菜鸟求教！VB获得运行内存 - 编程论坛

#2

xiangyue05102016-11-21 19:02

程序代码：

Option Explicit
Private Type MEMORYSTATUS
memLength As Long
memMemoryLoad As Long
memTotalPhys As Long
memAvailPhys As Long
memTotalPageFile As Long
memAvailPageFile As Long
memTotalVirtual As Long
memAvailVirtual As Long
End Type
Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Function Memory(lType As Long) As Long
Const clKB As Long = 1024
Dim tMS As MEMORYSTATUS
tMS.memLength = Len(tMS)
GlobalMemoryStatus tMS
Select Case lType
Case 1
Memory = tMS.memMemoryLoad
Case 2
Memory = tMS.memTotalPhys / clKB
Case 3
Memory = tMS.memAvailPhys / clKB
Case 4
Memory = tMS.memTotalPageFile / clKB
Case 5
Memory = tMS.memAvailPageFile / clKB
Case 6
Memory = tMS.memTotalVirtual / clKB
Case 7
Memory = tMS.memAvailVirtual / clKB
Case Else
'Invalid number
Memory = -1
End Select
End Function

如果是桌面加速球这样的还需要获取每一个进程的内存占用，然后区分必须进程和次要进程，最后对次要进程进行处理。这个难度很大

#3

肇励影2016-11-22 00:35

回复 2楼 xiangyue0510

那接下来我要怎么使用呢？比如加速球上有一个钟和一个标签，如何调用这些代码呢？

#4

xiangyue05102016-11-22 09:25

你说的是timer吧，钟……
昨天忘记说了，GlobalMemoryStatus适用于小内存情况，较大内存最好用GlobalMemoryStatusEx
声明

程序代码：

Private Type LARGE_INTEGER

LowPart As Long

HighPart As Long
End Type
Private Type MEMORYSTATUSEX

dwLength As Long

dwMemoryLoad As Long

ullTotalPhys As LARGE_INTEGER

ullAvailPhys As LARGE_INTEGER

ullTotalPageFile As LARGE_INTEGER

ullAvailPageFile As LARGE_INTEGER

ullTotalVirtual As LARGE_INTEGER

ullAvailVirtual As LARGE_INTEGER

ullAvailExtendedVirtual As LARGE_INTEGER
End Type
Private Declare Function GlobalMemoryStatusEx Lib "kernel32.dll" (ByRef lpBuffer As MEMORYSTATUSEX) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

在label1中显示内存信息

程序代码：

Private Sub DisplayMemory()
Dim MemStat As MEMORYSTATUSEX

Dim TotalPhys As Currency
Dim AvailPhys As Currency

Dim POPSize As Currency

Dim TotalPageFile As Currency
Dim AvailPageFile As Currency

Dim TotalVirtual As Currency
Dim AvailVirtual As Currency
With MemStat
MemStat.dwLength = Len(MemStat)
GlobalMemoryStatusEx MemStat
POPSize = .dwLength

TotalPhys = Int(LargeIntToCurrency(.ullTotalPhys) / 1024 ^ 2)
AvailPhys = Int(LargeIntToCurrency(.ullAvailPhys) / 1024 ^ 2)

TotalPageFile = Int(LargeIntToCurrency(.ullTotalPageFile) / 1024 ^ 2)
AvailPageFile = Int(LargeIntToCurrency(.ullAvailPageFile) / 1024 ^ 2)

TotalVirtual = Int(LargeIntToCurrency(.ullTotalVirtual) / 1024 ^ 2)
AvailVirtual = Int(LargeIntToCurrency(.ullAvailVirtual) / 1024 ^ 2)

Label1.Caption = "入栈大小:" & POPSize & " Bytes" & vbCrLf & _
"物理内存大小:" & TotalPhys & "MB" & vbCrLf & _
"已用物理内存:" & TotalPhys - AvailPhys & "MB" & vbCrLf & _
"可用物理内存:" & Int((AvailPhys / TotalPhys) * 100) & "%" & vbCrLf & _
"可用物理内存:" & AvailPhys & "MB" & vbCrLf & vbCrLf & _
"虚拟内存大小:" & TotalVirtual & "MB" & vbCrLf & _
"已用虚拟内存:" & TotalVirtual - AvailVirtual & "MB" & vbCrLf & _
"可用虚拟内存:" & Int((AvailVirtual / TotalVirtual) * 100) & "%" & vbCrLf & _
"可用虚拟内存:" & AvailVirtual & "MB" & vbCrLf & vbCrLf & _
" 总计:" & TotalPageFile & "MB" & vbCrLf & _
" 已用:" & TotalPageFile - AvailPageFile & "MB" & vbCrLf & _
" 可用:" & AvailPageFile & "MB" & vbCrLf & vbCrLf & _
"-------------------------" & vbCrLf & _
"已经使用了: " & .dwMemoryLoad & "%"
Me.Caption = "已用内存:" & .dwMemoryLoad & "%"
End With
End Sub

Private Function LargeIntToCurrency(liInput As LARGE_INTEGER) As Currency
CopyMemory LargeIntToCurrency, liInput, LenB(liInput)
LargeIntToCurrency = LargeIntToCurrency * 10000
End Function

利用Timer控件实时刷新

程序代码：

Private Sub Timer1_Timer()
DisplayMemory
End Sub