求大神帮我看看，用VB写的获得TCP协议网络状态，打开不显示东西
’用vb6写的，一个Frm_Main窗口一个ListView控件一个Timer控件’Frm_Main代码
Private Sub ListView1_BeforeLabelEdit(Cancel As Integer)
heaphwd = GetProcessHeap() '获取调用过程堆句柄
End Sub
Private Sub Timer1_Timer()
Dim ret As Boolean
On Error Resume Next
ret = InternetGetConnectedState(0, 0)
If ret Then
GetNetState
End If
On Error GoTo 0
End Sub
’添加模块Mdl_GetNetState代码
Option Explicit
Public Declare Function InternetGetConnectedState Lib "wininet" (lpdwFlags As Long, ByVal dwReserved As Long) As Boolean
'For netstat
Private Const PROCESS_VM_READ As Long = &H10
Private Const PROCESS_QUERY_INFORMATION As Long = &H400
Private Const MIB_TCP_STATE_CLOSED As Long = 1
Private Const MIB_TCP_STATE_LISTEN As Long = 2
Private Const MIB_TCP_STATE_SYN_SENT As Long = 3
Private Const MIB_TCP_STATE_SYN_RCVD As Long = 4
Private Const MIB_TCP_STATE_ESTAB As Long = 5
Private Const MIB_TCP_STATE_FIN_WAIT1 As Long = 6
Private Const MIB_TCP_STATE_FIN_WAIT2 As Long = 7
Private Const MIB_TCP_STATE_CLOSE_WAIT As Long = 8
Private Const MIB_TCP_STATE_CLOSING As Long = 9
Private Const MIB_TCP_STATE_LAST_ACK As Long = 10
Private Const MIB_TCP_STATE_TIME_WAIT As Long = 11
Private Const MIB_TCP_STATE_DELETE_TCB As Long = 12
Private Type PMIB_UDPEXROW
dwLocalAddr As Long
dwLocalPort As Long
dwProcessId As Long
End Type
Private Type PMIB_TCPEXROW
dwStats As Long
dwLocalAddr As Long
dwLocalPort As Long
dwRemoteAddr As Long
dwRemotePort As Long
dwProcessId As Long
End Type
Public heaphwd As Long
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * 260
End Type
Private Declare Function AllocateAndGetTcpExTableFromStack Lib "iphlpapi.dll" (ByRef pTcpTable As Any, _
ByRef bOrder As Boolean, _
ByVal heap As Long, _
ByVal zero As Long, _
ByVal flags As Long) As Long
Private Declare Function AllocateAndGetUdpExTableFromStack Lib "iphlpapi.dll" (ByRef pTcpTable As Any, _
ByRef bOrder As Boolean, _
ByVal heap As Long, _
ByVal zero As Long, _
ByVal flags As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, _
Source As Any, _
ByVal Length As Long)
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, _
ByVal dwFlags As Long, _
lpMem As Any) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function GetProcessHeap Lib "kernel32.dll" () As Long
Private Declare Function GetModuleBaseName Lib "psapi.dll" Alias "GetModuleBaseNameA" (ByVal hProcess As Long, _
ByVal hModule As Long, _
ByVal lpFileName As String, _
ByVal nSize As Long) As Long
Private Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, _
lphModule As Long, _
ByVal cb As Long, _
lpcbNeeded As Long) As Long
Private Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal hProcess As Long, _
ByVal hModule As Long, _
ByVal lpFileName As String, _
ByVal nSize As Long) As Long
Private Function GetIpString(ByVal Value As Long) As String '获取ip字符串
Dim table(3) As Byte
CopyMemory table(0), Value, 4
GetIpString = table(0) & "." & table(1) & "." & table(2) & "." & table(3)
End Function
Private Function GetPortNumber(ByVal Value As Long) As Long '获取端口号
GetPortNumber = (Value / 256) + (Value Mod 256) * 256
End Function
Private Function GetProcessName(ByVal ProcessID As Long) As String '获取进程名称
Dim strName As String * 1024
Dim hProcess As Long
Dim cbNeeded As Long
Dim hMod As Long
Select Case ProcessID
Case 0
GetProcessName = "Proccess Inactive"
Case 4
GetProcessName = "System"
Case Else
GetProcessName = "Unknown"
End Select
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, ProcessID)
If hProcess Then
If EnumProcessModules(hProcess, hMod, Len(hMod), cbNeeded) Then '枚举进程中模块
GetModuleBaseName hProcess, hMod, strName, Len(strName) '获取模块基本名称
GetProcessName = Left$(strName, lstrlen(strName)) '返回模块基本名称
End If
CloseHandle hProcess
End If
End Function
Private Function GetState(ByVal Value As Long) As String
Select Case Value
Case MIB_TCP_STATE_ESTAB
GetState = "ESTABLISH" '建立
Case MIB_TCP_STATE_CLOSED
GetState = "CLOSED" '关闭
Case MIB_TCP_STATE_LISTEN
GetState = "LISTEN" '监听
Case MIB_TCP_STATE_CLOSING '关闭中
GetState = "CLOSING"
Case MIB_TCP_STATE_LAST_ACK
GetState = "LAST_ACK" '最后一次应答
Case MIB_TCP_STATE_SYN_SENT
GetState = "SYN_SENT"
Case MIB_TCP_STATE_SYN_RCVD
GetState = "SYN_RCVD"
Case MIB_TCP_STATE_FIN_WAIT1
GetState = "FIN_WAIT1"
Case MIB_TCP_STATE_FIN_WAIT2
GetState = "FIN_WAIT2"
Case MIB_TCP_STATE_TIME_WAIT
GetState = "TIME_WAIT" '等待时间
Case MIB_TCP_STATE_CLOSE_WAIT
GetState = "CLOSE_WAIT" '关闭等待
Case MIB_TCP_STATE_DELETE_TCB
GetState = "DELETE_TCB" '删除TCB
End Select
End Function
Public Sub GetNetState()
Dim TcpExTable() As PMIB_TCPEXROW
Dim UdpExTable() As PMIB_UDPEXROW
Dim Pointer As Long
Dim Number As Long
Dim Size As Long
Dim i As Long
Dim tmp(9, 1000) As String
Dim ret As Boolean
On Error Resume Next
On Error GoTo 0
Frm_Main.ListView1.ListItems.Clear
DoEvents
'for TCP
On Error Resume Next
'***********************************************************************************************
'*** TCP 网 络 连 接 （开始） ***
'***********************************************************************************************
If AllocateAndGetTcpExTableFromStack(Pointer, True, heaphwd, 2, 2) = 0 Then '分配并获取TCPextable
CopyMemory Number, ByVal Pointer, 4
If Number Then
ReDim TcpExTable(Number - 1) As PMIB_TCPEXROW '重定义数组
Size = Number * Len(TcpExTable(0)) '获取要传递的长度
CopyMemory TcpExTable(0), ByVal Pointer + 4, Size '数组传递
For i = 0 To UBound(TcpExTable)
tmp(0, i) = "TCP"
tmp(1, i) = GetIpString(TcpExTable(i).dwLocalAddr) '获取本地地址
tmp(2, i) = GetPortNumber(TcpExTable(i).dwLocalPort) '获取本地端口
If GetIpString(TcpExTable(i).dwRemoteAddr) = "0.0.0.0" Then '当没获取IP时
tmp(3, i) = ""
tmp(4, i) = ""
tmp(5, i) = ""
Else
With TcpExTable(i)
tmp(3, i) = GetIpString(.dwRemoteAddr) '获取远程IP
' tmp(4, i) = "" 'GetIpString(.dwRemoteAddr) '获取远程服务器名
tmp(4, i) = GetPortNumber(.dwRemotePort) '获取远程端口号
End With 'TcpExTable(i)
End If
With TcpExTable(i)
tmp(5, i) = GetState(.dwStats) '获取状态
tmp(6, i) = .dwProcessId '获取进程ID
tmp(7, i) = GetProcessName(.dwProcessId) '获取进程名称
tmp(8, i) = ProcessPathByPID(.dwProcessId) '获取进程路径
End With 'TcpExTable(i)
Next i
End If
HeapFree heaphwd, 0, ByVal Pointer '释放从堆中分配的内存
For i = 0 To UBound(TcpExTable)
With Frm_Main.ListView1.ListItems.Add
.Text = tmp(0, i)
.SubItems(1) = tmp(1, i)
.SubItems(2) = tmp(2, i)
.SubItems(3) = tmp(3, i)
.SubItems(4) = tmp(4, i)
.SubItems(5) = tmp(5, i)
.SubItems(6) = tmp(6, i)
.SubItems(7) = tmp(7, i)
.SubItems(8) = tmp(8, i)
' .SubItems(9) = tmp(9, i)
End With
Next i
End If
'***********************************************************************************************
'*** TCP 网 络 连 接 （结束） ***
'***********************************************************************************************
'--------------------------------------------------------------------------------------------------------------
'***********************************************************************************************
'*** UDP 网 络 连 接 （开始） ***
'***********************************************************************************************
If AllocateAndGetUdpExTableFromStack(Pointer, True, heaphwd, 2, 2) = 0 Then '分配并获取UDPextable
CopyMemory Number, ByVal Pointer, 4 '赋值
If Number Then '当值大于0时
ReDim UdpExTable(Number - 1) As PMIB_UDPEXROW
Size = Number * Len(UdpExTable(0))
CopyMemory UdpExTable(0), ByVal Pointer + 4, Size '传递UdpExTable对象
For i = 0 To UBound(UdpExTable)
tmp(0, i) = "UDP"
tmp(1, i) = GetIpString(UdpExTable(i).dwLocalAddr) '本地地址
tmp(2, i) = GetPortNumber(UdpExTable(i).dwLocalPort) '本地端口
tmp(3, i) = ""
tmp(4, i) = ""
tmp(5, i) = ""
tmp(6, i) = "LISTEN"
With UdpExTable(i)
tmp(7, i) = .dwProcessId
tmp(8, i) = GetProcessName(.dwProcessId)
tmp(9, i) = ProcessPathByPID(.dwProcessId)
End With 'UdpExTable(i)
Next i
For i = 0 To UBound(UdpExTable)
With Frm_Main.ListView1.ListItems.Add '添加列表项
.Text = tmp(0, i)
.SubItems(1) = tmp(1, i)
.SubItems(2) = tmp(2, i)
.SubItems(3) = tmp(3, i)
.SubItems(4) = tmp(4, i)
.SubItems(5) = tmp(5, i)
.SubItems(6) = tmp(6, i)
.SubItems(7) = tmp(7, i)
.SubItems(8) = tmp(8, i)
.SubItems(9) = tmp(9, i)
End With
Next i
End If
'***********************************************************************************************
'*** UDP 网 络 连 接 （结束） ***
'***********************************************************************************************
HeapFree heaphwd, 0, ByVal Pointer '释放从堆中分配的内存
End If
DoEvents
On Error GoTo 0
End Sub
Private Function ProcessPathByPID(PID As Long) As String '根据PID获取进程路径
Dim cbNeeded As Long
Dim Modules(1 To 2000) As Long
Dim ret As Long
Dim ModuleName As String
Dim nSize As Long
Dim hProcess As Long
'PROCESS_QUERY_INFORMATION：Enables using the process handle in the GetExitCodeProcess and GetPriorityClass functions to read information from the process object.
'PROCESS_VM_READ：Enables using the process handle in the ReadProcessMemory function to read from the virtual memory of the process
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, PID) '进程句柄
If hProcess <> 0 Then
ret = EnumProcessModules(hProcess, Modules(1), 20000, cbNeeded) '返回指定进程中所有模块
If ret <> 0 Then
ModuleName = Space$(260)
nSize = 5000
ret = GetModuleFileNameExA(hProcess, Modules(1), ModuleName, nSize) '获取模块路径
ProcessPathByPID = Left$(ModuleName, ret) '返回模路径
End If
End If
ret = CloseHandle(hProcess) '关闭一个内核对象
If LenB(ProcessPathByPID) = 0 Then
ProcessPathByPID = "SYSTEM"
End If
End Function
