تشخیص اجرا بودن یک برنامه

[HamidVB]

سلام.
چه جوری میشه با دادن آدرس یک برنامه تشخیص بدیم که آیا آن برنامه باز است یا نه؟

[MM_Mofidi]

میدانم که با استفاده از APP و اسم برنامه (در حال اجرا) می توان این کار را انجام داد.

[Best Programmer]

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 retur

' ned

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 retu

' rned

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 t

' he ModuleFileName

If lngReturn <> 0 Then
'Buffer with spaces first to allocate me

' mory 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



اینم راه حل مشکل