This is a new user-friendly module for defining full paths to all processes in the system, even for all system processes, in all versions of Windows. It works even without administrator rights, even under the Guest account. This is a continuation of the project from fafalone with significant changes.
All the functions presented in this module are a completely new software product. My main goal was to ensure that the full paths to the processes were determined correctly. Even if you renamed the folder with the executable program and started it again from the renamed folder. In versions prior to Windows 10, if you run the program a second time from a renamed folder, the system incorrectly determines the full path to the process (the system outputs the old path to the folder).
The main improvements in this project are:
Description of functions:
It is best to use the GetProcessFullPathUniversal function, since it is it that will first determine the Windows version and if Windows is before to Windows 10, then the GetProcessFullPathCorrect function will be called first and if this function does not determine the path to the process (since the process is a system process), then the GetProcessFullPathNt function will be called. But if you have Windows starting from the Windows 10 version, then the GetProcessFullPathNt function will be executed immediately.
At the moment, this code only works from 32-bit compilations (VB6 or Twin Basic). So far, I haven't made it compatible with TwinBasic and VBA7 to support 64-bit versions, but I'll leave that as an exercise for you if you really need it.
Module code:
All the functions presented in this module are a completely new software product. My main goal was to ensure that the full paths to the processes were determined correctly. Even if you renamed the folder with the executable program and started it again from the renamed folder. In versions prior to Windows 10, if you run the program a second time from a renamed folder, the system incorrectly determines the full path to the process (the system outputs the old path to the folder).
The main improvements in this project are:
- Correct identification of full paths to all processes in the system
- Performance - it works very fast, faster even than in the fafalone project, if we compare the functions GetProcessFullPathNt from HackerVlad and GetProcessFullPathEx from fafalone (on average 300 ms faster, in 200 thousand cycles).
- Windows XP support, this code also works in the old Windows XP, maybe even in Windows 2000...
- A new drive caching system, using a two-dimensional array, to speed up the definition of complete paths, in my function, you can optionally enable or disable this caching feature (Caching parameter).
- Correct path detection, if you start a new process from a new drive, from a removable USB media, if a new disk suddenly appears in the system, for example, a USB flash drive.
- For super-fast determination of full paths, there is an additional, optional, SaveSystemPath parameter, if someone suddenly needs to get the system path to the process in large cycles, as the system itself does.
Description of functions:
- GetProcessFullPathUniversal is a universal function, and it's best to use it for all versions of Windows. It is guaranteed to accurately and correctly determine the path to the process, even if the program folder was renamed and the process was restarted again from the renamed folder!
- GetProcessFullPathCorrect is a function that correctly determines the path to the process, a two-stage reading technology is used, for 32-bit processes this is a function from psapi.dll and for 64-bit processes, this is reading the PEB structure followed by command line parsing, a special API function to extract the path to the EXE process.
- GetProcessFullPathNt - I wrote this function myself, based on the work of fafalone, the NtQuerySystemInformation function with the SystemProcessIdInformation class is used for reading to get the path to any processes, even all system processes, without administrator rights. But this function may can deceive, and show the wrong paths, before Windows 10. Therefore, it is not advisable to use it all the time.
- QueryFullProcessImageName is the slowest function from Microsoft, which is better never to use, but for comparison, I included it in my speed tests. This feature has many disadvantages. It is slow, it only works starting from Windows Vista, it does not see system processes, it incorrectly determines paths if you restart the EXE process from a renamed folder, so it is better never to use this function at all.
It is best to use the GetProcessFullPathUniversal function, since it is it that will first determine the Windows version and if Windows is before to Windows 10, then the GetProcessFullPathCorrect function will be called first and if this function does not determine the path to the process (since the process is a system process), then the GetProcessFullPathNt function will be called. But if you have Windows starting from the Windows 10 version, then the GetProcessFullPathNt function will be executed immediately.
At the moment, this code only works from 32-bit compilations (VB6 or Twin Basic). So far, I haven't made it compatible with TwinBasic and VBA7 to support 64-bit versions, but I'll leave that as an exercise for you if you really need it.
Module code:
Code:
Option Explicit
'/////////////////////////////////////////////////////////////////////////////////
'// Module for correctly get the full path processes in all versions of Windows //
'// Copyright (c) 2024-12-19 by HackerVlad //
'// E-mail: vladislavpeshkov@ya.ru //
'// Version 3.5 //
'/////////////////////////////////////////////////////////////////////////////////
' API declarations ...
Private Declare Function NtQuerySystemInformation Lib "ntdll" (ByVal infoClass As Long, Buffer As Any, ByVal BufferSize As Long, ret As Long) As Long
Private Declare Function GetMem4 Lib "msvbvm60" (ByVal src As Long, dst As Any) As Long
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long)
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsW" (ByVal nBufferLength As Long, ByVal lpBuffer As Long) As Long
Private Declare Function QueryDosDevice Lib "kernel32" Alias "QueryDosDeviceW" (ByVal lpDeviceName As Long, ByVal lpTargetPath As Long, ByVal ucchMax As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString 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 GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryW" (ByVal lpBuffer As Long, ByVal uSize As Long) As Long
Private Declare Function GetModuleFileNameExW Lib "psapi" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As Long, ByVal nSize As Long) As Long
Private Declare Function SysAllocStringLen Lib "oleaut32" (ByVal olestr As Long, ByVal Length As Long) As Long
Private Declare Function CommandLineToArgv Lib "shell32" Alias "CommandLineToArgvW" (ByVal lpCmdLine As Long, pNumArgs As Integer) As Long
Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub SysFreeString Lib "oleaut32" (ByVal bstr As Long)
Private Declare Sub GetNativeSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
Private Declare Function IsWow64Process Lib "kernel32" (ByVal hProc As Long, bWow64Process As Long) As Long
' Undocumented APIs ...
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
' Constants ...
Private Const SystemProcessIdInformation = 88
Private Const ProcessBasicInformation = 0
Private Const STATUS_SUCCESS As Long = 0
Private Const MAX_PATH = 260
Private Const PROCESS_QUERY_INFORMATION = 1024
Private Const PROCESS_VM_READ = 16
Private Const PROCESSOR_ARCHITECTURE_AMD64 As Integer = 9
Private Const PROCESSOR_ARCHITECTURE_IA64 As Integer = 6
' Types ...
Private Type UNICODE_STRING
Length As Integer
MaxLength As Integer
lpBuffer As Long
End Type
Private Type SYSTEM_PROCESS_ID_INFORMATION
ProcessId As Long
ImageName As UNICODE_STRING
End Type
Private Type PROCESS_BASIC_INFORMATION_WOW64
ExitStatus As Long
Reserved0 As Long
PebBaseAddress As Currency
AffinityMask As Currency
BasePriority As Long
Reserved1 As Long
UniqueProcessId As Currency
InheritedFromUniqueProcessId As Currency
End Type
Private Type UNICODE_STRING64
Length As Integer
MaxLength As Integer
Fill As Long
lpBuffer As Currency
End Type
Private Type SYSTEM_INFO
wProcessorArchitecture As Integer
wReserved As Integer
dwPageSize As Long
lpMinimumApplicationAddress As Long
lpMaximumApplicationAddress As Long
dwActiveProcessorMask As Long
dwNumberOrfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
wProcessorLevel As Integer
wProcessorRevision As Integer
End Type
' Variables for caching ...
Dim MajorWinVer As Long
Dim ArrDosDevice() As String
Dim IsInitArrDosDevice As Boolean, IsInitMyOSIs64bit As Boolean, MyOSIs64bit As Boolean
' Its my function that caches data and replaces the QueryDosDevice call API
Private Function MyQueryDosDeviceCache(ByVal lpDeviceName As String) As String
Dim countChars As Long, i As Long, cnt As Long
Dim DosDeviceName As String
If IsInitArrDosDevice = True Then
For i = 0 To UBound(ArrDosDevice, 2)
If ArrDosDevice(0, i) = lpDeviceName Then
MyQueryDosDeviceCache = ArrDosDevice(1, i)
Exit Function
End If
Next
cnt = UBound(ArrDosDevice, 2) + 1 ' Since the position we need has not been found, we need to add a new position
End If
DosDeviceName = Space$(2048)
countChars = QueryDosDevice(StrPtr(lpDeviceName), StrPtr(DosDeviceName), 2048)
If countChars > 0 Then
DosDeviceName = Left$(DosDeviceName, countChars)
DosDeviceName = Replace$(DosDeviceName, vbNullChar, "")
End If
ReDim Preserve ArrDosDevice(1, cnt) As String
ArrDosDevice(0, cnt) = lpDeviceName
ArrDosDevice(1, cnt) = DosDeviceName
IsInitArrDosDevice = True
MyQueryDosDeviceCache = DosDeviceName
End Function
' Get the full path to the process using the NtQuerySystemInformation function
' Before Windows 10, sometimes it may incorrect to get the path to the process
Public Function GetProcessFullPathNt(ByVal pid As Long, Optional SaveSystemPath As Boolean, Optional Caching As Boolean = True) As String
Dim ProcName As String, sDrives As String, strBuff As String, DosDeviceName As String
Dim cbRet As Long, cbMax As Long, cnt As Long, i As Long
Dim spii As SYSTEM_PROCESS_ID_INFORMATION
Dim aDrive() As String
If pid = 0 Then
GetProcessFullPathNt = "[System idle process]"
ElseIf pid = 4 Then
GetProcessFullPathNt = "[System]"
End If
If pid = 0 Or pid = 4 Then Exit Function
cbMax = MAX_PATH * 2
PutMem4 VarPtr(ProcName), SysAllocStringLen(0&, cbMax)
spii.ProcessId = pid ' Fafalone wrote this line of code
spii.ImageName.MaxLength = cbMax ' Fafalone wrote this line of code
spii.ImageName.lpBuffer = StrPtr(ProcName) ' HackerVlad wrote this line of code
If NtQuerySystemInformation(SystemProcessIdInformation, spii, LenB(spii), cbRet) >= 0 Then ' Technology from fafalone
ProcName = Left$(ProcName, spii.ImageName.Length / 2)
GetProcessFullPathNt = ProcName
If SaveSystemPath = False Then
PutMem4 VarPtr(sDrives), SysAllocStringLen(0&, 2048)
cnt = GetLogicalDriveStrings(2048, StrPtr(sDrives)) ' HackerVlad's technology of getting all the letters of the drives
If Err.LastDllError = 0 Then
aDrive = Split(Left$(sDrives, cnt - 1), vbNullChar)
For i = 0 To UBound(aDrive)
If Caching = True Then
DosDeviceName = MyQueryDosDeviceCache(Left$(aDrive(i), 2)) & "\" ' HackerVlad's caching technology
Else
PutMem4 VarPtr(strBuff), SysAllocStringLen(0&, 2048)
If QueryDosDevice(StrPtr(Left$(aDrive(i), 2)), StrPtr(strBuff), 2048) Then
DosDeviceName = Left$(strBuff, lstrlen(StrPtr(strBuff))) & "\"
End If
SysFreeString StrPtr(strBuff)
End If
If Left$(ProcName, Len(DosDeviceName)) = DosDeviceName Then
GetProcessFullPathNt = Left$(aDrive(i), 2) & Mid$(ProcName, Len(DosDeviceName))
Exit Function
Else
If InStr(1, ProcName, DosDeviceName, vbTextCompare) > 0 Then ' Retrying
GetProcessFullPathNt = Replace$(ProcName, DosDeviceName, Left$(aDrive(i), 2) & "\", 1, 1, vbTextCompare)
Exit Function
End If
End If
Next
End If
End If
End If
End Function
' This function should get the correct paths, unlike another functions which can sometimes cheat
Public Function GetProcessFullPathCorrect(ByVal pid As Long) As String
Dim hProc As Long, lpwstr As Long, CmdStringPtr As Long, lengthPathWinDir As Long, IsProcRunWOW64 As Long
Dim strProcName As String, strProcName2 As String, PathWinDir As String
Dim pbi64 As PROCESS_BASIC_INFORMATION_WOW64
Dim cmd64 As UNICODE_STRING64
Dim pParam64 As Currency
Dim cnt As Integer
If pid = 0 Then
GetProcessFullPathCorrect = "[System idle process]"
ElseIf pid = 4 Then
GetProcessFullPathCorrect = "[System]"
End If
If pid = 0 Or pid = 4 Then Exit Function
hProc = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, pid)
If hProc > 0 Then
' First of all, you need to find out if the OS is 32-bit or 64-bit?
If IsInitMyOSIs64bit = False Then
Dim si As SYSTEM_INFO
GetNativeSystemInfo si
MyOSIs64bit = (si.wProcessorArchitecture = PROCESSOR_ARCHITECTURE_AMD64 Or si.wProcessorArchitecture = PROCESSOR_ARCHITECTURE_IA64)
IsInitMyOSIs64bit = True
End If
If MyOSIs64bit = True Then IsWow64Process hProc, IsProcRunWOW64
If IsProcRunWOW64 = 1 Or MyOSIs64bit = False Then ' 32-bit process
strProcName = Space$(MAX_PATH)
If GetModuleFileNameExW(hProc, 0, StrPtr(strProcName), MAX_PATH) Then
strProcName = Left$(strProcName, lstrlen(StrPtr(strProcName)))
End If
Else ' 64-bit process
#If Win32 Then
If NtWow64QueryInformationProcess64(hProc, ProcessBasicInformation, pbi64, Len(pbi64), 0) = STATUS_SUCCESS Then
If NtWow64ReadVirtualMemory64(hProc, pbi64.PebBaseAddress + 0.0032@, pParam64, Len(pParam64), 0, 0) = STATUS_SUCCESS Then
If NtWow64ReadVirtualMemory64(hProc, pParam64 + 0.0112@, cmd64, Len(cmd64), 0, 0) = STATUS_SUCCESS Then
If cmd64.Length > 0 Then
strProcName = Space$(cmd64.Length / 2) ' We allocate a buffer of sufficient length
NtWow64ReadVirtualMemory64 hProc, cmd64.lpBuffer, ByVal StrPtr(strProcName), cmd64.Length, 0, 0
If Len(strProcName) > 0 Then
strProcName2 = strProcName
strProcName = vbNullString
lpwstr = CommandLineToArgv(StrPtr(strProcName2), cnt)
If lpwstr Then
GetMem4 lpwstr, CmdStringPtr
PutMem4 VarPtr(strProcName), SysAllocStringLen(CmdStringPtr, lstrlen(CmdStringPtr))
LocalFree lpwstr
End If
End If
End If
End If
End If
End If
#End If
End If
CloseHandle hProc
If Left$(strProcName, 12) = "\SystemRoot\" And strProcName <> "\SystemRoot\" Then
PutMem4 VarPtr(PathWinDir), SysAllocStringLen(0&, MAX_PATH)
lengthPathWinDir = GetWindowsDirectory(StrPtr(PathWinDir), MAX_PATH)
PathWinDir = Left$(PathWinDir, lengthPathWinDir)
strProcName = PathWinDir & Mid$(strProcName, 12)
End If
If Left$(strProcName, 13) = "%SystemRoot%\" And strProcName <> "%SystemRoot%\" Then
If Len(PathWinDir) = 0 Then
PutMem4 VarPtr(PathWinDir), SysAllocStringLen(0&, MAX_PATH)
lengthPathWinDir = GetWindowsDirectory(StrPtr(PathWinDir), MAX_PATH)
PathWinDir = Left$(PathWinDir, lengthPathWinDir)
End If
strProcName = PathWinDir & Mid$(strProcName, 13)
End If
If Left$(strProcName, 4) = "\??\" And strProcName <> "\??\" Then
strProcName = Mid$(strProcName, 5)
End If
GetProcessFullPathCorrect = strProcName
End If
End Function
' Universal function
Public Function GetProcessFullPathUniversal(ByVal pid As Long, Optional Caching As Boolean = True) As String
Dim MajorWindowsVersion As Long
Dim ProcName As String
If pid = 0 Then
GetProcessFullPathUniversal = "[System idle process]"
ElseIf pid = 4 Then
GetProcessFullPathUniversal = "[System]"
End If
If pid = 0 Or pid = 4 Then Exit Function
If MajorWinVer = 0 Then
GetMem4 &H7FFE026C, MajorWindowsVersion ' Get the Windows version
MajorWinVer = MajorWindowsVersion ' Save
End If
If MajorWinVer < 10 Then ' Old versions Windows
ProcName = GetProcessFullPathCorrect(pid) ' Technology from HackerVlad
Else ' Windows 10 and latter
GetProcessFullPathUniversal = GetProcessFullPathNt(pid, , Caching) ' Technology from fafalone
Exit Function
End If
If InStr(1, ProcName, "\") = 0 Then ' Retrying
ProcName = GetProcessFullPathNt(pid, , Caching) ' Technology from fafalone
End If
GetProcessFullPathUniversal = ProcName
End Function