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.523 |
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