[Sources code] Obtener Path de un programa con el handle de ventana

[x64core]

Hola buenas panas!  
bueno aqui aportando al foro por todo lo que me han ayudado todos por mis dudas   tambien quiero ayudar  
este sources hecho por mi es sencillo es para obtener la ruta de un programa por medio del handle de la ventana:

es sencillo perdon por cualquier error que tenga  

Ejemplo de uso:

Código [Seleccionar] Expandir

msgbox PathEXEWindow(Win) ' donde Win es el handle de la ventana

Código (vb) [Seleccionar] Expandir

Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long


Private Const PROCESS_ALL_ACCESS  As Long = &H1F0FFF
Private Const MAX_PATH = 260

'------------------------------------------------------------------------------------------
' FUNCION: _
-------------------------------------------------------------------------------------------


Function PathEXEWindow(HndW As Long) As String
Dim IDp As Long, HandleProcess As Long
Dim Bufpath As String, LenBuf As Long

Call GetWindowThreadProcessId(HndW, IDp)

HandleProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, IDp)

Bufpath = String$(MAX_PATH, Chr$(0))
LenBuf = MAX_PATH

If 0 = GetModuleFileNameExA(HandleProcess, 0, Bufpath, LenBuf) Then
    MsgBox "No se puede obtener la ruta del proceso Verifique los valores", vbCritical
    Exit Function
End If

PathEXEWindow = Left(Bufpath, LenBuf)
Call CloseHandle(HandleProcess)
End Function

espero que les guste y mas que les sirva  

[BlackZeroX]

.
Solo lo ordene y le añadi una funcion...

Código (vb) [Seleccionar] Expandir




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

Enum GetFileStr
     Extensión = 1
     FileName = 2
     Ruta = 4
End Enum

Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) 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

Private Sub Form_Load()
    MsgBox GetPatchInfohwnd(Me.hwnd, FileName + Extensión)
    MsgBox GetPatchInfohwnd(Me.hwnd, Ruta Or Extensión)
    MsgBox GetPatchInfohwnd(Me.hwnd, Ruta Or Extensión Or FileName)
End Sub

' ////////////////////////////////////////////////////////////////
' // http://infrangelux.hostei.com/index.php?option=com_content&view=article&id=17:artgetpatchinfo&catid=2:catprocmanager&Itemid=8
' ////////////////////////////////////////////////////////////////
Public Function GetPatchInfo(ByRef 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

Public Function GetPatchInfohwnd(ByVal hwnd As Long, Optional GetDir As GetFileStr = Ruta) As String
Dim PID     As Long
Dim lProc   As Long
Dim sTmp    As String * MAX_PATH

    If Not (GetWindowThreadProcessId(hwnd, PID) = 0) Then
        lProc = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, PID)
        If Not (lProc = 0) Then
            GetPatchInfohwnd = GetPatchInfo(Mid$(sTmp, 1, GetModuleFileNameExA(lProc, 0, sTmp, MAX_PATH)), GetDir)
            CloseHandle lProc
        End If
    End If
End Function



Dulces Lunas!¡.

[CAR3S?]

buenisimo, cuando mi imaginacion se reactive, vere si lo uso

[Hasseds]

Otra opción, no será la mas profesional, pero sí otra opción 

Código [Seleccionar] Expandir



Option Explicit

Private Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize 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 GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Function PathExeWindow(ByVal hwnd As Long, ByRef sPath As String) As Long

  Dim HProc As Long, lngPid As Long, lnglen As Long, Bfpath As String * &H104
 
  Call GetWindowThreadProcessId(hwnd, lngPid)
  HProc = OpenProcess(&H410, &H0, lngPid)
  If HProc = 0 Then Exit Function
 
  lnglen = GetModuleFileNameExA(HProc, &H0, Bfpath, &H104)
  Call CloseHandle(HProc)
  If lnglen = 0 Then Exit Function
 
  sPath = Left$(Bfpath, lnglen)
  PathExeWindow = lnglen

End Function

Private Sub Form_Load()
 
  Dim sPath As String

  If PathExeWindow(hwnd, sPath) > 0 Then
    MsgBox sPath, , "sPath"
    MsgBox Mid$(sPath, 1, InStrRev(sPath, "\")), , "sDirectorio"
    MsgBox Mid$(sPath, InStrRev(sPath, "\") + 1), , "sFile"
    MsgBox Mid$(sPath, InStrRev(sPath, ".") + 1), , "sExtencion"
  End If

End Sub



[x64core]

buenoo!