I really liked the project from the genius programmer fafalone called "List all protected files on Vista+", and inspired by this project, I decided without hesitation that this very interesting code can be used to determine the full path to system processes. Even if you do not have sufficient rights to view the full path to the EXE file of the system process.
To be honest, I can't even think of anything else to use this fafalone code for, and I don't even know what else a list of all system files might be useful for...
Therefore, I immediately decided that I would make my own project to read a list of all processes with full paths to the EXE files of these processes, for any users. Even if the user account does not have sufficient rights. For example, in the Guest account, any version of Windows from Vista+, you can also get full process paths using this list of all system files. Of course, at the same time, it is impossible to guarantee 100% that this particular path will be for this process, but I think it is possible for 90 percent. Personally, I have only one process that was determined incorrectly. The path to only one process was incorrectly determined, I noted this in the illustration below.
In this project, I use my self-written GetProcessPathName function to determine the full path to the process, to the EXE file. I do not use the QueryFullProcessImageName function as it sometimes cheats and returns the wrong result for operating systems below Windows 10. It so happened that in systems before Windows 10, the operating system has a bug in determining the path to the process, which does not always correctly determine the path to the process. For example, if you run any EXE file from any folder, then close the program, then rename the folder from which this EXE file was launched, and then run this program again, then the OS path will be determined incorrectly (there will be an old file path). This is a bug of the Windows operating system related to excessive caching of folder paths on disk. Therefore, I use other approaches to determine the full path to the process image on disk.
In order to correctly determine the path to the EXE process, you have to read the PEB structure for 64-bit processes using the undocumented functions NtWow64QueryInformationProcess64 and NtWow64ReadVirtualMemory64. And for 32-bit processes, everything is much simpler - just use the GetModuleFileNameExW function from the library psapi.dll this function absolutely always returns the correct result, unlike all other functions.
Thus, I seem to have found the correct implementation to get the full path to the EXE file of the process in memory. But in fact, my GetProcessPathName function could still be improved so that the full path to the process file is returned for absolutely all processes, even if there is no wonderful list of all Windows system files at hand, but I did not do this anymore, since there are very few processes that are not completely determined by my function.
And my main task in this project is to show you that you can use a list of all system-protected files in order to determine the locations of unknown system processes, even when there are no rights to read system processes. Thank God, it is possible to get a list of all system files with the fafalone code, even if you do not have SeDebugPrivilege privileges. This is very gratifying and it gives you access, gives you the opportunity to find out the full paths to system processes. Thus, a special hack is implemented in order to be able to read the full paths to EXE files, even when the current user does not have any rights to do so. So enjoy my wonderful invention. Thanks to fafalone.
To be honest, I can't even think of anything else to use this fafalone code for, and I don't even know what else a list of all system files might be useful for...
Therefore, I immediately decided that I would make my own project to read a list of all processes with full paths to the EXE files of these processes, for any users. Even if the user account does not have sufficient rights. For example, in the Guest account, any version of Windows from Vista+, you can also get full process paths using this list of all system files. Of course, at the same time, it is impossible to guarantee 100% that this particular path will be for this process, but I think it is possible for 90 percent. Personally, I have only one process that was determined incorrectly. The path to only one process was incorrectly determined, I noted this in the illustration below.
In this project, I use my self-written GetProcessPathName function to determine the full path to the process, to the EXE file. I do not use the QueryFullProcessImageName function as it sometimes cheats and returns the wrong result for operating systems below Windows 10. It so happened that in systems before Windows 10, the operating system has a bug in determining the path to the process, which does not always correctly determine the path to the process. For example, if you run any EXE file from any folder, then close the program, then rename the folder from which this EXE file was launched, and then run this program again, then the OS path will be determined incorrectly (there will be an old file path). This is a bug of the Windows operating system related to excessive caching of folder paths on disk. Therefore, I use other approaches to determine the full path to the process image on disk.
In order to correctly determine the path to the EXE process, you have to read the PEB structure for 64-bit processes using the undocumented functions NtWow64QueryInformationProcess64 and NtWow64ReadVirtualMemory64. And for 32-bit processes, everything is much simpler - just use the GetModuleFileNameExW function from the library psapi.dll this function absolutely always returns the correct result, unlike all other functions.
Thus, I seem to have found the correct implementation to get the full path to the EXE file of the process in memory. But in fact, my GetProcessPathName function could still be improved so that the full path to the process file is returned for absolutely all processes, even if there is no wonderful list of all Windows system files at hand, but I did not do this anymore, since there are very few processes that are not completely determined by my function.
And my main task in this project is to show you that you can use a list of all system-protected files in order to determine the locations of unknown system processes, even when there are no rights to read system processes. Thank God, it is possible to get a list of all system files with the fafalone code, even if you do not have SeDebugPrivilege privileges. This is very gratifying and it gives you access, gives you the opportunity to find out the full paths to system processes. Thus, a special hack is implemented in order to be able to read the full paths to EXE files, even when the current user does not have any rights to do so. So enjoy my wonderful invention. Thanks to fafalone.
Code:
Option Explicit
Option Compare Text
Private Declare Function WTSEnumerateProcesses Lib "wtsapi32.dll" Alias "WTSEnumerateProcessesW" (ByVal hServer As Long, ByVal Reserved As Long, ByVal Version As Long, ppProcessInfo As Long, pCount As Long) As Long
Private Declare Function WTSFreeMemory Lib "wtsapi32.dll" (ByVal pMemory As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, ByVal Source As Long, ByVal Length As Long)
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
Private Declare Function SysAllocStringLen Lib "oleaut32" (ByVal olestr As Long, ByVal BLen As Long) As Long
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal ptr As Long, ByVal Value As Long)
Private Declare Function GetMem4 Lib "msvbvm60" (ByVal Addr As Long, ByRef dstValue As Long) As Long
Private Declare Function GetModuleFileNameExW Lib "psapi.dll" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As Long, ByVal nSize 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 OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As Any, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPriv As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Private Const WTS_CURRENT_SERVER_HANDLE = 0
Private Const MAX_PATH As Long = 260
Private Const PROCESS_QUERY_INFORMATION = 1024
Private Const PROCESS_QUERY_LIMITED_INFORMATION As Long = &H1000
Private Const PROCESS_VM_READ = 16
Private Const ProcessBasicInformation = 0
Private Const STATUS_SUCCESS As Long = 0&
Private Const PROCESS_ALL_ACCESS = 2035711
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8
Private Type WTS_PROCESS_INFO
SessionId As Long
ProcessId As Long
pProcessName As Long
pUserSid As Long
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 LUID
lowpart As Long
highpart As Long
End Type
Private Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges As LUID_AND_ATTRIBUTES
End Type
' Undocumented APIs
Private Declare Function NtWow64QueryInformationProcess64 Lib "ntdll.dll" (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.dll" (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
#If VBA7 Then
Private Declare PtrSafe Function BeginFileMapEnumeration Lib "sfc_os.dll" (ByVal Reserved0 As Long, ByVal Reserved1 As LongPtr, Handle As LongPtr) As Long
Private Declare PtrSafe Function CloseFileMapEnumeration Lib "sfc_os.dll" (ByVal Handle As LongPtr) As Long
Private Declare PtrSafe Function GetNextFileMapContent Lib "sfc_os.dll" (ByVal Reserved As Long, ByVal SfcHandle As LongPtr, ByVal Size As LongPtr, ProtectedInfo As PPROTECTED_FILE_INFO, dwNeeded As LongPtr) As Long
#Else
Private Enum LongPtr
[_]
End Enum
Private Declare Function BeginFileMapEnumeration Lib "sfc_os.dll" (ByVal Reserved0 As Long, ByVal Reserved1 As LongPtr, Handle As LongPtr) As Long
Private Declare Function CloseFileMapEnumeration Lib "sfc_os.dll" (ByVal Handle As LongPtr) As Long
Private Declare Function GetNextFileMapContent Lib "sfc_os.dll" (ByVal Reserved As Long, ByVal SfcHandle As LongPtr, ByVal Size As LongPtr, ProtectedInfo As PPROTECTED_FILE_INFO, dwNeeded As LongPtr) As Long
#End If
Private Const ERROR_NO_MORE_FILES As Long = 18
Private Const ERROR_INSUFFICIENT_BUFFER As Long = 122
Private Type PPROTECTED_FILE_INFO
Length As Long
FileName(259) As Integer
End Type
Dim sf() As String
Private Function IsArrayInitialized(arr) As Boolean
Dim saAddress As Long
GetMem4 VarPtr(arr) + 8, saAddress
GetMem4 saAddress, saAddress
IsArrayInitialized = (saAddress <> 0)
If IsArrayInitialized Then IsArrayInitialized = UBound(arr) >= LBound(arr)
End Function
' Set process privileges
Private Function SetPrivilegeProcess(ByVal Enable As Boolean, Optional ProcessId As Long, Optional seName As String = "SeDebugPrivilege") As Boolean
Dim hProcess As Long
Dim ret As Long
Dim p_lngToken As Long
Dim p_lngBufferLen As Long
Dim p_typLUID As LUID
Dim p_typTokenPriv As TOKEN_PRIVILEGES
Dim p_typPrevTokenPriv As TOKEN_PRIVILEGES
If ProcessId > 0 Then
hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, ProcessId)
Else
hProcess = -1
End If
If hProcess Then
If OpenProcessToken(hProcess, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, p_lngToken) Then
ret = LookupPrivilegeValue(0&, seName, p_typLUID)
If ret Then
p_typTokenPriv.PrivilegeCount = 1
p_typTokenPriv.Privileges.Attributes = IIf(Enable, &H2, &H0)
p_typTokenPriv.Privileges.pLuid = p_typLUID
AdjustTokenPrivileges p_lngToken, False, p_typTokenPriv, Len(p_typPrevTokenPriv), p_typPrevTokenPriv, p_lngBufferLen
If Err.LastDllError = 0 Then SetPrivilegeProcess = True
End If
CloseHandle p_lngToken
End If
If ProcessId > 0 Then CloseHandle hProcess
End If
End Function
' This function should get the correct paths, unlike QueryFullProcessImageName which can sometimes cheat
Private Function GetProcessPathName(ByVal pid As Long) As String
Dim hProc As Long
Dim lStr As Long
Dim strProcName As String
Dim cmd64 As UNICODE_STRING64
Dim pbi64 As PROCESS_BASIC_INFORMATION_WOW64
Dim pParam64 As Currency
Dim i As Long
If pid = 4 Then
GetProcessPathName = "[System]"
Exit Function
End If
hProc = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, pid)
If hProc > 0 Then
PutMem4 VarPtr(strProcName), SysAllocStringLen(0&, MAX_PATH)
If GetModuleFileNameExW(hProc, 0, StrPtr(strProcName), MAX_PATH) Then
strProcName = Left$(strProcName, lstrlen(StrPtr(strProcName)))
strProcName = Replace(strProcName, "\??\", vbNullString)
strProcName = Replace(strProcName, "%SystemRoot%", Environ("windir"))
strProcName = Replace(strProcName, "\SystemRoot", Environ("windir"))
GetProcessPathName = strProcName
Else ' 64-bit process
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
lStr = cmd64.Length \ 2 ' We allocate a buffer of sufficient length
PutMem4 VarPtr(strProcName), SysAllocStringLen(0&, lStr)
NtWow64ReadVirtualMemory64 hProc, cmd64.lpBuffer, ByVal StrPtr(strProcName), cmd64.Length, 0, 0
If Mid$(strProcName, 1, 1) = Chr(34) And Len(strProcName) > 1 Then
i = InStr(2, strProcName, Chr(34))
strProcName = Mid$(strProcName, 2, i - 2)
End If
strProcName = Replace(strProcName, vbNullChar, " ")
strProcName = Replace(strProcName, "\??\", vbNullString)
i = 0
i = InStr(1, strProcName, ".exe ")
If i > 0 Then
strProcName = Mid$(strProcName, 1, i + 3)
End If
strProcName = Replace(strProcName, "%SystemRoot%", Environ("windir"))
strProcName = Replace(strProcName, "\SystemRoot", Environ("windir"))
strProcName = Trim$(strProcName)
GetProcessPathName = strProcName
End If
End If
End If
End If
End If
CloseHandle hProc
End If
End Function
Private Function SFCList_Vista() As String()
On Error GoTo ErrorHandler:
Dim dwNeeded As LongPtr
Dim dwBufferSize As Long
Dim pData As PPROTECTED_FILE_INFO
Dim hSFC As LongPtr
Dim ret As Long
Dim SFCList() As String
Dim i As Long
ret = BeginFileMapEnumeration(0&, 0&, hSFC)
If hSFC = 0 Then
'Debug.Print "Error! Cannot get handle of first element of BeginFileMapEnumeration."
Exit Function
Else
'Debug.Print "Init ok"
End If
dwBufferSize = LenB(pData)
ReDim SFCList(300)
Do
ret = GetNextFileMapContent(0&, hSFC, dwBufferSize, pData, dwNeeded)
Select Case Err.LastDllError ' <--- Does not working here !!!
Case 0
If UBound(SFCList) < i Then ReDim Preserve SFCList(i + 100)
SFCList(i) = WCHARtoSTR(pData.FileName)
i = i + 1
Case ERROR_NO_MORE_FILES Or (pData.Length = 0)
Exit Do
Case ERROR_INSUFFICIENT_BUFFER Or (dwNeeded > dwBufferSize)
Debug.Print "ERROR_INSUFFICIENT_BUFFER"
End Select
If pData.Length = 0 Then Exit Do
Loop
CloseFileMapEnumeration hSFC
If i = 0 Then
ReDim SFCList(0)
Else
ReDim Preserve SFCList(i - 1)
End If
SFCList_Vista = SFCList
Exit Function
ErrorHandler:
Debug.Print "SFCList_Vista errorhandler::" & Err.Number & "->" & Err.Description
End Function
Private Function WCHARtoSTR(aCh() As Integer) As String
Dim i As Long
Dim sz As String
For i = LBound(aCh) To UBound(aCh)
If aCh(i) <> 0 Then
sz = sz & ChrW$(CLng(aCh(i)))
End If
Next
WCHARtoSTR = sz
End Function
Private Function SaveFile(FileName As String, Data As String, Optional out As Boolean = True) As Boolean
On Error Resume Next
Dim FileNo As Integer
FileNo = FreeFile
Err.Clear
If out = True Then
Open FileName For Output As FileNo
Print #FileNo, Data;
Close FileNo
Else
Open FileName For Append As FileNo
Print #FileNo, Data;
Close FileNo
End If
If Err.Number > 0 Then
Err.Clear
SaveFile = False
Exit Function
End If
SaveFile = True
End Function
Private Sub Command1_Click()
Dim ppProcessInfo As Long
Dim pCount As Long
Dim WTS As WTS_PROCESS_INFO
Dim ProcessName As String
Dim GetProcessName As String
Dim pVoid As Long
Dim i As Long
Dim i2 As Long
Dim lpString As Long
Dim lpszDomain As String, lpszUsername As String
Dim cbDomain As Long, cbUsername As Long
Dim peUse As Long
Dim strProcName As String
Dim founded As Boolean
If List1.ListCount > 0 Then List1.Clear
If WTSEnumerateProcesses(WTS_CURRENT_SERVER_HANDLE, 0, 1, ppProcessInfo, pCount) > 0 Then
pVoid = ppProcessInfo
For i = 0 To pCount - 1
CopyMemory WTS, pVoid, LenB(WTS)
If WTS.ProcessId > 0 Then
PutMem4 VarPtr(ProcessName), SysAllocStringLen(0, lstrlen(WTS.pProcessName))
lstrcpy StrPtr(ProcessName), WTS.pProcessName
GetProcessName = GetProcessPathName(WTS.ProcessId)
If WTS.ProcessId <> 4 Then
If GetProcessName <> ProcessName And GetProcessName <> vbNullString Then
List1.AddItem Chr(34) & GetProcessName & Chr(34)
Else
founded = False
If IsArrayInitialized(sf) = True Then
For i2 = 0 To UBound(sf)
If Right$(sf(i2), Len(ProcessName) + 1) = "\" & ProcessName Then
strProcName = sf(i2)
strProcName = Replace(strProcName, "\??\", vbNullString)
strProcName = Replace(strProcName, "%SystemRoot%", Environ("windir"))
strProcName = Replace(strProcName, "\SystemRoot", Environ("windir"))
'List1.AddItem Chr(34) & strProcName & Chr(34)
List1.AddItem Chr(34) & strProcName & Chr(34) & " (Presumably)"
founded = True
Exit For
End If
Next
End If
If founded = False Then
List1.AddItem ProcessName
End If
End If
Else
List1.AddItem "[System]"
End If
End If
pVoid = pVoid + LenB(WTS)
Next
WTSFreeMemory ppProcessInfo
End If
List1.Selected(0) = True
List1.SetFocus
Command1.Caption = "List Processes (" & List1.ListCount & ")"
End Sub
Private Sub Command2_Click()
SetPrivilegeProcess True
End Sub
Private Sub Command3_Click()
SetPrivilegeProcess False
End Sub
Private Sub Command4_Click()
If IsArrayInitialized(sf) = True Then
Dim i As Long
If List1.ListCount > 0 Then List1.Clear
Screen.MousePointer = 13
For i = 0 To UBound(sf)
List1.AddItem sf(i)
Next
Screen.MousePointer = 0
End If
End Sub
Private Sub Command5_Click()
Dim str As String
Dim i As Long
Screen.MousePointer = 13
For i = 0 To List1.ListCount - 1
str = str & List1.List(i) & vbCrLf
Next
SaveFile App.Path & "\list.txt", str
Screen.MousePointer = 0
End Sub
Private Sub Form_Activate()
On Error Resume Next
Screen.MousePointer = 13
sf = SFCList_Vista()
Screen.MousePointer = 0
End Sub
Private Sub Form_Load()
SetPrivilegeProcess True
End Sub