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

此代码演示了进程和端口以及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