新建模块 mod进程断网.bas,代码:
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