Code:
Option Explicit
Private Const MAX_PATH = 260
Private Type PROCESS_MEMORY_COUNTERS
cb As Long
PageFaultCount As Long
PeakWorkingSetSize As Long
WorkingSetSize As Long
QuotaPeakPagedPoolUsage As Long
QuotaPagedPoolUsage As Long
QuotaPeakNonPagedPoolUsage As Long
QuotaNonPagedPoolUsage As Long
PagefileUsage As Long
PeakPagefileUsage As Long
End Type
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Declare Function GetVersionEx Lib "kernel32" _
Alias "GetVersionExA" ( _
ByRef lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function Process32First Lib "kernel32" ( _
ByVal hSnapshot As Long, _
ByRef lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" ( _
ByVal hSnapshot As Long, _
ByRef lppe As PROCESSENTRY32) As Long
Private Declare Function OpenProcess Lib "kernel32" ( _
ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" ( _
ByVal dwFlags As Long, _
ByVal th32ProcessID As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Declare Function GetProcessMemoryInfo Lib "psapi.dll" ( _
ByVal lHandle As Long, _
ByRef lpStructure As PROCESS_MEMORY_COUNTERS, _
ByVal lSize As Long) As Long
Private Const TH32CS_SNAPPROCESS As Long = 2
Private Const PROCESS_QUERY_LIMITED_INFORMATION As Long = &H1000
Private Const PROCESS_QUERY_INFORMATION As Long = &H400
Private Const INVALID_HANDLE_VALUE As Long = -1
Dim IsVistaAndLater As Boolean
Private Sub Form_Load()
Dim ver As OSVERSIONINFO
ver.dwOSVersionInfoSize = Len(ver)
GetVersionEx ver
IsVistaAndLater = ver.dwMajorVersion >= 6
Call tmrTimer_Timer
End Sub
Private Sub Form_Resize()
If Me.ScaleWidth > 200 And Me.ScaleHeight > 200 Then lvwInfo.Move 100, 100, Me.ScaleWidth - 200, Me.ScaleHeight - 200
End Sub
Private Sub tmrTimer_Timer()
Dim hSnap As Long: Dim pe As PROCESSENTRY32
Dim hProc As Long: Dim mi As PROCESS_MEMORY_COUNTERS
Dim i As Long: Dim li As ListItem
hSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
If hSnap = INVALID_HANDLE_VALUE Then Exit Sub
pe.dwSize = Len(pe)
If Process32First(hSnap, pe) Then
Do
hProc = OpenProcess(IIf(IsVistaAndLater, PROCESS_QUERY_LIMITED_INFORMATION, PROCESS_QUERY_INFORMATION), _
False, pe.th32ProcessID)
If hProc Then
mi.cb = Len(mi)
GetProcessMemoryInfo hProc, mi, Len(mi)
If i >= lvwInfo.ListItems.Count Then
Set li = lvwInfo.ListItems.Add(, , Left$(pe.szExeFile, InStr(1, pe.szExeFile, vbNullChar)))
Else: Set li = lvwInfo.ListItems(i + 1)
End If
li.SubItems(1) = pe.th32ProcessID
li.SubItems(2) = LTrim(Format(mi.WorkingSetSize / 1024, "### ### ##0"))
li.SubItems(3) = LTrim(Format(mi.PagefileUsage / 1024, "### ### ##0"))
li.SubItems(4) = mi.PageFaultCount
li.SubItems(5) = LTrim(Format(mi.PeakPagefileUsage / 1024, "### ### ##0"))
li.SubItems(6) = LTrim(Format(mi.PeakWorkingSetSize / 1024, "### ### ##0"))
li.SubItems(7) = LTrim(Format(Int(mi.QuotaNonPagedPoolUsage / 1024), "### ### ##0"))
li.SubItems(8) = LTrim(Format(Int(mi.QuotaPagedPoolUsage / 1024), "### ### ##0"))
li.SubItems(9) = LTrim(Format(mi.QuotaPeakNonPagedPoolUsage / 1024, "### ### ##0"))
li.SubItems(10) = LTrim(Format(mi.QuotaPeakPagedPoolUsage / 1024, "### ### ##0"))
CloseHandle hProc
i = i + 1
End If
Loop While Process32Next(hSnap, pe)
End If
CloseHandle hSnap
If i < lvwInfo.ListItems.Count Then
Do Until lvwInfo.ListItems.Count = i
lvwInfo.ListItems.Remove (lvwInfo.ListItems.Count)
Loop
End If
End Sub