16,717
社区成员
发帖
与我相关
我的任务
分享
'這個程式需要四個Label,一個TextBox,一個Timer,一個Command
Private Type MEMORYSTATUS
dwLength As Long 'MEMORYSTATUS結構大小
dwMemoryLoad As Long '系統記憶體工作負荷的估計 介於0~100間 _
這個值只供比較用 95/98 NT演算法都不同 將來也可能改
dwTotalPhys As Long ' 實體記憶體大小
dwAvailPhys As Long ' 剩餘的實體記憶體
dwTotalPageFile As Long '記憶體頁可儲存的位元組數
dwAvailPageFile As Long '剩餘記憶體頁大小
dwTotalVirtual As Long '每個處理程序可用位址大小
dwAvailVirtual As Long
End Type
Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Dim lpBuffer As MEMORYSTATUS
Dim lTotalMem As Long
Private Sub Command1_Click()
Me.Caption = "開始釋放記憶體"
Timer1.Enabled = False
Command1.Enabled = False
Dim i As Long, s() As Byte
i = CLng(Text1.Text) * 1024 * 1024
ReDim s(i)
Erase s
Timer1.Enabled = True
Command1.Enabled = True
Me.Caption = "釋放完成"
End Sub
Private Sub Form_Load()
lpBuffer.dwLength = Len(lpBuffer)
GlobalMemoryStatus lpBuffer
lTotalMem = lpBuffer.dwTotalPhys \ 1024 \ 1024
Label1.Caption = "總記憶體大小 = " & lpBuffer.dwTotalPhys & " Bytes"
Label2.Caption = "可用記憶體大小 = " & lpBuffer.dwAvailPhys & " Bytes"
Label3.Caption = "剩餘記憶體記憶體 = " & lpBuffer.dwAvailPhys / lpBuffer.dwTotalPhys * 100 & " %"
Command1.Caption = "釋放記憶體"
Text1.Text = lTotalMem
Timer1.Enabled = True
Timer1.Interval = 1000
MsgBox "Text1內的值是所要產生的Buffer大小 單位是MB" & Chr(10) & Chr(13) & _
"預設值是記憶體大小 當然也可以大於這個值" & Chr(10) & Chr(13) & _
"不過通常會有反效果 建議是使用這個值" & Chr(10) & Chr(13) & _
"或使用小於這個值的數 多執行幾次"
End Sub
Private Sub Timer1_Timer()
GlobalMemoryStatus lpBuffer
Label2.Caption = "可用記憶體大小 = " & lpBuffer.dwAvailPhys & " Bytes"
Label3.Caption = "剩餘記憶體記憶體 = " & lpBuffer.dwAvailPhys / lpBuffer.dwTotalPhys * 100 & " %"
Label4.Caption = "建議使用" & lpBuffer.dwAvailPhys \ 1000 \ 1000 + 3 & "這個值去釋放"
End Sub
'释放对象
Dim pro As Process
For Each pro In Process.GetProcesses
If pro.ProcessName = "EXCEL" Then
pro.Kill()
End If
Next