miaozk2006

Private Const PROCESS_QUERY_INFORMATION = 1024
Private Const PROCESS_VM_READ = 16
Private Const MAX_PATH = 256
Private Const AF_INET6 = 23
Private Const AF_INET = 2
Public Enum TCP_TABLE_CLASS
    TCP_TABLE_BASIC_LISTENER
    TCP_TABLE_BASIC_CONNECTIONS
    TCP_TABLE_BASIC_ALL
    TCP_TABLE_OWNER_PID_LISTENER
    TCP_TABLE_OWNER_PID_CONNECTIONS
    TCP_TABLE_OWNER_PID_ALL
    TCP_TABLE_OWNER_MODULE_LISTENER
    TCP_TABLE_OWNER_MODULE_CONNECTIONS
    TCP_TABLE_OWNER_MODULE_ALL
End Enum
Private Type MIB_TCPROW_OWNER_PID
    dwState As Long
    dwLocalAddr As Long
    dwLocalPort As Long
    dwRemoteAddr As Long
    dwRemotePort As Long
    dwOwningPid As Long
End Type
Public Declare Function CloseHandle Lib "kernel32.dll" (ByVal Handle As Long) As Long
Public Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Public Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Public Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function htons Lib "ws2_32.dll" (ByVal dwLong As Long) As Long
Public Declare Function GetExtendedTcpTable Lib "IPHLPAPI.DLL" (pTcpTableEx As Any, lSize As Long, ByVal bOrder As Long, ByVal Flags As Long, ByVal TableClass As TCP_TABLE_CLASS, ByVal bReserved As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function SetTcpEntry Lib "IPHLPAPI.DLL" (ByRef pTcpTable As MIB_TCPROW_OWNER_PID) As Long
Private ½ø³Ì±íÖ¸Õë() As Byte
Public RÐÐ As Long
Private Êý¾Ý²Î¿¼ As Long

Public Function Ë¢ÐÂ() As Boolean
    Dim Ö¸Õë´óС As Long, ²Î¿¼ As Long
    Ö¸Õë´óС = 4
    ²Î¿¼ = GetExtendedTcpTable(0&, Ö¸Õë´óС, 1, AF_INET, TCP_TABLE_OWNER_PID_ALL, 0)
    ReDim ½ø³Ì±íÖ¸Õë(Ö¸Õë´óС - 1)
    ²Î¿¼ = GetExtendedTcpTable(½ø³Ì±íÖ¸Õë(0), Ö¸Õë´óС, 1, AF_INET, TCP_TABLE_OWNER_PID_ALL, 0)
    If ²Î¿¼ = 0 Then
        CopyMemory RÐÐ, ½ø³Ì±íÖ¸Õë(0), 4
    Else
        ˢР= False
        Exit Function
    End If
    If RÐÐ = 0 Or ½ø³Ì±íÖ¸Õë(0) Then
        ˢР= False
        Exit Function
    End If
End Function

Public Function ÇжϳÌÐòÍøÂçÁ´½Ó(½ø³ÌÃû As String)
    On Error Resume Next
    Dim i As Long
    Dim TCP±í As MIB_TCPROW_OWNER_PID
    Êý¾Ý²Î¿¼ = 0
    Dim ½ø³ÌÃû³Æ As String
    For i = 0 To RÐÐ
        ½ø³ÌÃû³Æ = ""
        CopyMemory TCP±í, ½ø³Ì±íÖ¸Õë(0 + Êý¾Ý²Î¿¼ + 4), LenB(TCP±í)
        If TCP±í.dwRemoteAddr <> 0 Or È¡¶Ë¿ÚºÅ(TCP±í.dwRemotePort) <> 0 Or È¡¶Ë¿ÚºÅ(TCP±í.dwLocalPort) <> 0 Then
            ' Debug.Print "״̬:"; c_state(TCP±í.dwState); ",";
            ' Debug.Print "±¾µØIP:"; »ñÈ¡IPµØÖ·(TCP±í.dwLocalAddr); ",";
            ' Debug.Print "±¾µØPORT:"; È¡¶Ë¿ÚºÅ(TCP±í.dwLocalPort); ",";
            ' Debug.Print "Ô¶³ÌIP:"; TCP±í.dwRemoteAddr; ",";
            ' Debug.Print "Ô¶³ÌPORT:"; È¡¶Ë¿ÚºÅ(TCP±í.dwRemotePort); ",";
            ' Debug.Print "½ø³ÌID:"; TCP±í.dwOwningPid; ",";
            ' Debug.Print "½ø³ÌÃû:"; »ñÈ¡½ø³Ì·¾¶(TCP±í.dwOwningPid)
            ½ø³ÌÃû³Æ = »ñÈ¡IPµØÖ·(TCP±í.dwRemoteAddr) & »ñÈ¡½ø³Ì·¾¶(TCP±í.dwOwningPid)
            If InStr(LCase$(½ø³ÌÃû³Æ), LCase$(½ø³ÌÃû)) > 0 Then
                TCP±í.dwState = 12
                SetTcpEntry TCP±í
            End If
        End If
        Êý¾Ý²Î¿¼ = Êý¾Ý²Î¿¼ + LenB(TCP±í)
        DoEvents
    Next i
End Function
Public Function È¡¶Ë¿ÚºÅ(ByVal dwPort As Long) As Long
    È¡¶Ë¿ÚºÅ = htons(dwPort)
End Function
Public Function »ñÈ¡IPµØÖ·(dwAddr As Long) As String
    Dim IPÊý¾Ý(3) As Byte
    CopyMemory IPÊý¾Ý(0), dwAddr, 4
    »ñÈ¡IPµØÖ· = CStr(IPÊý¾Ý(0)) & "." & CStr(IPÊý¾Ý(1)) & "." & CStr(IPÊý¾Ý(2)) & "." & CStr(IPÊý¾Ý(3))
End Function
Public Function »ñÈ¡½ø³Ì·¾¶(pid As Long) As String
    Dim cbNeeded As Long
    Dim Modules(1 To 200) As Long
    Dim nSize As Long
    Dim lRet As Long
    Dim ModuleName As String
    Dim hProcess As Long
    If pid = 0 Then »ñÈ¡½ø³Ì·¾¶ = "": Exit Function
    If pid = 4 Then »ñÈ¡½ø³Ì·¾¶ = "": Exit Function
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, pid)
    If hProcess <> 0 Then
        lRet = EnumProcessModules(hProcess, Modules(1), 200, cbNeeded)
        If lRet <> 0 Then
            ModuleName = Space$(MAX_PATH)
            nSize = MAX_PATH
            lRet = GetModuleFileNameExA(hProcess, Modules(1), ModuleName, nSize)
            If CBool(InStr(1, (Left$(ModuleName, lRet)), "", vbTextCompare)) Then
                »ñÈ¡½ø³Ì·¾¶ = Left$(ModuleName, lRet)
            End If
        End If
    End If
    lRet = CloseHandle(hProcess)
End Function