saludos,
estoy intentando sacar la ruta de un proceso, se que en el foro se ha hablado del tema y pese a que he buscado no he encontrado la manera de sacar la ruta sabiendo el nombre del proceso
Hola. Este código permite sacar la ruta del proceso a partir de su hWnd, así que solo tienes que obtener el PID del proceso y luego obtener su hWnd:
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function EnumProcessModules Lib "psapi" (ByVal hProcess As Long, lphModule As Any, cb As Long, lpcbNeeded As Long) As Long
Private Declare Function GetModuleFileNameEx Lib "psapi" Alias "GetModuleFileNameExA" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFileName As String, nSize As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Function ExeFileName(ByVal hWnd As Long) As String
Const PROCESS_QUERY_INFORMATION As Long = &H400&
Const PROCESS_VM_READ As Long = &H10&
Const opFlags As Long = PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ
Const nMaxMods As Long = 256
Const nBaseModule As Long = 1
Const nBytesPerLong As Long = 4
Const MAX_PATH As Long = 260
Dim hModules() As Long
Dim hProcess As Long
Dim nProcessID As Long
Dim nBufferSize As Long
Dim nBytesNeeded As Long
Dim nRet As Long
Dim sBuffer As String
'Get the process ID from the window handle
Call GetWindowThreadProcessId(hWnd, nProcessID)
'Open the process so we can read some module info.
hProcess = OpenProcess(opFlags, False, nProcessID)
If hProcess Then
'Get list of process modules.
ReDim hModules(1 To nMaxMods) As Long
nBufferSize = UBound(hModules) * nBytesPerLong
nRet = EnumProcessModules(hProcess, hModules(nBaseModule), nBufferSize, nBytesNeeded)
If nRet = False Then
'Check to see if we need to allocate more space for results.
If nBytesNeeded > nBufferSize Then
ReDim hModules(nBaseModule To nBytesNeeded \ nBytesPerLong) As Long
nBufferSize = nBytesNeeded
nRet = EnumProcessModules(hProcess, hModules(nBaseModule), nBufferSize, nBytesNeeded)
End If
End If
'Get the module name.
sBuffer = Space$(MAX_PATH)
nRet = GetModuleFileNameEx(hProcess, hModules(nBaseModule), sBuffer, MAX_PATH)
If nRet Then
ExeFileName = Left$(sBuffer, nRet)
End If
'Clean up
Call CloseHandle(hProcess)
End If
End Function
Saludos.
Ops, lei mal, bueno dejo el code por si alguien lo necesita.
Lo que podes hacer es usar CreateToolhelp32Snapshot
Devuelve ruta o nombre
'---------------------------------------------------------------------------------------
' 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
Algo asi
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
muchas gracias a ambos y especialmente a cobein :-*
me había confundido de api :-X