Option Explicit
 
Private Sub Form_Load()
Dim stRes()     As stProcessInfo
Dim i           As Long
 
    i = (GetProcess("explorer.exe", stRes()) - 1)
    Do Until (i = 0)
        Debug.Print stRes(i - 1).dwPid; stRes(i - 1).szRuta
        i = (i - 1)
    Loop
End Sub
 
 

 
' ////////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
' //                                                            //
' // Web: http://InfrAngeluX.Sytes.Net/                         //
' //                                                            //
' // |-> Pueden Distribuir Este Código siempre y cuando         //
' // no se eliminen los créditos originales de este código      //
' // No importando que sea modificado/editado o engrandecido    //
' // o achicado, si es en base a este código                    //
' ////////////////////////////////////////////////////////////////

Option Explicit
 
Private Const PROCESS_QUERY_INFORMATION As Long = (&H400)
Private Const PROCESS_VM_READ           As Long = (&H10)
Private Const MAX_PATH                  As Long = 260
 
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
Public Type stProcessInfo
    szRuta              As String
    dwPid               As Long
End Type
Enum GetFileStr
     Extensión = 1
     FileName = 2
     Ruta = 4
End Enum
 
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
 
Public Function GetProcess(ByVal sProcName As String, ByRef stRetOut() As stProcessInfo) As Long
'   //  La funcion Retorna la cantidad de procesos encontrados.
Dim hCTS                As Long
Dim PE32                As PROCESSENTRY32
Dim lhFind              As Long
Dim li                  As Long
Dim sTmp                As String * MAX_PATH
Dim lProc               As Long
 
    hCTS = CreateToolhelp32Snapshot(&HF, 0&)
    PE32.dwSize = LenB(PE32)
    sProcName = LCase$(sProcName)
    Mid$(PE32.szExeFile, 1, MAX_PATH) = String(MAX_PATH, Chr(0))
    lhFind = Process32First(hCTS, PE32)
    While (lhFind > 0)
        lProc = (InStr(1, PE32.szExeFile, Chr(0), vbBinaryCompare) - 1)
        If (lProc = Len(sProcName)) Then
            If (LCase$(Mid$(PE32.szExeFile, 1, lProc)) = sProcName) Then
                lProc = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, PE32.th32ProcessID)
                ReDim Preserve stRetOut(0 To li)
                If Not (lProc = 0) Then
                    stRetOut(li).szRuta = GetPatchInfo(Mid$(sTmp, 1, GetModuleFileNameExA(lProc, 0, sTmp, MAX_PATH)), Ruta)
                    CloseHandle lProc
                End If
                stRetOut(li).dwPid = PE32.th32ProcessID
                li = (li + 1)
            End If
        End If
        Mid$(PE32.szExeFile, 1, MAX_PATH) = String(MAX_PATH, Chr(0))
        lhFind = Process32Next(hCTS, PE32)
    Wend
    CloseHandle hCTS
    If (li > 0) Then
        GetProcess = (li + 1)
    Else
        GetProcess = 0
    End If
End Function
 
' ////////////////////////////////////////////////////////////////
' // http://infrangelux.hostei.com/index.php?option=com_content&view=article&id=17:artgetpatchinfo&catid=2:catprocmanager&Itemid=8
' ////////////////////////////////////////////////////////////////
Public Function GetPatchInfo(ByVal StrRutaFull As String, Optional ByVal Options As GetFileStr = FileName) As String
Dim lng_ptr(1)              As Long
Dim lng_aux                 As Long
     lng_aux = Len(StrRutaFull)
     lng_ptr(0) = InStrRev(StrRutaFull, "\")
     If lng_ptr(0) > 0 Then
         lng_ptr(1) = InStrRev(StrRutaFull, ".")
         If lng_ptr(1) > 0 And Not lng_ptr(0) < lng_ptr(1) Then
             lng_ptr(1) = lng_aux + 1
         End If
         If (Options And Ruta) = Ruta Then
             GetPatchInfo = Mid$(StrRutaFull, 1, lng_ptr(0)) & GetPatchInfo
         End If
         If (Options And FileName) = FileName Then
             If lng_ptr(1) = lng_aux Then
                 lng_aux = lng_aux - lng_ptr(0) - 1
             Else
                 lng_aux = lng_ptr(1) - lng_ptr(0) - 1
             End If
             GetPatchInfo = GetPatchInfo & Mid$(StrRutaFull, lng_ptr(0) + 1, lng_aux)
         End If
         If (Options And Extensión) = Extensión Then
             GetPatchInfo = GetPatchInfo & Mid$(StrRutaFull, lng_ptr(1), lng_ptr(1))
         End If
     End If
End Function