Option Explicit
ReferencedDomainName As String, cbReferencedDomainName As Long, peUse As Integer) As Long
Private Declare Function WTSEnumerateProcesses Lib "wtsapi32.dll" Alias "WTSEnumerateProcessesA" (ByVal hServer As Long, ByVal Reserved As Long, ByVal Version As Long, ByRef ppProcessInfo As Long, ByRef pCount As Long) As Long
Private Declare Sub WTSFreeMemory Lib "wtsapi32.dll" (ByVal pMemory As Long)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Const WTS_CURRENT_SERVER_HANDLE = 0&
Private Type WTS_PROCESS_INFO
SessionID As Long
ProcessID As Long
pProcessName As Long
pUserSid As Long
End Type
Public Function CheckProcess(ProcessName As String) As Boolean
Dim RetVal As Long
Dim Count As Long
Dim i As Integer
Dim lpBuffer As Long
Dim p As Long
Dim udtProcessInfo As WTS_PROCESS_INFO
RetVal = WTSEnumerateProcesses(0&, 0&, 1, lpBuffer, Count)
If RetVal Then
p = lpBuffer
For i = 1 To Count
CopyMemory udtProcessInfo, ByVal p, LenB(udtProcessInfo)
If LCase(GetStringFromLP(udtProcessInfo.pProcessName)) = LCase(ProcessName) Then CheckProcess = True
p = p + LenB(udtProcessInfo)
Next i
WTSFreeMemory lpBuffer
End If
End Function
Private Function GetStringFromLP(ByVal StrPtr As Long) As String
Dim b As Byte
Dim tempStr As String
Dim bufferStr As String
Dim Done As Boolean
Done = False
Do
' Get the byte/character that StrPtr is pointing to.
CopyMemory b, ByVal StrPtr, 1
If b = 0 Then ' If you've found a null character, then you're done.
Done = True
Else
tempStr = Chr$(b) ' Get the character for the byte's value
bufferStr = bufferStr & tempStr 'Add it to the string
StrPtr = StrPtr + 1 ' Increment the pointer to next byte/char
End If
Loop Until Done
GetStringFromLP = bufferStr
End Function