Функция QueryFullProcessImageName врёт и возвращает неправильный, уже не существующий, путь к исполняемому файлу

@HackerVlad · Регистрация: 10.09.2021

Студворк — интернет-сервис помощи студентам

Столкнулся сегодня с небывалом чудом. Функция QueryFullProcessImageName врёт и возвращает не правду, наглую ложь и враньё. Позор Microsoft'у! Я такого от Microsoft'а не ожидал, честно! Баг майкрософта!!!

Всё началось с того, что я решил написать простенькую функцию AppPath для получения пути к своему исполняемому файлу с учётом уникодных символов, с китайскими иероглифами или другими сложными уникодными символами, в пути, в именах папок. Конечно стандартный App.Path нам такого не вернёт, но в стандартном App.Path хотя бы не врёт с получением правильного пути. Хоть и не поддерживает уникод.

Итак сначала я создал новый проект:

Форма:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Option Explicit
Private Declare Function QueryFullProcessImageName Lib "kernel32" Alias "QueryFullProcessImageNameW" (ByVal hProcess As Long, ByVal dwFlags As Long, ByVal lpExeName As Long, lpdwSize As Long) As Long
Private Const MAX_PATH As Long = 260
 
Public Function AppPath() As String
    Dim strProcName As String
    Dim lStr As Long
    
    strProcName = Space$(MAX_PATH * 2): lStr = MAX_PATH
    QueryFullProcessImageName -1, 0, StrPtr(strProcName), lStr
    strProcName = Left$(strProcName, lStr)
    
    AppPath = Left$(strProcName, InStrRev(strProcName, "\"))
End Function
 
Private Sub Command1_Click()
    Me.Cls
    PrintW Chr(34) & AppPath & Chr(34), Me
End Sub
 
Private Sub Command2_Click()
    Me.Cls
    PrintW Chr(34) & App.Path & Chr(34), Me
End Sub

Модуль:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Option Explicit
Private Declare Function DrawText Lib "user32" Alias "DrawTextW" (ByVal hdc As Long, ByVal lpStr As Long, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
 
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
Private Const DT_CENTER = &H1
Private Const DT_SINGLELINE = &H20
Private Const DT_VCENTER = &H4
 
Public Function PrintW(PrintText As String, PrintForm As Form)
    Dim myRect As RECT
    
    myRect.Left = 0
    myRect.Top = 0
    myRect.Right = PrintForm.ScaleWidth
    myRect.Bottom = PrintForm.ScaleHeight
    
    DrawText PrintForm.hdc, StrPtr(PrintText), Len(PrintText), myRect, DT_SINGLELINE Or DT_VCENTER Or DT_CENTER
End Function

В форме ScaleMode выставил на пиксели. Далее всё заработало правильно как надо. Скомпилировал EXE, вышел из VB6 так как он и не сможет запуститься вообще, если проект находится в папках с уникодными сложными символами, с китайщиной.

Переименовал свою папку с программой в "App.Path с китайскими иероглифами 拷贝" для теста, как будет работать функция.
Запустил EXE и первый раз функция сработала правильно! Потом переименовал папку в другое имя, для проверки. Переименовал в "App.Path с китайскими иероглифами ñ" и решил проверить, в результате получил в пути старое имя папки! Майкрософтовская функция QueryFullProcessImageName даже и не подумала обновить путь к EXE-файлу! Ладно, подумал может это лёгкий баг и нужно просто перезапустить программу заного. Полностью закрыл, потом открыл программу снова! И то же самое! Опять старый путь с китайскими символами!!!! Я был в шоке! Потом 10 раз закрывал и перезапускал и всё так же старая папка с китайщиной. И самое смешное то, что стандартный App.Path правильно меняет путь и китайских символов в пути уже нет, НО конечно не поддерживает букву n диакритическую с тильдой сверху буквы.

Вопрос почему функция майкрософта такая ерундовая!? И как правильно получать путь в уникоде чтобы небыло этой ерунды со старыми путями, после переименовывания папок...

@HackerVlad · 04.11.2026, 18:43 **[ТС]**

Кстати я по такой же самой системе чтения PEB сделал ещё и перечисление модулей 64-битного процесса, пусть это будет EnumProcessModules64:
Для теста я здесь показываю как перечислить все модули 64-битного процесса Explorer.exe. Для обнаружения самого процесса Explorer.exe используется лёгкая функция GetShellWindow. А так это просто демонстрационный пример как перечислить все 64-битные модули внутри 64-битного процесса из 32-битного своего процесса:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
Option Explicit
 
Private Declare Function NtWow64QueryInformationProcess64 Lib "ntdll" (ByVal ProcessHandle As Long, ByVal InformationClass As Long, ByRef ProcessInformation As Any, ByVal ProcessInformationLength As Long, ByRef ReturnLength As Long) As Long
Private Declare Function NtWow64ReadVirtualMemory64 Lib "ntdll" (ByVal hProcess As Long, ByVal BaseAddress As Currency, ByRef Buffer As Any, ByVal BufferLengthL As Long, ByVal BufferLengthH As Long, ByRef ReturnLength As Currency) 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 GetShellWindow Lib "user32" () As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
 
Private Const STATUS_SUCCESS As Long = 0
Private Const PROCESS_QUERY_INFORMATION As Long = &H400
Private Const PROCESS_VM_READ As Long = &H10
 
Private Type LISTENTRY64
    Flink As Currency
    Blink As Currency
End Type
 
Private Type UNICODESTRING64
    Length As Integer
    MaximumLength As Integer
    pad As Long
    lpBuffer As Currency
End Type
 
Private Type pbi64
    ExitStatus As Long
    pad1 As Long
    PebBaseAddress As Currency
    AffinityMask As Currency
    BasePriority As Long
    pad2 As Long
    UniqueProcessId As Currency
    InheritedFrom As Currency
End Type
 
Private Type LDRDATA64
    pad(0 To 15) As Byte
    InLoadOrder As LISTENTRY64
End Type
 
Private Type LDRENTRY64
    InLoadOrder As LISTENTRY64
    InMemoryOrder As LISTENTRY64
    InInitOrder As LISTENTRY64
    DllBase As Currency
    EntryPoint As Currency
    SizeOfImage As Long
    pad1 As Long
    FullDllName As UNICODESTRING64
End Type
 
Public Function EnumModules64(ByVal pid As Long, ByRef modules As Collection) As Boolean
    Dim hProc As Long
    Dim pbi64 As pbi64
    Dim ldrPtr As Currency
    Dim ldr64 As LDRDATA64
    Dim entry64 As LDRENTRY64
    Dim head As Currency, cur As Currency
    Dim strName As String
    Dim guard As Long
    Dim ntst As Long
 
    Set modules = New Collection
 
    hProc = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, pid)
    If hProc = 0 Then Exit Function
 
    ntst = NtWow64QueryInformationProcess64(hProc, 0, pbi64, Len(pbi64), 0)
    If ntst <> STATUS_SUCCESS Or pbi64.PebBaseAddress = 0 Then GoTo Done
 
    ' PEB64 + 0x18 = PEB_LDR_DATA64 (24 байта = 0.0024@ в Currency)
    ntst = NtWow64ReadVirtualMemory64(hProc, pbi64.PebBaseAddress + 0.0024@, ldrPtr, 8, 0, 0)
    If ntst <> STATUS_SUCCESS Or ldrPtr = 0 Then GoTo Done
 
    ntst = NtWow64ReadVirtualMemory64(hProc, ldrPtr, ldr64, Len(ldr64), 0, 0)
    If ntst <> STATUS_SUCCESS Then GoTo Done
 
    head = ldrPtr + 0.0016@
    cur = ldr64.InLoadOrder.Flink
 
    Do While cur <> 0 And cur <> head
        guard = guard + 1
        If guard > 4096 Then Exit Do
 
        ntst = NtWow64ReadVirtualMemory64(hProc, cur, entry64, Len(entry64), 0, 0)
        If ntst <> STATUS_SUCCESS Then Exit Do
 
        If entry64.FullDllName.Length > 0 Then
            strName = Space$(entry64.FullDllName.Length \ 2)
            If NtWow64ReadVirtualMemory64(hProc, entry64.FullDllName.lpBuffer, _
                ByVal StrPtr(strName), entry64.FullDllName.Length, 0, 0) = STATUS_SUCCESS Then
                modules.Add strName
            End If
        End If
 
        cur = entry64.InLoadOrder.Flink
    Loop
 
    EnumModules64 = (modules.Count > 0)
 
Done:
    If hProc <> 0 Then CloseHandle hProc
End Function
 
Public Function GetExePath64(ByVal pid As Long) As String
    Dim hProc As Long
    Dim pbi64 As pbi64
    Dim paramPtr As Currency
    Dim uds As UNICODESTRING64
    Dim ntst As Long
 
    hProc = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, pid)
    If hProc = 0 Then Exit Function
 
    ntst = NtWow64QueryInformationProcess64(hProc, 0, pbi64, Len(pbi64), 0)
    If ntst = STATUS_SUCCESS And pbi64.PebBaseAddress <> 0 Then
        ' PEB64 + 0x20 = ProcessParameters (32 = 0.0032@)
        ntst = NtWow64ReadVirtualMemory64(hProc, pbi64.PebBaseAddress + 0.0032@, paramPtr, 8, 0, 0)
        If ntst = STATUS_SUCCESS And paramPtr <> 0 Then
            ' ProcessParameters + 0x60 = ImagePathName (96 = 0.0096@)
            ntst = NtWow64ReadVirtualMemory64(hProc, paramPtr + 0.0096@, uds, Len(uds), 0, 0)
            If ntst = STATUS_SUCCESS And uds.Length > 0 Then
                GetExePath64 = Space$(uds.Length \ 2)
                NtWow64ReadVirtualMemory64 hProc, uds.lpBuffer, _
                    ByVal StrPtr(GetExePath64), uds.Length, 0, 0
            End If
        End If
    End If
 
    If hProc <> 0 Then CloseHandle hProc
End Function
 
' ===== Демо =====
Private Sub Command1_Click()
    Dim col As New Collection
    Dim i As Long
    
    Debug.Print GetExePath64(GetMainExplorerPID) ' GetMainExplorerPID — explorer.exe
    
    If EnumModules64(2036, col) Then
        For i = 1 To col.Count
            Debug.Print i; ": "; col(i)
        Next
    Else
        Debug.Print "EnumModules64 failed"
    End If
End Sub
 
Public Function GetMainExplorerPID() As Long
    Dim pid As Long
    If GetShellWindow() <> 0 Then GetWindowThreadProcessId GetShellWindow(), pid
    GetMainExplorerPID = pid
End Function

Новые блоги и статьи Все статьи Все блоги /
Часы с термометром и праздничным календарем yariko 12.11.2026 Сегодня мы рассмотрим как можно сделать отличные многофункциональные часы. Итак, поставим конкретную задачу: разработать часы с календарем, двумя термодатчиками, выводом поздравительных сообщений. . .	Транслитерация текста с кириллицы на латиницу (вариант №1) Maks 11.11.2026 Решил облегчить жизнь себе и коллегам админам при создании электронных почтовых ящиков для пользователей, в результате написал обработку "Транслитерация текста" с кириллицы на латиницу, а в ней. . .	Книги по геймдизайну, левел-дизайну, игровым механикам и проектированию игрового опыта 8Observer8 08.11.2026 Содержание блога \| English Version 1. 2003 - 06 - Designing Virtual Worlds (1st Edition) Автор: Richard A. Bartle \| Объем: 768 стр. Ссылки: Amazon . . .	Родители токсичные абьюзеры по отношению к своим детям ругают их оскорбляют не любят zorxor 08.11.2026 Жить в атмосфере постоянных оскорблений, критики и холодности со стороны родителей — это тяжелое и болезненное испытание, которое оставляет глубокие эмоциональные раны. Токсичное и абьюзивное. . .
Как только я захожу к себе в свою комнату я сразу же с себя снимаю свои трусы. Ответ от Джемени ИИ. zorxor 08.11.2026 Джемени, как только я захожу к себе в свою комнату я сразу же с себя снимаю свои трусы. Многие люди, возвращаясь домой, сразу переодеваются в максимально свободную одежду или вовсе предпочитают. . .	Паттерн очереди действий/команд (Action / Command Queue). Система очереди действий и кат-сцен с SDL3 Callbacks, cglm и OpenGL 8Observer8 07.11.2026 Содержание блога \| English Version Руководство для начинающих по реализации паттерна очереди действий/ команд (Action / Command Queue) на C++ (C++20) с использованием официального SDL3 Callbacks. . .	Проверка полного ФИО в типовом справочнике Maks 07.11.2026 Решение реализовано в конфигурации КА2, на примере справочника "КонтактныеЛицаПартнеров". Задача: Запрет инициалов. Не допускаеть использование сокращений вида "И. И. ", "И. И. ", "И И" и. . .	Про "Windows must die!" kumehtar 04.11.2026 Знаете, чет накатило. . . . Когда-то это было почти боевым кличем: мол, нормальный человек сидит на DOS, OS/ 2 или Linux, а вот это вот - Must Die. А теперь человек произносит «мастдай» с усмешкой - и. . .