Visual Basic Programming Code Examples

Visual Basic > Windows and Controls Code Examples

Get a list of the system processes



Get a list of the system processes

The following routine returns a 1d string array containing the names of the system processes along with their corresponding process IDs in 1d long array. An example routine showing how to use this routine can be found at the bottom of this post:

Option Explicit
'Windows 95/98 platform
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnap As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnap As Long, lppe As PROCESSENTRY32) As Long

'Windows NT platform
Private Declare Function EnumProcesses Lib "psapi" (lpIdProcess As Any, ByVal cb As Long, cbNeeded As Long) As Long
Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetModuleBaseName Lib "PSAPI.DLL" Alias "GetModuleBaseNameA" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Public Declare Function EnumProcessModules Lib "PSAPI.DLL" (ByVal hProcess As Long, lphModule As Long, ByVal cb As Long, lpcbNeeded As Long) As Long

Private Const MAX_PATH As Integer = 260

Private Type PROCESSENTRY32
    lSize 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
    sExeFile As String * MAX_PATH
End Type



'Purpose     :  Enumerate the current processes and return names and process IDs.
'Inputs      :  [sFilter]           If set will only return processes containing this string.
'               [bWINNT]            Set this to True when running on NT machines.
'Outputs     :  Returns the number of processes, or -1 if an error occurs.
'               asProcessNames      A 1d string array containing the system processes.
'               alProcIDs           A 1d long array of Process IDs corresponding to the names given in the
'                                   string array
'Notes       :  The routine works for WIN NT, 95/98 and 2000.


Function EnumProcs(asProcessNames() As String, alProcIDs() As Long, Optional sFilter As String, Optional bWINNT As Boolean) as Long
    Dim lhwnSnapShot As Long, tProcess As PROCESSENTRY32, lThisProc As Long, sThisProc As String
    Dim bFiltered As Boolean, alAllProcIDs() As Long
    Dim lCB As Long
    
    Const TH32CS_SNAPHEAPLIST = &H1, TH32CS_SNAPPROCESS = &H2, 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
    
    On Error GoTo ErrFailed
    Erase asProcessNames
    Erase alProcIDs
    
    bFiltered = Len(sFilter)
    
    If bWINNT Then
'-------Windows NT platform
        lCB = 512
        Do
            ReDim alAllProcIDs(0 To (lCB \ 4) - 1) As Long
            If EnumProcesses(alAllProcIDs(0), lCB, lThisProc) = 0 Then
                'Failed
                EnumProcs = -1
                Exit Function
            End If
            If lThisProc <= lCB Then
                'Retrieved all the process IDs
                Exit Do
            End If
            'Increase the size of the array to hold the ProcIDs
            lCB = lCB * 2
        Loop
        
        lCB = (lThisProc \ 4) - 1
        
        'Resize arrays
        ReDim Preserve alAllProcIDs(0 To lCB) As Long
        ReDim asProcessNames(1 To lCB + 1)
        ReDim alProcIDs(1 To lCB + 1)

        'Get the process names        
        For lThisProc = 0 To lCB
            sThisProc = GetProcessName(alAllProcIDs(lThisProc))
            If Len(sThisProc) Then
                If bFiltered Then
                    'Filter the list of processes returned
                    If InStr(1, sThisProc, sFilter, vbBinaryCompare) Then
                        EnumProcs = EnumProcs + 1
                        asProcessNames(EnumProcs) = sThisProc
                        alProcIDs(EnumProcs) = alAllProcIDs(lThisProc)
                    End If
                Else
                    EnumProcs = EnumProcs + 1
                    asProcessNames(EnumProcs) = sThisProc
                    alProcIDs(EnumProcs) = alAllProcIDs(lThisProc)
                End If
            End If
        Next
        If EnumProcs And EnumProcs <> lCB + 1 Then
            ReDim Preserve asProcessNames(1 To EnumProcs)
            ReDim Preserve alProcIDs(1 To EnumProcs)
        Else
            Erase asProcessNames
        End If
    Else
