ListProcesses with full paths for the guest system

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.

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

---

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

Good! :)

Nice.

There's also another undocumented way that can get system process paths without any special privileges, not even basic elevation, and without any special steps for 64bit processes from 32bit builds: Through NtQuerySystemInformation with the undocumented info class SystemProcessIdInformation.

[VB6, twinBASIC] Getting the full path of all processes when not elevated

Of course 64bit compatible as well :)

Really should at least provision for updates in the future by using LongPtr where appropriate, it's very little extra effort so if you ever do want to make a 64bit build you don't need to redo all that.

There's also some APIs I've found where it's straight impossible to use from 32bit WOW64.

fafalone, I have already forgotten about NtQuerySystemInformation and about your project, which you did a year ago, I also commented a year ago. I remember now. But still, the NtQuerySystemInformation function returns the wrong path in the cases I described before Win 10.

At the same time, you didn't even tell me anything about it at the time. And for me, the main goal was to avoid the error of returning the wrong path to the EXE file. Therefore, it is better to use NtQuerySystemInformation only in cases when there is no information from other functions.

It is best to read from the PEB structure. And if the reading failed, only then you can already access your magic NtQuerySystemInformation function (but you need to understand that in this case it can sometimes give out lies).

Can the NtQuerySystemInformation function receive information from the PEB structure? Then it would be possible to always get the correct path to the EXE process. Even after renaming the folders...

You know the PEB isn't write protected so if you really want to catch all edge cases, that can lie too :D

Also, reading the PEB isn't possible without elevation for SYSTEM processes.

Have you checked the system file list won't lie when they're moved?

Relying on the list of system files is wrong strategy, it turned out to be on my part... But it seems impossible to move/rename them, the system protects such folders... Therefore, there are likely to be correct values...

Fafalone, you see, I compared your code and my code. Your code determines the paths incorrectly if you rename the folder with the program and run it again, but my code always correctly determines the path to the folder. I didn't even think about the fact that some hacker would break into the PEB structure, by the way, but what is the probability that this would happen?

Quote:

---

Originally Posted by fafalone

There's also some APIs I've found where it's straight impossible to use from 32bit WOW64.

---

Which APIs do you mean?

Quote:

---

Originally Posted by HackerVlad

Relying on the list of system files is wrong strategy, it turned out to be on my part... But it seems impossible to move/rename them, the system protects such folders... Therefore, there are likely to be correct values...

Fafalone, you see, I compared your code and my code. Your code determines the paths incorrectly if you rename the folder with the program and run it again, but my code always correctly determines the path to the folder. I didn't even think about the fact that some hacker would break into the PEB structure, by the way, but what is the probability that this would happen?

---

I was making a comparison too; pointing out your code requires administrator access to work on SYSTEM processes and also has an uncommon edge case where it could be wrong. Just meeting different requirements.

Quote:

---

Originally Posted by HackerVlad

Which APIs do you mean?

---

APIs like to enable/disable or install/uninstall or even update hardware for example; SetupDiCallClassInstaller, DiUninstallDriver, etc.

Quote:

---

Originally Posted by fafalone

out your code requires administrator access to work on SYSTEM processes

---

This is not necessary at all. But I'm thinking of writing a new code. To connect my technology and yours.

I was thinking, why use complex functions to get a list of processes? If this is very easily achieved by the NtQuerySystemInformation function. Now there will be a very short code to get a list of processes.

Code:

---

Option Explicit
Private Declare Function NtQuerySystemInformation Lib "ntdll.dll" (ByVal infoClass As Long, Buffer As Any, ByVal BufferSize As Long, ret As Long) As Long
Private Declare Function GetMem4 Lib "msvbvm60" (src As Any, dst As Any) As Long

Private Const SystemProcessInformation As Long = &H5&
Private Const STATUS_INFO_LENGTH_MISMATCH As Long = &HC0000004
Private Const STATUS_SUCCESS As Long = 0&

Private Sub Command1_Click()
    Dim ret As Long
    Dim buf() As Byte
    Dim Offset As Long
    Dim deltaOffset As Long
    Dim pid As Long
   
    If NtQuerySystemInformation(SystemProcessInformation, ByVal 0&, 0&, ret) = STATUS_INFO_LENGTH_MISMATCH Then
        ReDim buf(ret - 1)
       
        If NtQuerySystemInformation(SystemProcessInformation, buf(0), ret, ret) = STATUS_SUCCESS Then
            Do
                GetMem4 buf(Offset + &H44), pid
                List1.AddItem pid
               
                GetMem4 buf(Offset), deltaOffset
                Offset = Offset + deltaOffset
            Loop While deltaOffset
        End If
    End If
End Sub

---

Now we get a list of all the PIDs, it remains only to find out the full paths for each of the processes and that's it.

fafalone, I started rewriting your project for myself, and to be honest, I don't understand at all why you have so many lines of code there? You have a lot of extra code, I wrote the same thing as you, and I only got 90 lines of code. I'm sorry, of course, that I wrote only for a 32-bit system, but to support 64 bits, there's not much to add.

And to be honest, I don't understand why you used the CreateToolhelp32Snapshot, Process32FirstW, Process32NextW functions to enumerate processes if it's too tedious.

Code:

---

