[代码原创][VB]使用Native API获取进程路径
本帖最后由 Tesla.Angela 于 2010-7-21 10:36 编辑由网上的驱动源码转换过来的，发现在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 使用方法：
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
页:
[1]