VB6: Problema con función "ProcessExists"

[Progmasterbr]

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:

Código [Seleccionar] Expandir




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

[LeandroA]

Hola es por un tema de privilegios. para ello tenes que darle ciertos privilegios a tu proceso pega en un modulo bas este codigo

Código (vb) [Seleccionar] Expandir

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.

[Progmasterbr]

LeandroA,

El problema sigue apareciendo.
aquí está mi proyecto http://tempsend.com/370CC8ED77, y cómo me estoy tratando de verificar si un determinado programa se está ejecutando.

[LeandroA]

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

[Progmasterbr]

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.

[LeandroA]

hola por lo que vi estas llamando mal la funcion

Incorrecto

Código [Seleccionar] Expandir

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

Código [Seleccionar] Expandir

MsgBox IsProcessRunning("teste.exe")

o

Código [Seleccionar] Expandir

MsgBox FindProcessID("teste.exe") <> 0

[Lekim]

Hola
Solo necesitas esto, tal cual...(Sin declaraciones API)

Código (vb) [Seleccionar] Expandir

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