'-------Windows 95/98 platform
        
        'Get a handle to a snapshot of the processes (and modules, threads, heaps used by the processes)
        lhwnSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
        tProcess.lSize = Len(tProcess)
        ReDim asProcessNames(1 To 1)
        ReDim alProcIDs(1 To 1)
        
        
        'Get first process in snapshot
        lThisProc = Process32First(lhwnSnapShot, tProcess)
        
        Do While lThisProc
            
            sThisProc = Left$(tProcess.sExeFile, IIf(InStr(1, tProcess.sExeFile, Chr$(0)) > 0, InStr(1, tProcess.sExeFile, Chr$(0)) - 1, 0))
            If Len(sThisProc) Then
                If bFiltered Then
                    'Filter the list of processes returned
                    If InStr(1, sThisProc, sFilter, vbBinaryCompare) Then
                        EnumProcs = EnumProcs + 1
                        ReDim Preserve asProcessNames(1 To EnumProcs)
                        ReDim Preserve alProcIDs(1 To EnumProcs)
                        asProcessNames(EnumProcs) = sThisProc
                        alProcIDs(EnumProcs) = tProcess.th32ProcessID
                    End If
                Else
                    EnumProcs = EnumProcs + 1
                    ReDim Preserve asProcessNames(1 To EnumProcs)
                    ReDim Preserve alProcIDs(1 To EnumProcs)
                    asProcessNames(EnumProcs) = sThisProc
                    alProcIDs(EnumProcs) = tProcess.th32ProcessID
                End If
            End If
            'Get next process in snapshot
            lThisProc = Process32Next(lhwnSnapShot, tProcess)
        Loop
        'close snapshot
        CloseHandle lhwnSnapShot
    End If
    
    Exit Function

ErrFailed:
    Erase asProcessNames
    Erase alProcIDs
    EnumProcs = -1
    On Error GoTo 0
End Function


'Purpose     :  Returns a process name given a Process ID
'Inputs      :  lProcessID          A 32 bit long Process ID
'Outputs     :  Returns the processes name


Public Function GetProcessName(ByVal lProcessID As Long) As String
    Dim szProcessName As String
    Dim lLen As Long, hProcess As Long
    Dim alhwndMod(0 To 1023) As Long
    Dim lcbNeeded As Long
    Dim lCounter As Long
    Dim lR As Long
    Const PROCESS_QUERY_INFORMATION = &H400
    Const PROCESS_VM_READ = &H10

    lLen = MAX_PATH
    
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lProcessID)
    
    If (lProcessID = 0) Then
        GetProcessName = "System Idle Process"
    ElseIf (lProcessID = 2) Then
        GetProcessName = "System"
    Else
        'Get the process name
        If (hProcess <> 0) Then
            If (EnumProcessModules(hProcess, alhwndMod(0), 1024 * 4, lcbNeeded)) Then
                szProcessName = String$(lLen, 0)
                LSet szProcessName = "unknown"
                lR = GetModuleBaseName(hProcess, alhwndMod(lCounter), szProcessName, lLen)
                GetProcessName = Left$(szProcessName, InStr(szProcessName, vbNullChar) - 1)
            End If
        End If
    End If
    CloseHandle hProcess
End Function

'Demonstration routine
Sub Test()
    Dim lThisProc As Long, lNumProcs As Long, asProcNames() As String, alProcIDs() As Long
    
    'WIN NT Test
    lNumProcs = EnumProcs(asProcNames, alProcIDs, , True)
    For lThisProc = 1 To lNumProcs
        Debug.Print asProcNames(lThisProc) & vbTab & "ID:" & alProcIDs(lThisProc)
    Next
    
    '95/98/2000 Test
    lNumProcs = EnumProcs(asProcNames, alProcIDs)
    For lThisProc = 1 To lNumProcs
        Debug.Print asProcNames(lThisProc) & vbTab & "ID:" & alProcIDs(lThisProc)
    Next

End Sub