vb@rchiv · Tipps & Tricks · Arbeitsspeicher freiräumen

Rubrik: System/Windows · Sonstiges | VB-Versionen: VB4, VB5, VB6

17.09.02

Arbeitsspeicher freiräumen Dieser Tipp zeigt, wie man den Arbeitsspeicher bei Speicherengpässen optimieren kann.
Autor: Marcus Jacob	Bewertung:	Views: 34.503
www.jacob-software-development.de	System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Dieser Tipp zeigt, wie man den Arbeitsspeicher bei Speicherengpässen optimieren kann.
Um das nachfolgende Beispiel zu testen, erstellen Sie ein neues Formular und platzieren darauf:

1x Command-Button
2x Label (Label1 und Label2)
1x Progressbar
1x Timer

Und hier der benötigte Code:

' API´s und Konstanten
Private Declare Sub GlobalMemoryStatus Lib "kernel32" ( _
  lpBuffer As MEMORYSTATUS)
 
Private Type MEMORYSTATUS
  dwLength As Long         ' Gesamtlänge der Struktur
  dwMemoryLoad As Long     ' Prozent des belegten Speichers
  dwTotalPhys As Long      ' Gesamtarbeitsspeicher
  dwAvailPhys As Long      ' Verfügbarer Arbeitsspeicher
  dwTotalPageFile As Long  ' Größe der Auslagerungsdatei
  dwAvailPageFile As Long  ' Verfügbarer Arbeitsspeicher
  dwTotalVirtual As Long   ' Größe d. virtuellen Speichers
  dwAvailVirtual As Long   ' Verfügbarer virtueller Speicher
End Type
 
Private lpInfo As MEMORYSTATUS

Private Sub Form_Load()
  Me.Caption = "Speicher freigeräumt !"
 
  ' Timer auf 1 Sek. einstellen
  Timer1.Interval = 1000
End Sub

Private Sub Timer1_Timer()
  Dim NeuPhys As Long
  Dim Phys As Long
 
  If InStr(Me.Caption, "freigeräumt") <> 0 Then
    Call GlobalMemoryStatus(lpInfo)
    NeuPhys = lpInfo.dwAvailPhys
    Phys = lpInfo.dwTotalPhys
    Label2 = "Freier Speicher nachher: " + _
      CStr(NeuPhys / 1024) + " KB" 'Aktualisieren
 
    ' Ergänzung : Aufruf automatisieren wenn Speicher
    ' unter 20 MB
    If NeuPhys < 20000000 Then
      Command1 = True
    End If
  End If
End Sub

Private Sub Command1_Click()
  Dim Phys As Long
  Dim NeuPhys As Long
  Dim frei As Long
 
  Call GlobalMemoryStatus(lpInfo)
 
  ' Nie mehr als 50% vom RAM freiräumen
  Phys = lpInfo.dwTotalPhys / 60  
 
  ' Wieviel ist gerade frei?
  frei = lpInfo.dwAvailPhys       
 
  Screen.MousePointer = vbHourglass
  ProgressBar1.Max = 20
  Label1.Caption = "Freier Speicher voher: " + _
    CStr(frei / 1024) + " KB"
 
  ReDim at(20) As String
  Dim i As Integer
 
  For i = 0 To 20
    Me.ProgressBar1.Value = i
    at(i) = Space$(Phys)        ' Speicher aufblähen
    DoEvents
    Me.Caption = "Räume Speicher frei.... [" & _
      CStr(i / 20 * 100) & "%] Optimiert..."
  Next i
  Me.Caption = "Fertig"
  ProgressBar1.Value = 0
  Me.Caption = "Speicher freigeräumt !"
  Screen.MousePointer = 0
End Sub