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