Option Explicit
Private Declare Function NtQuerySystemInformation Lib "ntdll.dll" (ByVal infoClass As Long, Buffer As Any, ByVal BufferSize As Long, ret As Long) As Long
Private Declare Function GetMem4 Lib "msvbvm60" (src As Any, dst As Any) 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 "QueryDosDeviceA" (ByVal lpDeviceName As String, ByVal lpTargetPath As String, ByVal ucchMax As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long

Private Const SystemProcessInformation As Long = &H5&
Private Const SystemProcessIdInformation = 88 ' New technology from Fafalone
Private Const STATUS_INFO_LENGTH_MISMATCH As Long = &HC0000004
Private Const STATUS_SUCCESS As Long = 0&
Private Const MAX_PATH = 260

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

' Get FullPath process, using technology from Fafalone
Private Function GetProcessFullPathEx(ByVal pid As Long) As String
    Dim spii As SYSTEM_PROCESS_ID_INFORMATION
    Dim ProcName As String
    Dim cbRet As Long
    Dim cbMax As Long
    Dim sDrives As String
    Dim strBuff As String * MAX_PATH
    Dim DosDeviceName As String
    Dim cnt As Long
    Dim aDrive() As String
    Dim i As Long
   
    cbMax = MAX_PATH * 2
    ProcName = Space$(cbMax)
   
    spii.ProcessId = pid
    spii.ImageName.MaxLength = cbMax
    spii.ImageName.lpBuffer = StrPtr(ProcName)
   
    If NtQuerySystemInformation(SystemProcessIdInformation, spii, LenB(spii), cbRet) >= 0 Then
        ProcName = Left$(ProcName, spii.ImageName.Length / 2)
       
        cnt = GetLogicalDriveStrings(0&, StrPtr(sDrives))
        sDrives = Space$(cnt * 2)
        cnt = GetLogicalDriveStrings(Len(sDrives), StrPtr(sDrives))
       
        If Err.LastDllError = 0 Then
            aDrive = Split(Left$(sDrives, cnt - 1), vbNullChar)
           
            For i = 0 To UBound(aDrive)
                If QueryDosDevice(Left$(aDrive(i), 2), strBuff, MAX_PATH) Then
                    DosDeviceName = Left$(strBuff, lstrlen(StrPtr(strBuff)))
                   
                    If InStr(1, ProcName, DosDeviceName, vbTextCompare) > 0 Then
                        GetProcessFullPathEx = Replace(ProcName, DosDeviceName, Left$(aDrive(i), 2), , 1, vbTextCompare)
                        Exit Function
                    End If
                End If
            Next
        End If
    End If
End Function

Private Sub Command1_Click()
    Dim ret As Long
    Dim buf() As Byte
    Dim Offset As Long
    Dim deltaOffset As Long
    Dim pid As Long
   
    If List1.ListCount > 0 Then List1.Clear
   
    If NtQuerySystemInformation(SystemProcessInformation, ByVal 0&, 0&, ret) = STATUS_INFO_LENGTH_MISMATCH Then
        ReDim buf(ret - 1)
       
        If NtQuerySystemInformation(SystemProcessInformation, buf(0), ret, ret) = STATUS_SUCCESS Then
            Do
                GetMem4 buf(Offset + &H44), pid
                List1.AddItem Chr(34) & GetProcessFullPathEx(pid) & Chr(34)
               
                GetMem4 buf(Offset), deltaOffset
                Offset = Offset + deltaOffset
            Loop While deltaOffset
        End If
    End If
End Sub

---

Because other things matter besides how many lines you can save when you don't care about anything else.

New version! In general, as I said, to write a universal script, I combined our two functions, your code and my code, and got a universal code to correctly determine the path, even if the EXE folder was renamed. Enjoy the new version of my program.

P. S. I'm sorry that I can't make 64-bit versions, but if you need it so badly, then please rewrite my code yourself!

Code:

---

Option Explicit
    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" (src As Any, dst As Any) As Long
    Private Declare Function GetMem8 Lib "msvbvm60" (src As Any, dst As Any) As Long
    Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long)
    Private Declare Sub memcpy Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length 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 "QueryDosDeviceA" (ByVal lpDeviceName As String, ByVal lpTargetPath As String, 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 GetModuleFileNameExW Lib "psapi" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As Long, ByVal nSize As Long) As Long
    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 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 GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryW" (ByVal lpBuffer As Long, ByVal uSize As Long) As Long
   
    Private Const SystemProcessInformation As Long = &H5&
    Private Const SystemProcessIdInformation = 88
    Private Const ProcessBasicInformation = 0
    Private Const STATUS_INFO_LENGTH_MISMATCH As Long = &HC0000004
    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 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 Function GetProcessFullPathEx(ByVal pid As Long) As String
        Dim spii As SYSTEM_PROCESS_ID_INFORMATION
        Dim ProcName As String
        Dim cbRet As Long
        Dim cbMax As Long
        Dim sDrives As String
        Dim strBuff As String * MAX_PATH
        Dim DosDeviceName As String
        Dim cnt As Long
        Dim aDrive() As String
        Dim i As Long
       
        cbMax = MAX_PATH * 2
        ProcName = Space$(cbMax)
       
        spii.ProcessId = pid
        spii.ImageName.MaxLength = cbMax
        spii.ImageName.lpBuffer = StrPtr(ProcName)
       
        If NtQuerySystemInformation(SystemProcessIdInformation, spii, LenB(spii), cbRet) >= 0 Then
            ProcName = Left$(ProcName, spii.ImageName.Length / 2)
           
            cnt = GetLogicalDriveStrings(0&, StrPtr(sDrives))
            sDrives = Space$(cnt * 2)
            cnt = GetLogicalDriveStrings(Len(sDrives), StrPtr(sDrives))
           
            If Err.LastDllError = 0 Then
                aDrive = Split(Left$(sDrives, cnt - 1), vbNullChar)
               
                For i = 0 To UBound(aDrive)
                    If QueryDosDevice(Left$(aDrive(i), 2), strBuff, MAX_PATH) Then
                        DosDeviceName = Left$(strBuff, lstrlen(StrPtr(strBuff)))
                       
                        If InStr(1, ProcName, DosDeviceName, vbTextCompare) > 0 Then
                            GetProcessFullPathEx = Replace(ProcName, DosDeviceName, Left$(aDrive(i), 2), , 1, vbTextCompare)
                            Exit Function
                        End If
                    End If
                Next
            End If
        End If
    End Function
   
    Private Sub strProcNameArrange(strProcName As String)
        Dim PathWinDir As String
        Dim lengthPathWinDir As Long
       
        If Left$(strProcName, 12) = "\SystemRoot\" And strProcName <> "\SystemRoot\" Then
            PathWinDir = Space$(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
                PathWinDir = Space$(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
    End Sub
   
    ' This function should get the correct paths, unlike another functions 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 strProcName2 As String
        Dim cmd64 As UNICODE_STRING64
        Dim pbi64 As PROCESS_BASIC_INFORMATION_WOW64
        Dim pParam64 As Currency
        Dim LPWSTR As Long
        Dim CmdStringPtr As Long
        Dim cnt As Integer
       
        hProc = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, pid)
       
        If hProc > 0 Then
            strProcName = Space$(MAX_PATH)
           
            If GetModuleFileNameExW(hProc, 0, StrPtr(strProcName), MAX_PATH) Then
                strProcName = Left$(strProcName, lstrlen(StrPtr(strProcName)))
                strProcNameArrange strProcName
               
                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
                                strProcName = Space$(MAX_PATH) ' 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 ByVal LPWSTR, CmdStringPtr
                                        PutMem4 VarPtr(strProcName), SysAllocStringLen(CmdStringPtr, lstrlen(CmdStringPtr))
                                       
                                        ' This situation will only be possible if privileges "SeDebugPrivilege" are enabled
                                        strProcNameArrange strProcName
                                    End If
                                End If
                               
                                GetProcessPathName = strProcName
                            End If
                        End If
                    End If
                End If
            End If
           
            CloseHandle hProc
        End If
    End Function
   
    ' Universal function
    Public Function GetProcessFullPath(ByVal pid As Long) As String
        Dim ProcName As String
       
        ProcName = GetProcessPathName(pid) ' Technology from HackerVlad
       
        If InStr(1, ProcName, "\") = 0 Then ' Retrying
            ProcName = GetProcessFullPathEx(pid) ' Technology from fafalone
        End If
       
        GetProcessFullPath = ProcName
    End Function
   
    Private Sub Command1_Click()
        Dim ret As Long
        Dim buf() As Byte
        Dim Offset As Long
        Dim deltaOffset As Long
        Dim pid As Long
        Dim ImgName As UNICODE_STRING
        Dim ProcName As String
        Dim nProc As Long
       
        Text1.Text = vbNullString
       
        If NtQuerySystemInformation(SystemProcessInformation, ByVal 0&, 0&, ret) = STATUS_INFO_LENGTH_MISMATCH Then
            ReDim buf(ret - 1)
           
            If NtQuerySystemInformation(SystemProcessInformation, buf(0), ret, ret) = STATUS_SUCCESS Then
                Do
                    nProc = nProc + 1
                   
                    GetMem4 buf(Offset + &H44), pid
                    GetMem8 buf(Offset + &H38), ImgName
                    ProcName = Space$(ImgName.Length \ 2)
                    memcpy ByVal StrPtr(ProcName), ByVal ImgName.lpBuffer, ImgName.Length
                   
                    If pid = 0 Then
                        PostLog "ProcId 0: [System idle process]"
                    ElseIf pid = 4 Then
                        PostLog "ProcId 4: [System]"
                    Else
                        PostLog "ProcId " & pid & " (" & ProcName & "): " & Chr(34) & GetProcessFullPath(pid) & Chr(34)
                    End If
                   
                    GetMem4 buf(Offset), deltaOffset
                    Offset = Offset + deltaOffset
                Loop While deltaOffset
               
                Text1.Text = Text1.Text & "Done. Enumerated " & nProc & " processes."
            End If
        End If
    End Sub
   
    Private Sub PostLog(sMsg As String)
        Text1.Text = Text1.Text & sMsg & vbCrLf
    End Sub
   
    Private Sub Form_Resize()
        On Error Resume Next
        Text1.Width = Me.Width - 380
        Text1.Height = Me.Height - 1270
    End Sub

---

I wrote a new version today, version 2.0. I fixed a lot of bugs. Now everything is working perfectly! The post has been updated.

Quote:

---

Originally Posted by fafalone

You know the PEB isn't write protected so if you really want to catch all edge cases, that can lie too :D

---

Dear fafalone, I do not know how reliable it is to get information from the PEB structure, but I conducted tests in a cycle of 100,000 interations, and found out that getting the full path to the process from the PEB is 10 times faster in speed than if using your technology.

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

Just get the full path of the process, I feel no use ah.

Sometimes I have a lot of programs on my computer, and I want to write a software to list them, and then manually choose to close or open them. Or write a program to automatically close the batch with one click. At the same time, some programs are not closed.

In this case, I need to read the full path of the process.If I just want to be able to control him or shut him down, I can actually not know where his path is.

It's up to you to decide what to use this code for and whether you need it at all. Sometimes it is very useful to know where the program file path started from.

One use is my File Activity Monitor. It monitors what files are being read/written/etc and knowing what program is doing that is important.

I need to get the full path from the process id. For performance, important since sometimes hundreds of events per second come in, I generate a full list for running processes on load, so further lookups only need to be done for new process ids.

fafalone, now you can use my code without fear that Windows 7 will have an error getting the path.