VB and VBA Users Source Code: Returning all the Process IDs for an EXE/Image name
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Returning all the Process IDs for an EXE/Image name
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Thursday, February 07, 2002
Hits:
834
Category:
Windows API
Article:
The following code will return all the Process IDs for a specified image/exe name. Option Explicit Private Declare Function CloseHandle Lib "Kernel32.dll" (ByVal Handle As Long) As Long Private Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long Private Declare Function EnumProcesses Lib "PSAPI.DLL" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long Private Declare Function GetModuleFileNameExA Lib "PSAPI.DLL" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long Private Declare Function EnumProcessModules Lib "PSAPI.DLL" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long 'Purpose : Returns all the process IDs for the matching Image/Exe name 'Inputs : sImageName The name of the image (or Exe) to return the PIDs for. 'Outputs : Returns a one based long array of matching processes, or empty if the image name is ' not found. If an error occurs will return the error number. 'Author : Andrew Baker (copyright www.vbusers.com) 'Date : 31/Jan/2002 'Notes : 'Revisions : Public Function ImageGetProcessIDs(ByVal sImageName As String) As Variant Const clMaxNumProcesses As Long = 5000 Const MAX_PATH = 260, PROCESS_QUERY_INFORMATION = 1024, PROCESS_VM_READ = 16 Dim sModuleName As String * MAX_PATH, sProcessNamePath As String, sProcessName As String Dim alMatchingProcessIDs() As Long Dim alModules(1 To 400) As Long Dim lBytesReturned As Long, lNumMatching As Long Dim lNumProcesses As Long, lBytesNeeded As Long, alProcIDs() As Long Dim lHwndProcess As Long, lThisProcess As Long, lRet As Long On Error GoTo ErrFailed sImageName = UCase$(Trim$(sImageName)) 'Size array to hold process IDs ReDim alProcIDs(clMaxNumProcesses * 4) As Long 'Populate an array containing all process ID's lRet = EnumProcesses(alProcIDs(1), clMaxNumProcesses * 4, lBytesReturned) 'Count number of processes returned lNumProcesses = lBytesReturned / 4 'Resize the array containing all the processes ReDim Preserve alProcIDs(lNumProcesses) 'Resize the array to contain all the matching processes ReDim alMatchingProcessIDs(1 To lNumProcesses) For lThisProcess = 1 To lNumProcesses 'Open the process lHwndProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, alProcIDs(lThisProcess)) If lHwndProcess <> 0 Then 'Get an array of the module handles for the specified process lRet = EnumProcessModules(lHwndProcess, alModules(1), 200&, lBytesNeeded) If lRet <> 0 Then 'Get Process Path and Name lRet = GetModuleFileNameExA(lHwndProcess, alModules(1), sModuleName, MAX_PATH) sProcessNamePath = Trim$(UCase$(Left$(sModuleName, lRet))) 'Get the Process Name sProcessName = Mid$(sProcessNamePath, InStrRev(sProcessNamePath, "\") + 1) If sProcessName = sImageName Then 'Store the process ID lNumMatching = lNumMatching + 1 alMatchingProcessIDs(lNumMatching) = alProcIDs(lThisProcess) End If End If End If 'Close the handle to this process lRet = CloseHandle(lHwndProcess) Next If lNumMatching Then 'Return matching process IDs ReDim Preserve alMatchingProcessIDs(1 To lNumMatching) ImageGetProcessIDs = alMatchingProcessIDs Else 'No matching processes found ImageGetProcessIDs = Empty End If Exit Function ErrFailed: Debug.Print "Error in ImageGetProcessIDs: " & Err.Description ImageGetProcessIDs = Err.Number End Function 'Returns the process ID of all open Excel's Sub Test() Dim avProcIDs As Variant, lThisProcID As Long 'Return the process IDs of the explorers avProcIDs = ImageGetProcessIDs("excel.exe") If IsArray(avProcIDs) Then For lThisProcID = 1 To UBound(avProcIDs) Debug.Print "Excel Proc ID: " & avProcIDs(lThisProcID) Next Else Debug.Print "Failed to find valid processes" End If End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
