Private Declare Function EnumProcesses Lib "PSAPI.DLL" ( _
idProcess As Long, _
ByVal cBytes As Long, _
cbNeeded As Long) As Long
Private Declare Function EnumProcessModules Lib "PSAPI.DLL" ( _
ByVal hProcess As Long, _
hModule As Long, _
ByVal cb As Long, _
cbNeeded As Long) As Long
Private Declare Function GetModuleBaseName _
Lib "PSAPI.DLL" Alias "GetModuleBaseNameA" ( _
ByVal hProcess As Long, _
ByVal hModule As Long, _
ByVal lpBaseName As String, _
ByVal nSize As Long) As Long
Private Declare Function GetModuleFileNameEx _
Lib "PSAPI.DLL" Alias "GetModuleFileNameExA" ( _
ByVal hProcess As Long, _
ByVal hModule As Long, _
ByVal lpFilename As String, _
ByVal nSize As Long) 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 CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Const MAX_PATH = 260&
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const SYNCHRONIZE = &H100000
Private Const PROCESS_VM_READ = &H10&
Private Const PROCESS_QUERY_INFORMATION = &H400&
Private Const PROCESS_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or _
SYNCHRONIZE Or &HFFF&
Private Function TrimNull(ByVal sStr As String) As String
Dim nPos As Long
nPos = InStr(sStr, vbNullChar)
If nPos Then
TrimNull = Left$(sStr, nPos - 1)
Else
TrimNull = sStr
End If
End Function
Public Function IsProcessRunning(ByVal sEXEName As String) As Boolean
Dim i As Integer, j As Integer, l As Long
Dim nNeeded As Long
Dim hEXE As Long
Dim hProcess As Long
Dim lret As Long
Dim nProcesses As Long
Dim nProcessIDs() As Long
Dim sEXENames() As String
Dim sFQEXENames() As String
If LCase$(Right$(sEXEName, 4)) <> ".exe" Then
sEXEName = sEXEName & ".exe"
End If
' First get the array of process IDs
' Initial guess on the number of running processes
nProcesses = 25
Do
' Size array
ReDim nProcessIDs(1 To nProcesses)
' Enumerate
lret = EnumProcesses(nProcessIDs(1), nProcesses * 4, nNeeded)
If lret = 0 Then
Exit Function
End If
' Compare needed bytes with array size in bytes.
' If less, then we got them all.
If nNeeded < nProcesses * 4 Then
Exit Do
Else
nProcesses = nProcesses * 2
End If
Loop
nProcesses = nNeeded / 4
ReDim Preserve nProcessIDs(1 To nProcesses)
ReDim sEXENames(1 To nProcesses)
ReDim sFQEXENames(1 To nProcesses)
'Get EXE names
For i = 1 To nProcesses
' Use OpenProcess to get a handle to each process
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0&, nProcessIDs(i))
' Watch out for special processes
Select Case nProcessIDs(i)
Case 0 ' System Idle Process
sEXENames(i) = "Idle Process"
sFQEXENames(i) = "Idle Process"
Case 2
sEXENames(i) = "System"
sFQEXENames(i) = "System"
Case 28
sEXENames(i) = "csrss.exe"
sFQEXENames(i) = "csrss.exe"
End Select
' If error skip this process
If hProcess Then
' Now get the handle of the first module
' in this process, since first module is EXE
hEXE = 0
lret = EnumProcessModules(hProcess, hEXE, 4&, nNeeded)
If hEXE Then
' Get the name of the module
sEXENames(i) = String$(MAX_PATH, 0)
lret = GetModuleBaseName(hProcess, hEXE, sEXENames(i), Len(sEXENames(i)))
sEXENames(i) = TrimNull(sEXENames(i))
' Get full path name
sFQEXENames(i) = String$(MAX_PATH, 0)
lret = GetModuleFileNameEx(hProcess, hEXE, sFQEXENames(i), Len(sFQEXENames(i)))
sFQEXENames(i) = TrimNull(sFQEXENames(i))
End If
End If
' Close handle
lret = CloseHandle(hProcess)
Next
' Check for match
For i = 1 To nProcesses
If LCase$(sFQEXENames(i)) = LCase$(sEXEName) Then
IsProcessRunning = True
Exit Function
End If
Next
For i = 1 To nProcesses
If LCase$(sEXENames(i)) = LCase$(sEXEName) Then
IsProcessRunning = True
Exit Function
End If
Next
End Function
