Binaryworld - GetProcessesInfo - Retrieve information on active processes ... [ VB -> Windows ]

Private Const TH32CS_SNAPPROCESS As Long = 2&
Private 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 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
  Loop
  ' close the snapshot
  CloseHandle hSnapshot

  ' return the result
  ReDim Preserve arr(5, index - 1) As Variant
  GetProcessesInfo = arr()

End Function