进程-端口-IP地址关联演示

这篇文章是我看了一篇VC的文章增加修改而来,原文章地址我也忘记了,作者也不是很清楚,在这里希望原作者能原谅. 

此代码演示了进程和端口以及IP地址的关联,程序使用了ZwQuerySystemInformation函数来枚举所有打开的句柄然后再使用ZwQueryObject函数来获取句柄所对应的路径,如果发现路径正包含/device/rawip或者/device/tcp或者/device/udp即是我们需要查找的对象.目前程序还有个缺陷就是无法获取远程IP地址和端口,我目前也还没找到方法,如果有懂这方面的高手可以把代码继续完善一下,好方便大家使用.

使用此方法枚举的信息可以躲过拦截相关的API函数来隐藏IP地址和端口的程序.

话不多说了,本来想把注释写详细些,一个由于时间太晚得睡觉了,还有就是我我基本上都是用的解锁文件的代码Copy过来的稍微修改了下.比如获取进程路径,枚举句柄等,如果不懂的可以在我的博客查看我"解锁文件"的相关文件有详细注释.下面我就把完整代码贴上来.

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

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

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

NtClose hProcessToDup

GetHandleByProcessId = hProcessHandle

Exit Function

End If

End If

NtClose hProcessToDup

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 pInfo, ByVal objTdi_RequestInfo.RequestConnectionInformation, Len(pInfo)

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

NtClose hEvent

End If

NtClose hFileHandle

End If

NtClose hProcessToDup

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