Const TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000
Const MAX_PATH As Integer = 260
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 Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function EnumProcesses Lib "psapi.dll" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function GetModuleBaseName Lib "psapi.dll" _
Private Function GetProcessNameFromId(ByVal ProcId As Long) As String
Private Declare Function GetModuleBaseName Lib "psapi.dll" _
Alias "GetModuleBaseNameA" _
(ByVal hProcess As Long, _
ByVal hModule As Long, _
ByVal lpBaseName As String, _
ByVal nSize As Long) As Long
Private Declare Function EnumProcessModules Lib "psapi.dll" _
(ByVal hProcess As Long, _
lphModule As Long, _
ByVal cb As Long, _
lpcbNeeded As Long) As Long
Dim lngModuleHandle As Long
Dim lngReturnValue As Long
Dim strProcessName As String
Dim hProc As Long
Dim lngNumberOfBytesReceived As Long
hProc = OpenProcess(PROCESS_ALL_ACCESS, False, ProcId)
lngModuleHandle = 0
lngReturnValue = EnumProcessModules(hProc, lngModuleHandle, 4&, lngNumberOfBytesReceived)
If Err.LastDllError Then
Debug.Print LastSystemError
End If
' Get the name of the module
strProcessName = String$(256, 0)
lngReturnValue = GetModuleBaseName(hProc, lngModuleHandle, strProcessName, Len(strProcessName))
If Err.LastDllError Then
Debug.Print LastSystemError
End If
CloseHandle hProc
GetProcessNameFromId = Trim$(strProcessName)
End Function
Public Sub FillProcessList(ByVal lstIn As ListBox)
Dim hSnapShot As Long
Dim uProcess As PROCESSENTRY32
Dim r As Boolean
Dim strProcName As String
On Error GoTo OldWindowsversion
'\\Takes a snapshot of the processes and the heaps, modules, and threads used by the processes
hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
'\\set the length of our ProcessEntry-type
uProcess.dwSize = Len(uProcess)
'\\Retrieve information about the first process encountered in our system snapshot
r = Process32First(hSnapShot, uProcess)
Do While r
strProcName = UCase(Left$(uProcess.szExeFile, IIf(InStr(1, uProcess.szExeFile, Chr$(0)) > 0, InStr(1, uProcess.szExeFile, Chr$(0)) - 1, 0)))
If Trim$(strProcName) <> "" Then
lstIn.AddItem strProcName
lstIn.ItemData(lstIn.NewIndex) = uProcess.th32ProcessID
End If
'\\Retrieve information about the next process recorded in our system snapshot
r = Process32Next(hSnapShot, uProcess)
Loop
'close our snapshot handle
CloseHandle hSnapShot
Exit Sub
OldWindowsversion:
Dim proclst() As Long
Dim lBytesRequired As Long, lItem As Long
ReDim proclst(256) As Long
Dim sName As String
r = EnumProcesses(proclst(0), UBound(proclst) * 4, lBytesRequired)
If lBytesRequired > (UBound(proclst) * 4) Then
ReDim proclst(lBytesRequired / 4) As Long
r = EnumProcesses(proclst(0), UBound(proclst) * 4, lBytesRequired)
End If
For lItem = 0 To UBound(proclst)
If proclst(lItem) <> 0 Then
sName = GetProcessNameFromId(proclst(lItem))
If sName <> "" And InStr(sName, "?") = 0 Then
lstIn.AddItem sName
lstIn.ItemData(lstIn.NewIndex) = proclst(lItem)
End If
End If
Next lItem
End Sub
