devxlogo

GetProcessesInfo – Retrieve information on active processes

GetProcessesInfo – Retrieve information on active processes

Private Const TH32CS_SNAPPROCESS As Long = 2&Private Const MAX_PATH As Integer = 260Private 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_PATHEnd TypePrivate Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags _    As Long, ByVal lProcessID As Long) As LongPrivate Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, _    uProcess As PROCESSENTRY32) As LongPrivate Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, _    uProcess As PROCESSENTRY32) As LongPrivate Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)' get information on all the active processes' IMPORTANT: works on Win95, Win98, Win2K, but not on WinNT' returns a two-dimensional array of variants, formatted as follows'' arr(0,n) = process ID of the N-th process' arr(1,n) = EXE file path' arr(2,n) = number of threads' arr(3,n) = ID of parent processPublic Function GetProcessesInfo() As Variant()    Dim hSnapshot As Long    Dim procEntry As PROCESSENTRY32    Dim res As Long    Dim index As Integer    Dim arr() As Variant        ' take a snapshot of all active processes    hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)    ' raise error if fails (for example under WinNT)    If hSnapshot = -1 Then Err.Raise 999, , "Unable to get process snapshot"    ' prepare the receiving buffer    procEntry.dwSize = Len(procEntry)        ' prepare a result array    ReDim arr(5, 100) As Variant            ' start with the first process    res = Process32First(hSnapshot, procEntry)    Do While res        If index > UBound(arr) Then            ReDim Preserve arr(5, index + 99) As Variant        End If        ' store information in array        arr(0, index) = procEntry.th32ProcessID        arr(1, index) = Left$(procEntry.szExeFile, InStr(procEntry.szExeFile & _            vbNullChar, vbNullChar) - 1)        arr(2, index) = procEntry.cntThreads        arr(3, index) = procEntry.th32ParentProcessID        ' get info on next process in the snapshot        res = Process32Next(hSnapshot, procEntry)        index = index + 1    Loop    ' close the snapshot    CloseHandle hSnapshot        ' return the result    ReDim Preserve arr(5, index - 1) As Variant    GetProcessesInfo = arr()    End Function

devx-admin

Share the Post: