进程、端口、IP 关联演示

引用内容 引用内容

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

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

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



[本日志由 JiaJia 于 2008-03-29 05:12 PM 编辑]
文章来自: 本站原创
引用通告: 查看所有引用 | 我要引用此文章
Tags: VB 进程
评论: 0 | 引用: 0 | 查看次数: -
发表评论
昵 称:
密 码: 游客发言不需要密码.
内 容:
验证码: 验证码
选 项:
虽然发表评论不用注册,但是为了保护您的发言权,建议您注册帐号.