Buen día amigos,
Tengo dos funciones que sirven para verificar si un proceso que ya está en marcha, pero return false cuando el proceso se está ejecutando.
¿Podría alguien ayudarme con esto, por favor?
Aquí dejo las funciones que estoy utilizando:
''''''''''''''''''''''''''''''''' PROCESS EXISTS '''''''''''''''''''''
Private Const MAX_PATH = 260
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Declare Function OpenProcess Lib "kernel32" ( _
ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function EnumProcesses Lib "PSAPI.DLL" ( _
lpidProcess As Long, ByVal cb As Long, cbNeeded As Long) As Long
Private Declare Function EnumProcessModules Lib "PSAPI.DLL" ( _
ByVal hProcess As Long, lphModule As Long, ByVal cb As Long, lpcbNeeded As Long) As Long
Private Declare Function GetModuleBaseName Lib "PSAPI.DLL" Alias "GetModuleBaseNameA" ( _
ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Const PROCESS_VM_READ = &H10
Private Const PROCESS_QUERY_INFORMATION = &H400
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 * MAX_PATH
End Type
Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Const TH32CS_SNAPPROCESS As Long = 2&
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function FindProcessID(ByVal pExename As String) As Long
Dim ProcessID As Long, hSnapshot As Long
Dim uProcess As PROCESSENTRY32, rProcessFound As Long
Dim Pos As Integer, szExename As String
hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
If hSnapshot = -1 Then
Exit Function
End If
uProcess.dwSize = Len(uProcess)
rProcessFound = ProcessFirst(hSnapshot, uProcess)
Do While rProcessFound
Pos = InStr(1, uProcess.szExeFile, vbNullChar)
If Pos Then
szExename = Left$(uProcess.szExeFile, Pos - 1)
End If
If LCase$(szExename) = LCase$(pExename) Then
ProcessID = uProcess.th32ProcessID
Exit Do
Else
rProcessFound = ProcessNext(hSnapshot, uProcess)
End If
Loop
CloseHandle hSnapshot
FindProcessID = ProcessID
End Function
Private Function IsProcessRunning2(PID As Long) As Boolean
Dim hProcess As Long
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, PID)
CloseHandle hProcess
IsProcessRunning2 = hProcess
End Function
Private Function IsProcessRunning(ByVal sProcess As String) As Boolean
Const MAX_PATH As Long = 260
Dim lProcesses() As Long, lModules() As Long, N As Long, lRet As Long, hProcess As Long
Dim sName As String
sProcess = UCase$(sProcess)
ReDim lProcesses(1023) As Long
If EnumProcesses(lProcesses(0), 1024 * 4, lRet) Then
For N = 0 To (lRet \ 4) - 1
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lProcesses(N))
If hProcess Then
ReDim lModules(1023)
If EnumProcessModules(hProcess, lModules(0), 1024 * 4, lRet) Then
sName = String$(MAX_PATH, vbNullChar)
GetModuleBaseName hProcess, lModules(0), sName, MAX_PATH
sName = Left$(sName, InStr(sName, vbNullChar) - 1)
If Len(sName) = Len(sProcess) Then
If sProcess = UCase$(sName) Then IsProcessRunning = True: Exit Function
End If
End If
End If
CloseHandle hProcess
Next N
End If
End Function
Desde ya muchas gracias
Hola es por un tema de privilegios. para ello tenes que darle ciertos privilegios a tu proceso pega en un modulo bas este codigo
Option Explicit
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As Luid) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As Any, ReturnLength As Long) As Long
Private Type Luid
lowpart As Long
highpart As Long
End Type
Private Type LUID_AND_ATTRIBUTES
pLuid As Luid
Attributes As Long
End Type
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(1) As LUID_AND_ATTRIBUTES
End Type
Private Const TOKEN_ADJUST_PRIVILEGES As Long = &H20
Private Const TOKEN_QUERY As Long = &H8
Private Const SE_PRIVILEGE_ENABLED As Long = &H2
Private Const SE_DEBUG_NAME As String = "SeDebugPrivilege"
Public Function AdjustPrivileges() As Boolean
Dim lToken As Long
Dim tTOKEN_PRIVILEGES As TOKEN_PRIVILEGES
Dim lProcessID As Long
lProcessID = GetCurrentProcess
If Not OpenProcessToken(lProcessID, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, lToken) = 0 Then
With tTOKEN_PRIVILEGES
If LookupPrivilegeValue(vbNullString, SE_DEBUG_NAME, .Privileges(0).pLuid) = 0 Then
Exit Function
End If
.PrivilegeCount = 1
.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
End With
If Not AdjustTokenPrivileges(lToken, 0, tTOKEN_PRIVILEGES, Len(tTOKEN_PRIVILEGES), 0&, 0&) = 0 Then
AdjustPrivileges = True
End If
End If
End Function
luego en el form load llama a AdjustPrivileges,
y la funcion IsProcessRunning anda bien.
Saludos.
LeandroA,
El problema sigue apareciendo.
aquí está mi proyecto http://tempsend.com/370CC8ED77 (http://tempsend.com/370CC8ED77), y cómo me estoy tratando de verificar si un determinado programa se está ejecutando.
Hola perdona me estoy llendo al trabajo pero veo que pasaste un rar de 22mb que para solo comprobar si un exe se esta ejecutando? mira yo creo que con lo que tenes antes tiene que funcionar sino decime cual es el ejcutable en cuestion
LeandroA,
las funciones anteriores no reconocen el nombre de mi programa para comprobar, por lo que cuando se está ejecutando, dicen que no es cierto (falso).
Usted puede tratar de ver el nombre de su programa hecho en VB.NET (mi caso) no está funcionando. Ahora con otro programa funciona bien (por ejemplo, "chrome.exe").
Es decir, las funciones anteriores fallan para verificar algunos nombres de proceso. :-(
hola por lo que vi estas llamando mal la funcion
Incorrecto
MsgBox IsProcessRunning(FindProcessID("teste.exe"))
IsProcessRunning requiere el nombre del proceso (string) no el id por lo que no es necesario llamar a findprocessID, Ó como quieras puedes usar findprocessID y si este retorna <> 0 quiere decir que el proceso esta en ejecucion
MsgBox IsProcessRunning("teste.exe")
o
MsgBox FindProcessID("teste.exe") <> 0
Hola
Solo necesitas esto, tal cual...(Sin declaraciones API)
Public Function ToKnowIfAppIsActive(strAppName As String) As Boolean
Dim IdProceso As Long
Dim ListaProcesos As Object
Dim ObjetoWMI As Object
Dim Proceso As Object
Dim NameProcess As String
Set ObjetoWMI = GetObject("winmgmts:")
If IsNull(ObjetoWMI) = False Then
Set ListaProcesos = ObjetoWMI.InstancesOf("win32_process")
For Each Proceso In ListaProcesos
NameProcess = Proceso.Name
IdProceso = Proceso.ProcessID
If NameProcess = strAppName Then
ToKnowIfAppIsActive = True
Exit For
Else
ToKnowIfAppIsActive = False
End If
Next
End If
End Function
Por si no lo sabías te comento que Chrome.exe es una aplicación especial. Si ejecutas el Administrador de Tareas de windows (Ctrl + R y escribe taskmgr.exe) y luego miras en la pestaña 'Procesos', verás que la lista de procesos hay más de un Chrome.exe ejecutándose. Así que si tienes que encontrar la ventana principal debes buscar la ventana de chrome cuyo nombre de clase (ClassName) sea "Chrome_WidgetWin_1"
sl2s