ListProcesses with full paths for the guest system

[HackerVlad]

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.

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

P. S. Please do not use the code provided by me from this topic, as there is code here with errors, use the new version, without errors, follow the link: https://www.vbforums.com/showthread....ons-of-Windows