Option Explicit

Private Const PROCESS_QUERY_INFORMATION     As Long = 1024
Private Const PROCESS_VM_READ               As Long = 16
Private Const MAX_PATH                      As Long = 260
Private Const TH32CS_SNAPPROCESS            As Long = &H2

Private Declare Function CloseHandle Lib "Kernel32.dll" (ByVal Handle As Long) As Long
Private Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal lProc As Long, ByVal hModule As Long, ByVal sName As String, ByVal lSize As Long) As Long
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 lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Function GetModuleBaseNameA Lib "psapi.dll" (ByVal lProc As Long, ByVal hModule As Long, ByVal lpBaseName As String, ByVal lSize 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 * MAX_PATH
End Type

Private Function GetPathFromProcName(ByVal sName As String, Optional ByVal bCaseSensitive As Boolean = False) As String

    Dim hSnapShot   As Long
    Dim uProcess    As PROCESSENTRY32
    Dim lRet        As Long
    Dim sExe        As String

    If Not bCaseSensitive Then
        sName = UCase(sName)
    End If

    hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
    uProcess.dwSize = Len(uProcess)
    
    lRet = Process32First(hSnapShot, uProcess)

    Do While lRet
        sExe = Left$(uProcess.szExeFile, lstrlen(uProcess.szExeFile))
        If Not bCaseSensitive Then sExe = UCase(sExe)
        If sExe = sName Then
            GetPathFromProcName = ProcessPathByPID(uProcess.th32ProcessID)
            Exit Do
        End If
        lRet = Process32Next(hSnapShot, uProcess)
    Loop

    CloseHandle hSnapShot

End Function

Public Function ProcessPathByPID(ByVal lPID As Long, Optional ByVal bBase As Boolean) As String
    Dim lNeed               As Long
    Dim lvMods(1 To 200)    As Long
    Dim lRet                As Long
    Dim sName               As String * MAX_PATH
    Dim lSize               As Long
    Dim lProc               As Long

    lProc = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lPID)
            
    If Not lProc = 0 Then
                
        If EnumProcessModules(lProc, lvMods(1), 200, lNeed) Then
            If bBase Then
                lRet = GetModuleBaseNameA(lProc, lvMods(1), sName, MAX_PATH)
            Else
                lRet = GetModuleFileNameExA(lProc, lvMods(1), sName, MAX_PATH)
            End If
            If lRet = 0 Then
                ProcessPathByPID = "SYSTEM"
            Else
                ProcessPathByPID = Left$(sName, lRet)
            End If
        End If
        Call CloseHandle(lProc)
        
    Else
        ProcessPathByPID = "UNKNOWN"
    End If
    
End Function

'---------------------------------------------------------------------------------------
' Module      : mPathFromPid
' DateTime    : 12/09/2008 08:52
' Author      : Cobein
' Mail        : cobein27@hotmail.com
' WebPage     : http://www.advancevb.com.ar
' Purpose     : Return path to the executable from PID
' Usage       : At your own risk
' Requirements: None
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce
'               or publish this code on any web site,
'               online service, or distribute as source
'               on any media without express permission.
'
' Reference   : http://support.microsoft.com/default.aspx?scid=kb;en-us;187913
'
' History     : 12/09/2008 First Cut....................................................
'---------------------------------------------------------------------------------------
Option Explicit

Private Const PROCESS_QUERY_INFORMATION     As Long = 1024
Private Const PROCESS_VM_READ               As Long = 16
Private Const MAX_PATH                      As Long = 260

Private Declare Function CloseHandle Lib "Kernel32.dll" (ByVal Handle As Long) As Long
Private Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal lProc As Long, ByVal hModule As Long, ByVal sName As String, ByVal lSize As Long) As Long
Private Declare Function GetModuleBaseNameA Lib "psapi.dll" (ByVal lProc As Long, ByVal hModule As Long, ByVal lpBaseName As String, ByVal lSize As Long) As Long

Public Function ProcessPathByPID(ByVal lPID As Long, Optional ByVal bBase As Boolean) As String
    Dim lNeed               As Long
    Dim lvMods(1 To 200)    As Long
    Dim lRet                As Long
    Dim sName               As String * MAX_PATH
    Dim lSize               As Long
    Dim lProc               As Long

    lProc = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lPID)
            
    If Not lProc = 0 Then
                
        If EnumProcessModules(lProc, lvMods(1), 200, lNeed) Then
            If bBase Then
                lRet = GetModuleBaseNameA(lProc, lvMods(1), sName, MAX_PATH)
            Else
                lRet = GetModuleFileNameExA(lProc, lvMods(1), sName, MAX_PATH)
            End If
            If lRet = 0 Then
                ProcessPathByPID = "SYSTEM"
            Else
                ProcessPathByPID = Left$(sName, lRet)
            End If
        End If
        Call CloseHandle(lProc)
        
    Else
        ProcessPathByPID = "UNKNOWN"
    End If
    
End Function