[代码原创][VB]使用Native API获取进程路径

Tesla.Angela

由网上的驱动源码转换过来的，发现在VB里用UNICODE_STRING真是一种折磨。。。
废话不多说，直接上代码：

'//////////////////////////////
'Get Process Path By Native API
'Code By Tesla.Angela(GDUT.HWL)
'//////////////////////////////
Option Explicit

Private Declare Sub CopyMemory Lib "ntdll.dll" Alias "RtlMoveMemory" _
                (ByVal Destination As Long, _
                ByVal Source As Long, _
                ByVal Length As Long)

Private Declare Function ZwQueryInformationProcess Lib "ntdll.dll" _
                (ByVal ProcessHandle As Long, _
                ByVal ProcessInformationClass As Long, _
                ByVal ProcessInformation As Long, _
                ByVal ProcessInformationLength As Long, _
                ByRef ReturnLength As Long) As Long

Public Const STATUS_INFO_LENGTH_MISMATCH As Long = &HC0000004

Private Sub PspGetProcessPath(ByVal hProcess As Long, ByRef ProcessFullPath As String)
    Dim i As Long
    Dim st As Long
    Dim c As String
    Dim retLen As Long
    Dim buffer() As Byte
    Dim tmpstr As String
    Dim ustr_ptr As Long
    st = ZwQueryInformationProcess(hProcess, 27, 0, 0, retLen)
    If (st <> STATUS_INFO_LENGTH_MISMATCH) Then Exit Sub
    ReDim buffer(retLen) 'malloc
    st = ZwQueryInformationProcess(hProcess, 27, VarPtr(buffer(0)), retLen, 0)
    If st = 0 Then
        ustr_ptr = VarPtr(buffer(0))
        tmpstr = Space$(retLen)
        Call CopyMemory(VarPtr(tmpstr), ustr_ptr + 4, 4)
        For i = 1 To Len(tmpstr)
            c = Mid$(tmpstr, i, 1)
            If Asc(c) = 0 Then Exit Sub
            ProcessFullPath = ProcessFullPath & c
        Next
    Else
        Exit Sub
    End If
End Sub

Public Sub RtlGetProcessPath(ByVal hProcess As Long, ByRef ProcessFullPath As String)
    Dim i As Long
    Dim PrvPath As String
    PspGetProcessPath hProcess, PrvPath
    i = CLng(Mid$(PrvPath, 23, 1))
    ProcessFullPath = Replace(PrvPath, "\Device\HarddiskVolume" & CStr(i), Chr(66 + i) & ":")
End Sub

驱动源码：http://blog.csdn.net/alwaysrun/archive/2010/04/01/5440471.aspx

Tesla.Angela

使用方法：

Option Explicit

Private Declare Function OpenProcess Lib "kernel32.dll" _
                (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function RtlAdjustPrivilege Lib "ntdll.dll" _
                (ByVal Privilege As Long, ByVal NewValue As Long, ByVal NewThread As Long, ByRef OldValue As Long) As Long

Private Const SYNCHRONIZE As Long = &H100000
Private Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000
Private Const PROCESS_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)

Private Sub Command1_Click()
    Dim hProc As Long
    Dim mypath As String
    hProc = OpenProcess(PROCESS_ALL_ACCESS, 0, CLng(Text1.Text))
    Call RtlGetProcessPath(hProc, mypath)
    Text2.Text = mypath
    Call CloseHandle(hProc)
End Sub

Private Sub Form_Load()
    RtlAdjustPrivilege 20, 1, 0, 0
End Sub