Путь не к своей программу

[Arto]

Здравсивуйте
Мне нужно по HWND определить путь к активной программе

делаю так где sHwnd HWND активного приложения


Option Explicit

Private Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Declare Function GetWindowWord Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long) As Integer
Const GWW_HINSTANCE = (-6)

Public Sub FilePath(sHwnd)

Dim ModuleName As String, FileName As String, hInst As Long
ModuleName = String$(128, Chr$(0))

hInst = GetWindowWord(sHwnd, GWW_HINSTANCE)

ModuleName = Left$(ModuleName, GetModuleFileName(hInst, ModuleName, Len(ModuleName)))

Debug.Print "Module Filename: " + ModuleName & " HWND - " & sHwnd
End Sub

но все время время получаю путь к VB
D:\Program Files\Microsoft Visual Studio\VB98\VB6.EXE

Что я делаю не так
С уважением

[Arto]

Вроде кое что нашел сейчас проверю и дам знать

[Antonariy]

Код: Выделить всё

Option Explicit
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
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function NtQueryInformationProcess Lib "ntdll" (ByVal hProcess As Long, ByVal ProcessInformationClass As Long, ProcessInformation As Any, ByVal ProcessInformationLength As Long, ReturnLength As Long) As Long

Private Type PROCESS_BASIC_INFORMATION
    ExitStatus As Long
    PebBaseAddress As Long  'points to a structure too long to declare
    AffinityMask As Long
    BasePriority As Long
    UniqueProcessId As Long
    InheritedFromUniqueProcessId As Long
End Type

Private Type LIST_ENTRY
    pFlink As Long
    pBlink As Long
End Type

Private Type UNICODE_STRING
    Length As Integer
    MaximumLength As Integer
    Buffer As Long
End Type

Private Type LDR_MODULE
    InLoadOrderModuleList As LIST_ENTRY
    InMemoryOrderModuleList As LIST_ENTRY
    InInitializationOrderModuleList As LIST_ENTRY
    BaseAddress As Long
    EntryPoint As Long
    SizeOfImage As Long
    FullDllName As UNICODE_STRING
    BaseDllName As UNICODE_STRING
    Flags As Long
    LoadCount As Integer
    TlsIndex As Integer
    HashTableEntry As LIST_ENTRY
    TimeDateStamp As Long
End Type

Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const PROCESS_VM_READ = &H10


Private Sub Command1_Click()
Dim hWnd As Long, PID As Long, hProcess As Long
Dim pbi As PROCESS_BASIC_INFORMATION, dummy As Long
Dim ProcessModuleInfo As Long, NextModule As Long
Dim ModuleData As LDR_MODULE
Dim FileName As String
    hWnd = Val(Text1)
    If hWnd = 0 Then Exit Sub
    GetWindowThreadProcessId hWnd, PID
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, PID)
    If hProcess = 0 Then Exit Sub
    NtQueryInformationProcess hProcess, 0, pbi, Len(pbi), dummy
    ReadProcessMemory hProcess, pbi.PebBaseAddress + 12, ProcessModuleInfo, 4, dummy
    ReadProcessMemory hProcess, ProcessModuleInfo + 20, NextModule, 4, dummy
    Do
        ReadProcessMemory hProcess, NextModule - 8, ModuleData, Len(ModuleData), dummy
        NextModule = ModuleData.InMemoryOrderModuleList.pFlink
    Loop Until ModuleData.BaseAddress = &H400000
    FileName = Space$(ModuleData.FullDllName.Length \ 2)
    ReadProcessMemory hProcess, ModuleData.FullDllName.Buffer, ByVal StrPtr(FileName), ModuleData.FullDllName.Length, dummy
    Debug.Print FileName
    CloseHandle hProcess
End Sub

[tyomitch]

Круто. Но GetWindowModuleFileName круче.