Option Explicit
'Author: Sergio Desanti
'Proved: XP (32 BIT)
Private Declare Function CreateToolhelp32Snapshot Lib "Kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "Kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "Kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Sub CloseHandle Lib "Kernel32" (ByVal hPass As Long)
Private Declare Function GetModuleFileNameExA Lib "PSAPI.DLL" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFilename As String, ByVal nSize As Long) As Long
Private Type PROCESSENTRY32
dwSize As Long: cntUsage As Long: th32ProcessID As Long: th32DefaultHeapID As Long: th32ModuleID As Long: cntThreads As Long: th32ParentProcessID As Long: pcPriClassBase As Long: dwFlags As Long: szExeFile As String * 260
End Type
Private Sub Form_Load()
Shell "calc"
Shell "calc"
MsgBox IsWay("caLc.Exe")
End Sub
Private Function IsWay(ByVal NombreDelProceso As String) As String
Dim Handle_Procesos As Long
Handle_Procesos = CreateToolhelp32Snapshot(&HF, 0&)
Dim PE32 As PROCESSENTRY32
PE32.dwSize = Len(PE32)
Dim PidProc As Long
Dim NameProc As String
Dim RutaProc As String
Dim ret As Long
ret = Process32First(Handle_Procesos, PE32)
While ret > 0
NameProc = Split(PE32.szExeFile, Chr$(0))(0)
If LCase$(NameProc) = LCase$(NombreDelProceso) Then
PidProc = PE32.th32ProcessID
Dim H_Proceso As Long
H_Proceso = OpenProcess(&H410, &H0, PidProc)
Dim Buffer As String * &H104
Call GetModuleFileNameExA(H_Proceso, &H0, Buffer, &H104)
Call CloseHandle(H_Proceso)
RutaProc = Split(Buffer, Chr$(0))(0)
IsWay = IsWay & vbNewLine & RutaProc & vbTab & PidProc
End If
ret = Process32Next(Handle_Procesos, PE32)
Wend
Call CloseHandle(Handle_Procesos)
If IsWay = "" Then IsWay = "No esta Corriendo"
End Function