Browse DevX
Sign up for e-mail newsletters from DevX

Tip of the Day
Language: VB6,Win98,Win2K
Expertise: Intermediate
Jan 13, 2001



Building the Right Environment to Support AI, Machine Learning and Deep Learning

GetProcessesInfo - Retrieve information on active processes

Private Const TH32CS_SNAPPROCESS As Long = 2&
Private Const MAX_PATH As Integer = 260

    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 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 process

Public 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
    ' close the snapshot
    CloseHandle hSnapshot
    ' return the result
    ReDim Preserve arr(5, index - 1) As Variant
    GetProcessesInfo = arr()
End Function

Francesco Balena
Comment and Contribute






(Maximum characters: 1200). You have 1200 characters left.



Thanks for your registration, follow us on our social networks to keep up-to-date