这篇文章是我看了一篇VC的文章增加修改而来,原文章地址我也忘记了,作者也不是很清楚,在这里希望原作者能原谅.
此代码演示了进 程和端口以及IP地址的关联,程序使用了ZwQuerySystemInformation函数来枚举所有打开的句柄然后再使用 ZwQueryObject函数来获取句柄所对应的路径,如果发现路径正包含/device/rawip或者/device/tcp或者/device/ udp即是我们需要查找的对象.目前程序还有个缺陷就是无法获取远程IP地址和端口,我目前也还没找到方法,如果有懂这方面的高手可以把代码继续完善一 下,好方便大家使用.
使用此方法枚举的信息可以躲过拦截相关的API函数来隐藏IP地址和端口的程序.
话不多说了,本来想把注释写详细些,一个由于时间太晚得睡觉了,还有就是我我基本上都是用的解锁文件的代码Copy过来的稍微修改了下.比如获取进程路径,枚举句柄等,如果不懂的可以在我的博客查看我"解锁文件"的相关文件有详细注释.下面我就把完整代码贴上来.
frmMain.frm
VERSION 5.00
Begin VB.Form frmMain
BorderStyle = 1 'Fixed Single
Caption = "进程-端口-IP地址关联演示"
ClientHeight = 6120
ClientLeft = 45
ClientTop = 420
ClientWidth = 9600
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6120
ScaleWidth = 9600
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton cmdExit
Cancel = -1 'True
Caption = "退出(&C)"
Height = 375
Left = 8520
TabIndex = 2
Top = 5595
Width = 975
End
Begin VB.CommandButton cmdRefresh
Caption = "刷新(&R)"
Default = -1 'True
Height = 375
Left = 7440
TabIndex = 1
Top = 5595
Width = 975
End
Begin VB.ListBox lstInfo
Height = 5460
Left = 0
TabIndex = 0
Top = 0
Width = 9615
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Private Sub Form_Initialize()
InitCommonControls
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdRefresh_Click()
Me.lstInfo.Clear
EmunNetInfo
End Sub
Private Sub Form_Load()
EnablePrivilege
EmunNetInfo
End Sub
modPrivilege.bas
Attribute VB_Name = "modPrivilege"
Option Explicit
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const TOKEN_ASSIGN_PRIMARY = &H1
Private Const TOKEN_DUPLICATE = (&H2)
Private Const TOKEN_IMPERSONATE = (&H4)
Private Const TOKEN_QUERY = (&H8)
Private Const TOKEN_QUERY_SOURCE = (&H10)
Private Const TOKEN_ADJUST_PRIVILEGES = (&H20)
Private Const TOKEN_ADJUST_GROUPS = (&H40)
Private Const TOKEN_ALL_ACCESS = 983551
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const ANYSIZE_ARRAY = 1
Private Const SE_DEBUG_NAME = "SeDebugPrivilege"
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(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) 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 'Used to adjust your program's security privileges, can't restore without it!
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 GetCurrentProcess Lib "kernel32" () As Long '获取当前进程句柄
Public Function EnablePrivilege() As Boolean
Dim hdlProcessHandle As Long
Dim hdlTokenHandle As Long
Dim tmpLuid As LUID
Dim tkp As TOKEN_PRIVILEGES
Dim tkpNewButIgnored As TOKEN_PRIVILEGES
Dim lBufferNeeded As Long
Dim lp As Long
hdlProcessHandle = GetCurrentProcess()
lp = OpenProcessToken(hdlProcessHandle, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hdlTokenHandle)
lp = LookupPrivilegeValue(vbNullString, "SeDebugPrivilege", tmpLuid)
tkp.PrivilegeCount = 1
tkp.Privileges(0).pLuid = tmpLuid
tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
EnablePrivilege = AdjustTokenPrivileges(hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded)
End Function
modNetInfo.bas
Attribute VB_Name = "modNetInfo"
Option Explicit
Private Declare Function NtQueryInformationProcess Lib "NTDLL.DLL" (ByVal ProcessHandle As Long, _
ByVal ProcessInformationClass As PROCESSINFOCLASS, _
ByVal ProcessInformation As Long, _
ByVal ProcessInformationLength As Long, _
ByRef ReturnLength As Long) As Long
Private Enum PROCESSINFOCLASS
ProcessBasicInformation = 0
ProcessQuotaLimits
ProcessIoCounters
ProcessVmCounters
ProcessTimes
ProcessBasePriority
ProcessRaisePriority
ProcessDebugPort
ProcessExceptionPort
ProcessAccessToken
ProcessLdtInformation
ProcessLdtSize
ProcessDefaultHardErrorMode
ProcessIoPortHandlers
ProcessPooledUsageAndLimits
ProcessWorkingSetWatch
ProcessUserModeIOPL
ProcessEnableAlignmentFaultFixup
ProcessPriorityClass
ProcessWx86Information
ProcessHandleCount
ProcessAffinityMask
ProcessPriorityBoost
ProcessDeviceMap
ProcessSessionInformation
ProcessForegroundInformation
ProcessWow64Information
ProcessImageFileName
ProcessLUIDDeviceMapsEnabled
ProcessBreakOnTermination
ProcessDebugObjectHandle
ProcessDebugFlags
ProcessHandleTracing
ProcessIoPriority
ProcessExecuteFlags
ProcessResourceManagement
ProcessCookie
ProcessImageInformation
MaxProcessInfoClass
End Enum
Private Type PROCESS_BASIC_INFORMATION
ExitStatus As Long 'NTSTATUS
PebBaseAddress As Long 'PPEB
AffinityMask As Long 'ULONG_PTR
BasePriority As Long 'KPRIORITY
UniqueProcessId As Long 'ULONG_PTR
InheritedFromUniqueProcessId As Long 'ULONG_PTR
End Type
Private Type FILE_NAME_INFORMATION
FileNameLength As Long
FileName(3) As Byte
End Type
Private Type NM_INFO
Info As FILE_NAME_INFORMATION
strName(259) As Byte
End Type
Private Enum FileInformationClass
FileDirectoryInformation = 1
FileFullDirectoryInformation = 2
FileBothDirectoryInformation = 3
FileBasicInformation = 4
FileStandardInformation = 5
FileInternalInformation = 6
FileEaInformation = 7
FileAccessInformation = 8
FileNameInformation = 9
FileRenameInformation = 10
FileLinkInformation = 11
FileNamesInformation = 12
FileDispositionInformation = 13
FilePositionInformation = 14
FileFullEaInformation = 15
FileModeInformation = 16
FileAlignmentInformation = 17
FileAllInformation = 18
FileAllocationInformation = 19
FileEndOfFileInformation = 20
FileAlternateNameInformation = 21
FileStreamInformation = 22
FilePipeInformation = 23
FilePipeLocalInformation = 24
FilePipeRemoteInformation = 25
FileMailslotQueryInformation = 26
FileMailslotSetInformation = 27
FileCompressionInformation = 28
FileObjectIdInformation = 29
FileCompletionInformation = 30
FileMoveClusterInformation = 31
FileQuotaInformation = 32
FileReparsePointInformation = 33
FileNetworkOpenInformation = 34
FileAttributeTagInformation = 35
FileTrackingInformation = 36
FileMaximumInformation
End Enum
Private Declare Function NtQuerySystemInformation Lib "NTDLL.DLL" (ByVal SystemInformationClass As SYSTEM_INFORMATION_CLASS, _
ByVal pSystemInformation As Long, _
ByVal SystemInformationLength As Long, _
ByRef ReturnLength As Long) As Long
Private Enum SYSTEM_INFORMATION_CLASS
SystemBasicInformation
SystemProcessorInformation '// obsolete...delete
SystemPerformanceInformation
SystemTimeOfDayInformation
SystemPathInformation
SystemProcessInformation
SystemCallCountInformation
SystemDeviceInformation
SystemProcessorPerformanceInformation
SystemFlagsInformation
SystemCallTimeInformation
SystemModuleInformation
SystemLocksInformation
SystemStackTraceInformation
SystemPagedPoolInformation
SystemNonPagedPoolInformation
SystemHandleInformation
SystemObjectInformation
SystemPageFileInformation
SystemVdmInstemulInformation
SystemVdmBopInformation
SystemFileCacheInformation
SystemPoolTagInformation
SystemInterruptInformation
SystemDpcBehaviorInformation
SystemFullMemoryInformation
SystemLoadGdiDriverInformation
SystemUnloadGdiDriverInformation
SystemTimeAdjustmentInformation
SystemSummaryMemoryInformation
SystemMirrorMemoryInformation
SystemPerformanceTraceInformation
SystemObsolete0
SystemExceptionInformation
SystemCrashDumpStateInformation
SystemKernelDebuggerInformation
SystemContextSwitchInformation
SystemRegistryQuotaInformation
SystemExtendServiceTableInformation
SystemPrioritySeperation
SystemVerifierAddDriverInformation
SystemVerifierRemoveDriverInformation
SystemProcessorIdleInformation
SystemLegacyDriverInformation
SystemCurrentTimeZoneInformation
SystemLookasideInformation
SystemTimeSlipNotification
SystemSessionCreate
SystemSessionDetach
SystemSessionInformation
SystemRangeStartInformation
SystemVerifierInformation
SystemVerifierThunkExtend
SystemSessionProcessInformation
SystemLoadGdiDriverInSystemSpace
SystemNumaProcessorMap
SystemPrefetcherInformation
SystemExtendedProcessInformation
SystemRecommendedSharedDataAlignment
SystemComPlusPackage
SystemNumaAvailableMemory
SystemProcessorPowerInformation
SystemEmulationBasicInformation
SystemEmulationProcessorInformation
SystemExtendedHandleInformation
SystemLostDelayedWriteInformation
SystemBigPoolInformation
SystemSessionPoolTagInformation
SystemSessionMappedViewInformation
SystemHotpatchInformation
SystemObjectSecurityMode
SystemWatchdogTimerHandler
SystemWatchdogTimerInformation
SystemLogicalProcessorInformation
SystemWow64SharedInformation
SystemRegisterFirmwareTableInformationHandler
SystemFirmwareTableInformation
SystemModuleInformationEx
SystemVerifierTriageInformation
SystemSuperfetchInformation
SystemMemoryListInformation
SystemFileCacheInformationEx
MaxSystemInfoClass '// MaxSystemInfoClass should always be the last enum
End Enum
Private Type SYSTEM_HANDLE
UniqueProcessId As Integer
CreatorBackTraceIndex As Integer
ObjectTypeIndex As Byte
HandleAttributes As Byte
HandleValue As Integer
pObject As Long
GrantedAccess As Long
End Type
Private Const STATUS_INFO_LENGTH_MISMATCH = &HC0000004
Private Enum SYSTEM_HANDLE_TYPE
OB_TYPE_UNKNOWN = 0
OB_TYPE_TYPE = 1
OB_TYPE_DIRECTORY
OB_TYPE_SYMBOLIC_LINK
OB_TYPE_TOKEN
OB_TYPE_PROCESS
OB_TYPE_THREAD
OB_TYPE_UNKNOWN_7
OB_TYPE_EVENT
OB_TYPE_EVENT_PAIR
OB_TYPE_MUTANT
OB_TYPE_UNKNOWN_11
OB_TYPE_SEMAPHORE
OB_TYPE_TIMER
OB_TYPE_PROFILE
OB_TYPE_WINDOW_STATION
OB_TYPE_DESKTOP
OB_TYPE_SECTION
OB_TYPE_KEY
OB_TYPE_PORT
OB_TYPE_WAITABLE_PORT
OB_TYPE_UNKNOWN_21
OB_TYPE_UNKNOWN_22
OB_TYPE_UNKNOWN_23
OB_TYPE_UNKNOWN_24
OB_TYPE_IO_COMPLETION
OB_TYPE_FILE
End Enum
Private Type SYSTEM_HANDLE_INFORMATION
uCount As Long
aSH() As SYSTEM_HANDLE
End Type
Private Declare Function NtDuplicateObject Lib "NTDLL.DLL" (ByVal SourceProcessHandle As Long, _
ByVal SourceHandle As Long, _
ByVal TargetProcessHandle As Long, _
ByRef TargetHandle As Long, _
ByVal DesiredAccess As Long, _
ByVal HandleAttributes As Long, _
ByVal Options As Long) As Long
Private Const DUPLICATE_CLOSE_SOURCE = &H1
Private Const DUPLICATE_SAME_ACCESS = &H2
Private Const DUPLICATE_SAME_ATTRIBUTES = &H4
Private Declare Function NtOpenProcess Lib "NTDLL.DLL" (ByRef ProcessHandle As Long, _
ByVal AccessMask As Long, _
ByRef ObjectAttributes As OBJECT_ATTRIBUTES, _
ByRef ClientID As CLIENT_ID) As Long
Private Type OBJECT_ATTRIBUTES
Length As Long
RootDirectory As Long
ObjectName As Long
Attributes As Long
SecurityDescriptor As Long
SecurityQualityOfService As Long
End Type
Private Type CLIENT_ID
UniqueProcess As Long
UniqueThread As Long
End Type
Private Type IO_STATUS_BLOCK
Status As Long
uInformation As Long
End Type
Private Const PROCESS_CREATE_THREAD = &H2
Private Const PROCESS_VM_WRITE = &H20
Private Const PROCESS_VM_OPERATION = &H8
Private Const PROCESS_VM_READ = &H10
Private Const PROCESS_QUERY_INFORMATION As Long = (&H400)
Private Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000
Private Const SYNCHRONIZE As Long = &H100000
Private Const PROCESS_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)
Private Const PROCESS_DUP_HANDLE As Long = (&H40)
Private Declare Function NtClose Lib "NTDLL.DLL" (ByVal ObjectHandle As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, _
ByRef Source As Any, _
ByVal Length As Long)
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Enum OBJECT_INFORMATION_CLASS
ObjectBasicInformation = 0
ObjectNameInformation
ObjectTypeInformation
ObjectAllTypesInformation
ObjectHandleInformation
End Enum
Private Type UNICODE_STRING
uLength As Integer
uMaximumLength As Integer
pBuffer(3) As Byte
End Type
Private Type OBJECT_NAME_INFORMATION
pName As UNICODE_STRING
End Type
Private Const STATUS_INFO_LEN_MISMATCH = &HC0000004
Private Const HEAP_ZERO_MEMORY = &H8
Private Declare Function GetProcessHeap Lib "kernel32" () As Long
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
Private Declare Function HeapReAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any, ByVal dwBytes As Long) As Long
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type
Private Type TDI_REQUEST
AddressHandle As Long
RequestNotifyObject As Long
RequestContext As Long
TdiStatus As Long
End Type
Private Type TDI_CONNECTION_INFO
State As Long
Event As Long
TransmittedTsdus As Long
ReceivedTsdus As Long
TransmissionErrors As Long
ReceiveErrors As Long
Throughput As LARGE_INTEGER
Delay As LARGE_INTEGER
SendBufferSize As Long
ReceiveBufferSize As Long
Unreliable As Boolean
End Type
Private Type TDI_CONNECTION_INFORMATION
UserDataLength As Long
UserData As Long
OptionsLength As Long
Options As Long
RemoteAddressLength As Long
RemoteAddress As Long
End Type
Private Type TDI_REQUEST_QUERY_INFORMATION
Request As TDI_REQUEST
QueryType As Long
RequestConnectionInformation As Long 'TDI_CONNECTION_INFORMATION
End Type
Private Const TDI_QUERY_ADDRESS_INFO = &H3
Private Const FILE_DEVICE_TRANSPORT = &H21
Private Const METHOD_OUT_DIRECT = 2
Private Const FILE_ANY_ACCESS = 0
Private Const OBJ_CASE_INSENSITIVE = &H40
Private Declare Sub RtlInitUnicodeString Lib "NTDLL.DLL" (DestinationString As UNICODE_STRING, ByVal SourceString As Long)
Private Declare Function ntohs Lib "ws2_32.dll" (ByVal netshort As Integer) As Integer
Private Declare Function NtOpenFile Lib "NTDLL.DLL" (ByRef FileHandle As Long, _
ByVal DesiredAccess As Long, _
ByRef ObjectAttributes As OBJECT_ATTRIBUTES, _
ByRef IoStatusBlock As IO_STATUS_BLOCK, _
ByVal ShareAccess As Long, _
ByVal OpenOptions As Long) As Long
Private Declare Function NtQueryObject Lib "NTDLL.DLL" (ByVal ObjectHandle As Long, _
ByVal ObjectInformationClass As OBJECT_INFORMATION_CLASS, _
ByVal ObjectInformation As Long, ByVal ObjectInformationLength As Long, _
ReturnLength As Long) As Long
Private Declare Function NtDeviceIoControlFile Lib "NTDLL.DLL" (ByVal FileHandle As Long, _
ByVal pEvent As Long, _
ApcRoutine As Long, _
ApcContext As Long, _
IoStatusBlock As IO_STATUS_BLOCK, _
ByVal IoControlCode As Long, _
InputBuffer As Any, _
ByVal InputBufferLength As Long, _
OutputBuffer As Any, _
ByVal OutputBufferLength As Long) As Long
Private Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (lpEventAttributes As Any, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As String) As Long
Private Declare Function inet_ntoa Lib "wsock32.dll" (ByVal addr As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function lstrcpyW Lib "kernel32" (ByVal lpString1 As String, ByVal lpString2 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 GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const LB_SETHORIZONTALEXTENT = &H194
Private intMaxWidth As Integer
'判断Nt系列函数是否调用成功
Private Function NT_SUCCESS(ByVal nStatus As Long) As Boolean
NT_SUCCESS = (nStatus >= 0)
End Function
Private Function CTL_CODE(ByVal lDeviceType As Long, ByVal lFunction As Long, ByVal lMethod As Long, ByVal lAccess As Long) As Long
CTL_CODE = (lDeviceType * 2 ^ 16&) Or (lAccess * 2 ^ 14&) Or (lFunction * 2 ^ 2) Or (lMethod)
End Function
Private Function GetProcessPath(ByVal dwProcessId As Long) As String
Dim ntStatus As Long
Dim objBasic As PROCESS_BASIC_INFORMATION
Dim objFlink As Long
Dim objPEB As Long, objLdr As Long
Dim objBaseAddress As Long
Dim bytName(260 * 2 - 1) As Byte
Dim strModuleName As String, objName As Long
Dim objCid As CLIENT_ID
Dim objOa As OBJECT_ATTRIBUTES
Dim hProcess As Long
objOa.Length = Len(objOa)
objCid.UniqueProcess = dwProcessId
ntStatus = NtOpenProcess(hProcess, PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, objOa, objCid)
If hProcess = 0 Then
hProcess = GetHandleByProcessId(dwProcessId)
If hProcess = 0 Then
GetProcessPath = ""
Exit Function
End If
End If
Dim lngRet As Long, lngReturn As Long
ntStatus = NtQueryInformationProcess(hProcess, ProcessBasicInformation, VarPtr(objBasic), Len(objBasic), ByVal 0&)
If (NT_SUCCESS(ntStatus)) Then
objPEB = objBasic.PebBaseAddress
lngRet = ReadProcessMemory(hProcess, ByVal objPEB + &HC, objLdr, 4, ByVal 0&)
If lngRet = 0 Then Exit Function
lngRet = ReadProcessMemory(hProcess, ByVal objLdr + &HC, objFlink, 4, ByVal 0&)
If lngRet = 0 Then Exit Function
lngRet = ReadProcessMemory(hProcess, ByVal objFlink + &H28, objName, 4, ByVal 0&)
If lngRet = 0 Then Exit Function
lngRet = ReadProcessMemory(hProcess, ByVal objName, bytName(0), 260 * 2, ByVal 0&)
If lngRet = 0 Then Exit Function
strModuleName = bytName
strModuleName = Left(strModuleName & Chr(0), InStr(strModuleName & Chr(0), Chr(0)) - 1)
GetProcessPath = strModuleName
End If
NtClose hProcess
End Function
Private Function GetProcessPathByHandle(ByVal hProcess As Long) As String
Dim ntStatus As Long
Dim objBasic As PROCESS_BASIC_INFORMATION
Dim objFlink As Long
Dim objPEB As Long, objLdr As Long
Dim objBaseAddress As Long
Dim bytName(260 * 2 - 1) As Byte
Dim strModuleName As String, objName As Long, lngRet As Long
ntStatus = NtQueryInformationProcess(hProcess, ProcessBasicInformation, VarPtr(objBasic), Len(objBasic), ByVal 0&)
If (NT_SUCCESS(ntStatus)) Then
objPEB = objBasic.PebBaseAddress
lngRet = ReadProcessMemory(hProcess, ByVal objPEB + &HC, objLdr, 4, ByVal 0&)
If lngRet = 0 Then Exit Function
lngRet = ReadProcessMemory(hProcess, ByVal objLdr + &HC, objFlink, 4, ByVal 0&)
If lngRet = 0 Then Exit Function
lngRet = ReadProcessMemory(hProcess, ByVal objFlink + &H28, objName, 4, ByVal 0&)
If lngRet = 0 Then Exit Function
lngRet = ReadProcessMemory(hProcess, ByVal objName, bytName(0), 260 * 2, ByVal 0&)
If lngRet = 0 Then Exit Function
strModuleName = bytName
strModuleName = Left(strModuleName & Chr(0), InStr(strModuleName & Chr(0), Chr(0)) - 1)
GetProcessPathByHandle = strModuleName
End If
End Function
Public Function GetFileFullPath(ByVal hFile As Long) As String
Dim hHeap As Long, dwSize As Long, objName As UNICODE_STRING, pName As Long
Dim ntStatus As Long, i As Long, lngNameSize As Long, strDrives As String, strArray() As String
Dim dwDriversSize As Long, strDrive As String, strTmp As String, strTemp As String
On Error GoTo ErrHandle
hHeap = GetProcessHeap
pName = HeapAlloc(hHeap, HEAP_ZERO_MEMORY, &H1000)
ntStatus = NtQueryObject(hFile, ObjectNameInformation, pName, &H1000, dwSize)
If Not (NT_SUCCESS(ntStatus)) Then
i = 1
Do While (ntStatus = STATUS_INFO_LEN_MISMATCH)
pName = HeapReAlloc(hHeap, HEAP_ZERO_MEMORY, pName, &H1000 * i)
ntStatus = NtQueryObject(hFile, ObjectNameInformation, pName, &H1000, ByVal 0)
i = i + 1
Loop
End If
HeapFree hHeap, 0, pName
strTemp = String(512, Chr(0))
lstrcpyW strTemp, pName + Len(objName)
strTemp = StrConv(strTemp, vbFromUnicode)
strTemp = Left(strTemp, InStr(strTemp, Chr(0)) - 1)
strDrives = String(512, Chr(9))
dwDriversSize = GetLogicalDriveStrings(512, strDrives)
If dwDriversSize Then
strArray = Split(strDrives, Chr(0))
For i = 0 To UBound(strArray)
If strArray(i) <> "" Then
strDrive = Left(strArray(i), 2)
strTmp = String(260, Chr(0))
Call QueryDosDevice(strDrive, strTmp, 256)
strTmp = Left(strTmp, InStr(strTmp, Chr(0)) - 1)
If InStr(LCase(strTemp), LCase(strTmp)) = 1 Then
GetFileFullPath = strDrive & Mid(strTemp, Len(strTmp) + 1, Len(strTemp) - Len(strTmp))
Exit Function
End If
End If
Next
End If
ErrHandle:
End Function
'通过进程PID获取进程句柄此方法可以不躲过拦截NtOpenProcess方法获取进程句柄
Public Function GetHandleByProcessId(ByVal dwProcessId As Long) As Long
Dim ntStatus As Long
Dim objCid As CLIENT_ID
Dim objOa As OBJECT_ATTRIBUTES
Dim lngHandles As Long
Dim i As Long
Dim objBasic As PROCESS_BASIC_INFORMATION
Dim objInfo() As SYSTEM_HANDLE
Dim hProcess As Long, hProcessToDup As Long, hProcessHandle As Long
Dim hFile As Long
objOa.Length = Len(objOa)
objCid.UniqueProcess = dwProcessId
ntStatus = NtOpenProcess(hProcess, PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, objOa, objCid)
If hProcess <> 0 Then
GetHandleByProcessId = hProcess
Exit Function
End If
ntStatus = 0
Dim bytBuf() As Byte
Dim nSize As Long
nSize = 1
Do
ReDim bytBuf(nSize)
ntStatus = NtQuerySystemInformation(SystemHandleInformation, VarPtr(bytBuf(0)), nSize, 0&)
If (Not NT_SUCCESS(ntStatus)) Then
If (ntStatus <> STATUS_INFO_LENGTH_MISMATCH) Then
Erase bytBuf
Exit Function
End If
Else
Exit Do
End If
nSize = nSize * 2
ReDim bytBuf(nSize)
Loop
CopyMemory lngHandles, bytBuf(0), 4
ReDim objInfo(lngHandles - 1)
CopyMemory objInfo(0), bytBuf(4), Len(objInfo(0)) * lngHandles
For i = 0 To lngHandles - 1
If objInfo(i).ObjectTypeIndex = 5 Then ' And objInfo(i).UniqueProcessId = dwProcessId Then
objCid.UniqueProcess = objInfo(i).UniqueProcessId
ntStatus = NtOpenProcess(hProcessToDup, PROCESS_DUP_HANDLE, objOa, objCid)
If (NT_SUCCESS(ntStatus)) Then
ntStatus = NtDuplicateObject(hProcessToDup, objInfo(i).HandleValue, GetCurrentProcess, hProcessHandle, PROCESS_ALL_ACCESS, 0, DUPLICATE_SAME_ATTRIBUTES)
If (NT_SUCCESS(ntStatus)) Then
ntStatus = NtQueryInformationProcess(hProcessHandle, ProcessBasicInformation, VarPtr(objBasic), Len(objBasic), 0)
If (NT_SUCCESS(ntStatus)) Then
If (objBasic.UniqueProcessId = dwProcessId) Then
GetHandleByProcessId = hProcessHandle
Exit Function
End If
End If
End If
End If
End If
Next
End Function
Private Function UnsignedToInteger(ByVal lngValue As Long) As Integer
If lngValue <= 32767 Then
UnsignedToInteger = lngValue
Else
UnsignedToInteger = lngValue - 65536
End If
End Function
'检测所有进程
Public Function EmunNetInfo() As Boolean
Dim ntStatus As Long
Dim objCid As CLIENT_ID
Dim objOa As OBJECT_ATTRIBUTES
Dim lngHandles As Long
Dim i As Long
Dim objInfo As SYSTEM_HANDLE_INFORMATION, lngType As Long
Dim hProcess As Long, hProcessToDup As Long, hFileHandle As Long
Dim blnIsOk As Boolean, strProcessName As String
Dim hTcpHandle As Long, hUdpHandle As Long, hRawIpHandle As Long
Dim lngPort As Long, hEvent As Long, IOCTL_TDI_QUERY_INFORMATION As Long, hAddr As Long
'Dim objIo As IO_STATUS_BLOCK, objFn As FILE_NAME_INFORMATION, objN As NM_INFO
Dim bytBytes() As Byte, strTmp As String, bytBuffer(129) As Byte, strAddress As String
Dim objIoStatusBlock As IO_STATUS_BLOCK
Dim objTdi_RequestInfo As TDI_REQUEST_QUERY_INFORMATION
Dim intPort As Integer
IOCTL_TDI_QUERY_INFORMATION = CTL_CODE(FILE_DEVICE_TRANSPORT, 4, METHOD_OUT_DIRECT, FILE_ANY_ACCESS)
hTcpHandle = GetNetTcpHandle
hUdpHandle = GetNetUdpHandle
hRawIpHandle = GetNetRawIpHandle
If hTcpHandle = 0 Or hUdpHandle = 0 Or hRawIpHandle = 0 Then
Exit Function
End If
objOa.Length = Len(objOa)
ntStatus = 0
Dim bytBuf() As Byte
Dim nSize As Long
nSize = 1
Do
ReDim bytBuf(nSize)
ntStatus = NtQuerySystemInformation(SystemHandleInformation, VarPtr(bytBuf(0)), nSize, 0&)
If (Not NT_SUCCESS(ntStatus)) Then
If (ntStatus <> STATUS_INFO_LENGTH_MISMATCH) Then
Erase bytBuf
Exit Function
End If
Else
Exit Do
End If
nSize = nSize * 2
ReDim bytBuf(nSize)
Loop
lngHandles = 0
CopyMemory objInfo.uCount, bytBuf(0), 4
lngHandles = objInfo.uCount
ReDim objInfo.aSH(lngHandles - 1)
Call CopyMemory(objInfo.aSH(0), bytBuf(4), Len(objInfo.aSH(0)) * lngHandles)
For i = 0 To lngHandles - 1
If (objInfo.aSH(i).HandleValue = hTcpHandle Or objInfo.aSH(i).HandleValue = hUdpHandle Or objInfo.aSH(i).HandleValue = hRawIpHandle) And objInfo.aSH(i).UniqueProcessId = GetCurrentProcessId Then
lngType = objInfo.aSH(i).ObjectTypeIndex
Exit For
End If
Next
blnIsOk = True
For i = 0 To lngHandles - 1
If objInfo.aSH(i).ObjectTypeIndex = lngType Then
objCid.UniqueProcess = objInfo.aSH(i).UniqueProcessId
ntStatus = NtOpenProcess(hProcessToDup, PROCESS_DUP_HANDLE Or PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, objOa, objCid)
If hProcessToDup = 0 Then hProcessToDup = GetHandleByProcessId(objInfo.aSH(i).UniqueProcessId)
If hProcessToDup <> 0 Then
ntStatus = NtDuplicateObject(hProcessToDup, objInfo.aSH(i).HandleValue, GetCurrentProcess, hFileHandle, STANDARD_RIGHTS_REQUIRED, 0, 0)
If (NT_SUCCESS(ntStatus)) Then
strTmp = GetFileFullPath(hFileHandle)
If InStr(LCase(strTmp), "/device/rawip") Or InStr(LCase(strTmp), "/device/tcp") Or InStr(LCase(strTmp), "/device/udp") Then
hEvent = CreateEvent(ByVal 0&, 1, 0, vbNullString)
ReDim bytBytes(129)
objTdi_RequestInfo.QueryType = TDI_QUERY_ADDRESS_INFO
ntStatus = NtDeviceIoControlFile(hFileHandle, hEvent, ByVal 0&, ByVal 0&, objIoStatusBlock, IOCTL_TDI_QUERY_INFORMATION, objTdi_RequestInfo, Len(objTdi_RequestInfo), bytBuffer(0), 130)
If (NT_SUCCESS(ntStatus)) Then
' CopyMemory hAddr, ByVal StrPtr(bytBuffer) + 15, 4
CopyMemory hAddr, bytBuffer(14), 4
hAddr = inet_ntoa(hAddr)
strAddress = String(30, Chr(0))
lstrcpyW strAddress, hAddr
strAddress = Left(strAddress & Chr(0), InStr(strAddress, Chr(0)) - 1)
strProcessName = GetProcessPathByHandle(hProcessToDup)
' CopyMemory intPort, ByVal StrPtr(bytBuffer) + 13, 2
CopyMemory intPort, bytBuffer(12), 2
intPort = ntohs(intPort)
If InStr(LCase(strTmp), "/device/rawip") Then
strTmp = "类型是:RawIp " & "IP地址:" & strAddress & ":" & intPort & Space(22 - Len(strAddress & ":" & intPort)) & "进程PID是:" & objCid.UniqueProcess & Space(8 - Len(CStr(objCid.UniqueProcess))) & "进程路径是:" & strProcessName
ElseIf InStr(LCase(strTmp), "/device/tcp") Then
strTmp = "类型是:Tcp " & "IP地址:" & strAddress & ":" & intPort & Space(22 - Len(strAddress & ":" & intPort)) & "进程PID是:" & objCid.UniqueProcess & Space(8 - Len(CStr(objCid.UniqueProcess))) & "进程路径是:" & strProcessName
ElseIf InStr(LCase(strTmp), "/device/udp") Then
strTmp = "类型是:Udp " & "IP地址:" & strAddress & ":" & intPort & Space(22 - Len(strAddress & ":" & intPort)) & "进程PID是:" & objCid.UniqueProcess & Space(8 - Len(CStr(objCid.UniqueProcess))) & "进程路径是:" & strProcessName
End If
If intMaxWidth = 0 Then
intMaxWidth = frmMain.ScaleX(frmMain.TextWidth(strTmp), vbTwips, vbPixels) + 4
Else
If intMaxWidth < frmMain.ScaleX(frmMain.TextWidth(strTmp), vbTwips, vbPixels) + 4 Then
intMaxWidth = frmMain.ScaleX(frmMain.TextWidth(strTmp), vbTwips, vbPixels) + 4
End If
End If
frmMain.lstInfo.AddItem strTmp
SendMessage frmMain.lstInfo.hwnd, LB_SETHORIZONTALEXTENT, intMaxWidth, ByVal 0&
End If
End If
NtClose hFileHandle
End If
End If
End If
Next
NtClose hTcpHandle
NtClose hUdpHandle
NtClose hRawIpHandle
EmunNetInfo = blnIsOk
End Function
Public Function GetNetTcpHandle() As Long
Dim objNetString As UNICODE_STRING
Dim objAttributes As OBJECT_ATTRIBUTES
Dim objIoStatusBlock As IO_STATUS_BLOCK
Dim hHandle As Long, ntStatus As Long
RtlInitUnicodeString objNetString, StrPtr("/Device/Tcp")
objAttributes.Length = Len(objAttributes)
objAttributes.RootDirectory = 0
objAttributes.ObjectName = VarPtr(objNetString)
objAttributes.Attributes = OBJ_CASE_INSENSITIVE
objAttributes.SecurityDescriptor = 0
objAttributes.SecurityQualityOfService = 0
ntStatus = NtOpenFile(hHandle, &H100000, objAttributes, objIoStatusBlock, 3, 0)
If (NT_SUCCESS(ntStatus)) Then GetNetTcpHandle = hHandle
End Function
Public Function GetNetUdpHandle() As Long
Dim objNetString As UNICODE_STRING
Dim objAttributes As OBJECT_ATTRIBUTES
Dim objIoStatusBlock As IO_STATUS_BLOCK
Dim hHandle As Long, ntStatus As Long
RtlInitUnicodeString objNetString, StrPtr("/Device/Udp")
objAttributes.Length = Len(objAttributes)
objAttributes.RootDirectory = 0
objAttributes.ObjectName = VarPtr(objNetString)
objAttributes.Attributes = OBJ_CASE_INSENSITIVE
objAttributes.SecurityDescriptor = 0
objAttributes.SecurityQualityOfService = 0
ntStatus = NtOpenFile(hHandle, &H100000, objAttributes, objIoStatusBlock, 3, 0)
If (NT_SUCCESS(ntStatus)) Then GetNetUdpHandle = hHandle
End Function
Public Function GetNetRawIpHandle() As Long
Dim objNetString As UNICODE_STRING
Dim objAttributes As OBJECT_ATTRIBUTES
Dim objIoStatusBlock As IO_STATUS_BLOCK
Dim hHandle As Long, ntStatus As Long
RtlInitUnicodeString objNetString, StrPtr("/Device/RawIp")
objAttributes.Length = Len(objAttributes)
objAttributes.RootDirectory = 0
objAttributes.ObjectName = VarPtr(objNetString)
objAttributes.Attributes = OBJ_CASE_INSENSITIVE
objAttributes.SecurityDescriptor = 0
objAttributes.SecurityQualityOfService = 0
ntStatus = NtOpenFile(hHandle, &H100000, objAttributes, objIoStatusBlock, 3, 0)
If (NT_SUCCESS(ntStatus)) Then GetNetRawIpHandle = hHandle
End Function