enumerate Win32 processes from VB

Option Compare Text: Option Explicit: Option Base 0

Private Type PROCESSENTRY32
  size As Long
  usage As Long
  processId As Long
  defaultHeapId As Long
  moduleId As Long
  cntThreads As Long
  parentProcessId As Long
  classBase As Long
  flags As Long
  exeFile As String * 500
End Type

Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const TH32CS_SNAPPROCESS As Long = 2

Private Declare Function kCloseHandle Lib "kernel32.dll" Alias "CloseHandle" (ByVal hObject As Long) As Long
Private Declare Function kCreateToolhelpSnapshot Lib "kernel32.dll" Alias "CreateToolhelp32Snapshot" (ByVal flags As Long, ByVal processId As Long) As Long
Private Declare Function kProcessFirst Lib "kernel32.dll" Alias "Process32First" (ByVal hSnapshot As Long, processEntry As PROCESSENTRY32) As Long
Private Declare Function kProcessNext Lib "kernel32.dll" Alias "Process32Next" (ByVal hSnapshot As Long, processEntry As PROCESSENTRY32) As Long

Public Sub main(): Call printProcessNames: End Sub

Public Sub printProcessNames()
Dim processes() As String, i As Long
  If getProcessNames(processes) Then
    For i = LBound(processes) To UBound(processes)
      Debug.Print i, processes(i)
    Next i
  End If
End Sub

Private Function getProcessNames(ByRef processes() As String, Optional ByVal sortResults As Boolean = False) As Long
Dim retVal As Long, hSnapshot As Long, processEntry As PROCESSENTRY32
  Let hSnapshot = kCreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0)
  If hSnapshot = INVALID_HANDLE_VALUE Then
    Let retVal = 0
  Else: Let processEntry.size = Len(processEntry)
    If kProcessFirst(hSnapshot, processEntry) Then
      ReDim processes(0 To 0): Do: Call ensureCapacityString(processes, retVal)
        Let processes(inc(retVal)) = getNullTerminatedString(processEntry.exeFile)
      Loop While kProcessNext(hSnapshot, processEntry)
      If retVal <= UBound(processes) Then ReDim Preserve processes(0 To retVal - 1)
    Else: Let retVal = 0
    End If: Call kCloseHandle(hSnapshot)
    'If sortResults Then Call shellSortString(processes)
  End If: Let getProcessNames = retVal
End Function
 
Private Sub ensureCapacityString(ByRef vector() As String, ByVal size As Long, Optional ByVal chunk As Long = 256)
Dim oldCapacity As Long, newCapacity As Long
  Let oldCapacity = 1 - LBound(vector) + UBound(vector)
  Let newCapacity = IIf(size And 255 = 0, size, 256 * (1 + size \ 256))
  If oldCapacity < newCapacity Then ReDim Preserve vector(LBound(vector) To LBound(vector) - 1 + newCapacity)
End Sub

Private Function getNullTerminatedString(ByRef str As String) As String
Dim i As Long
  Let i = InStr(str, vbNullChar)
  Let getNullTerminatedString = Left$(str, IIf(i = 0, Len(str), i - 1))
End Function

Private Function inc(ByRef i As Long) As Long: Let inc = i: Let i = i + 1: End Function