Is Process Running

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IsProcessRunning
'
' Date: 07/13/1999
' Comapany: WEI 
' Web Site: http://www.winkenterprises.com
' Author: James N.Wink
' Email: [email protected]
'
' Description: Used to determine if a process is running.
'
' Input: EXEName - String  EXE name of the Process
'
' Output: IsProcessRunning - Boolean Returns True if running
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function IsProcessRunning(ByVal EXEName As String) As Boolean
 'Used if Win 95 is detected
 Dim booResult As Boolean
 Dim lngLength As Long
 Dim lngProcessID As Long
 Dim strProcessName As String
 Dim lngSnapHwnd As Long
 Dim udtProcEntry As PROCESSENTRY32
 'Used if NT is detected
 Dim lngCBSize As Long 'Specifies the size, in bytes, of the lpidProcess array
 Dim lngCBSizeReturned As Long 'Receives the number of bytes returned
 Dim lngNumElements As Long
 Dim lngProcessIDs() As Long
 Dim lngCBSize2 As Long
 Dim lngModules(1 To 200) As Long
 Dim lngReturn As Long
 Dim strModuleName As String
 Dim lngSize As Long
 Dim lngHwndProcess As Long
 Dim lngLoop As Long
 'Turn on Error handler
 On Error GoTo IsProcessRunning_Error
 
 booResult = False
 
 EXEName = UCase$(Trim$(EXEName)) 
 lngLength = Len(EXEName)
 
Select Case getVersion()
  Case WIN95_System_Found 'Windows 95/98
  'Get SnapShot of Threads
  lngSnapHwnd = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
  'Check to see if SnapShot was made
  If lngSnapHwnd = hNull Then GoTo IsProcessRunning_Exit
  'Set Size in UDT, must be done, prior to calling API
  udtProcEntry.dwSize = Len(udtProcEntry)
  ' Get First Process
  lngProcessID = Process32First(lngSnapHwnd, udtProcEntry)
  Do While lngProcessID
   'Get Full Path Process Name
   strProcessName = StrZToStr(udtProcEntry.szExeFile)
   'Check for Matching Upper case result
   
   strProcessName = Ucase$(Trim$(strProcessName))
   If Right$(strProcessName, lngLength) = EXEName Then
    'Found
    booResult = True
    GoTo IsProcessRunning_Exit
   End If
   'Not found, get next Process
   lngProcessID = Process32Next(lngSnapHwnd, udtProcEntry)
  Loop
  Case WINNT_System_Found 'Windows NT
  'Get the array containing the process id's for each process objec
  '  t
  'Set Default Size
  lngCBSize = 8 ' Really needs to be 16, but Loop will increment prior to calling API
  lngCBSizeReturned = 96
  'Check to see if Process ID's were returned
  Do While lngCBSize <= lngCBSizeReturned
   'Increment Size
   lngCBSize = lngCBSize * 2
   'Allocate Memory for Array
   ReDim lngProcessIDs(lngCBSize / 4) As Long
   'Get Process ID's
   lngReturn = EnumProcesses(lngProcessIDs(1), lngCBSize, lngCBSizeReturned)
  Loop
  'Count number of processes returned
  lngNumElements = lngCBSizeReturned / 4
  'Loop thru each process
  For lngLoop = 1 To lngNumElements
   'Get a handle to the Process and Open
   lngHwndProcess = OpenProcess(PROCESS_QUERY_INFORMATION _
   Or PROCESS_VM_READ, 0, lngProcessIDs(lngLoop))
   'Check to see if Process handle was returned
   If lngHwndProcess <> 0 Then
    'Get an array of the module handles for the specified process
    lngReturn = EnumProcessModules(lngHwndProcess, lngModules(1), 200, lngCBSize2)
    'If the Module Array is retrieved, Get the ModuleFileName
    If lngReturn <> 0 Then
     'Buffer with spaces first to allocate memory for byte array
     strModuleName = Space(MAX_PATH)
     'Must be set prior to calling API
     lngSize = 500
     'Get Process Name
     lngReturn = GetModuleFileNameExA(lngHwndProcess, lngModules(1), _
     strModuleName, lngSize)
     'Remove trailing spaces
     strProcessName = Left(strModuleName, lngReturn)
     'Check for Matching Upper case result
     strProcessName = UCase$(Trim$(strProcessName))
     If Right$(strProcessName, lngLength) = EXEName Then
      'Found
      booResult = True
      GoTo IsProcessRunning_Exit
     End If
    End If
   End If
   'Close the handle to this process
   lngReturn = CloseHandle(lngHwndProcess)
  Next
 End Select
GoTo IsProcessRunning_Exit
IsProcessRunning_Error:
Err.Clear
booResult = False
IsProcessRunning_Exit:
'Turn off Error handler
On Error GoTo 0
IsProcessRunning = booResult
End Function
Private Function getVersion() As Long
 
 Dim osinfo As OSVERSIONINFO
 Dim retvalue As Integer
 
 osinfo.dwOSVersionInfoSize = 148
 osinfo.szCSDVersion = Space$(128)
 retvalue = GetVersionExA(osinfo)
 getVersion = osinfo.dwPlatformId
End Function
Private Function StrZToStr(s As String) As String
 StrZToStr = Left$(s, Len(s) - 1)
End Function