shell "netstat"  '''察看网络状态具体对应到哪个进程暂时不知道

解决方案 »

  1.   

    使用微软的IP助手库函数(iphlpapi.dll)是一个捷径。其中的 GetTcpTable函数能返回当前系统中全部有效的 TCP连接。其定义为: 
    DWORD GetTcpTable( 
    PMIB_TCPTABLE pTcpTable, // buffer for the connection table 
    PDWORD pdwSize, // size of the buffer 
    BOOL bOrder // sort the table? 
    ); 
     
    其中参数一是 TCP连接表缓冲区的指针,参数二是缓冲区大小(当缓冲区不够大时,该参数返回实际需要的大小),参数三指示连接表是否需要按“Local IP”、“Localport”、“Remote IP”、“Remote port”依次进行排序。 
      

  2.   

    实例程序:
    Option Explicit 
    Private Type MIB_TCPROW ' TCP连接表中一行的结构 
    dwState As Long ' 状态 
    dwLocalAddr As Long ' Local IP 
    dwLocalPort As Long ' Local port 
    dwRemoteAddr As Long ' Remote IP 
    dwRemotePort As Long ' Remote port 
    End Type 
    Private Type MIB_TCPTABLE 
    dwNum_Of_Entries As Long ' 当前 TCP连接的总数 
    TCP_Table(120) As MIB_TCPROW ' 预留了120行的缓冲区 
    End Type 
    Private Declare Function GetTcpTable Lib "iphlpapi.dll" (ByRef pTcpTable _ 
    As MIB_TCPTABLE, ByRef pdwSize As Long, ByVal bOrder As Long) As Long 
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef _ 
    pDest As Any, ByRef pSource As Any, ByVal Length As Long) 
    Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" _ 
    (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long 
    Private Declare Function GetWindowsDirectory Lib "kernel32" Alias _ 
    "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long 
    Private Declare Function SetTcpEntry Lib "iphlpapi.dll" (ByRef pTcpTable _ 
    As MIB_TCPROW) As Long 
    Dim Last_Num_Of_Entries As Long 
    Dim TCP1 As MIB_TCPTABLE 
    Private Sub Form_Load() 
    Timer1.Interval = 10000 ' 定时监控 
    Timer1_Timer 
    End Sub 
    Private Sub Timer1_Timer() 
    Dim Return1 As Long, i As Long, Tmp1 As Long, Tmp2 As Long 
    Dim Ip_Buf(1 To 4) As Byte 
    Dim Win_Path As String, Tmp3 As String 
    Return1 = GetTcpTable(TCP1, Len(TCP1), 1) ' 返回 TCP连接表 
    If Last_Num_Of_Entries <> 0 And _ 
    Last_Num_Of_Entries <> TCP1.dwNum_Of_Entries Then ' 有异常时发出警告 
    Picture1.Visible = True ' 设置警告标志 
    On Error Resume Next 
    Win_Path = String(145, 0) 
    i = GetWindowsDirectory(Win_Path, 145) 
    Win_Path = Left(Win_Path, i) 
    i = sndPlaySound(Win_Path + "\Media\Ding.wav", &H1) ' 发出报警声音 
    On Error GoTo 0 
    Else 
    If Picture1.Visible = True Then Picture1.Visible = False 
    End If 
    Last_Num_Of_Entries = TCP1.dwNum_Of_Entries 
    Select Case Return1 ' 判断返回值 
    Case 0&: 
    Text1 = "": Combo1.Clear 
    For i = 0 To TCP1.dwNum_Of_Entries - 1 
    Tmp3 = Str(i + 1) + " " 
    Select Case TCP1.TCP_Table(i).dwState ' 显示连接状态 
    Case 1: Tmp3 = Tmp3 + "CLOSED" 
    Case 2: Tmp3 = Tmp3 + "LISTENING" 
    Case 3: Tmp3 = Tmp3 + "SYN_SENT" 
    Case 4: Tmp3 = Tmp3 + "SYN_RCVD" 
    Case 5: Tmp3 = Tmp3 + "ESTABLISHED" 
    Case 6: Tmp3 = Tmp3 + "FIN_WAIT1" 
    Case 7: Tmp3 = Tmp3 + "FIN_WAIT2" 
    Case 8: Tmp3 = Tmp3 + "CLOSE_WAIT" 
    Case 9: Tmp3 = Tmp3 + "CLOSING" 
    Case 10: Tmp3 = Tmp3 + "LAST_ACK" 
    Case 11: Tmp3 = Tmp3 + "TIME_WAIT" 
    Case 12: Tmp3 = Tmp3 + "DELETE_TCB" 
    End Select 
    Combo1.AddItem Tmp3 ' 充实列表以供用户删除 
    Tmp3 = Tmp3 + ":" + vbCrLf + vbTab + "Local: " ' 本地IP 
    CopyMemory Ip_Buf(1), TCP1.TCP_Table(i).dwLocalAddr, 4 
    Tmp3 = Tmp3 + CStr(Ip_Buf(1)) + "." + CStr(Ip_Buf(2)) + "." _ 
    + CStr(Ip_Buf(3)) + "." + CStr(Ip_Buf(4)) 
    Tmp1 = TCP1.TCP_Table(i).dwLocalPort ' 本地端口 
    Tmp2 = Tmp1 / 256 + (Tmp1 Mod 256) * 256 
    Tmp3 = Tmp3 + ":" + Str(Tmp2) + vbTab + "Remote: " ' 远程IP 
    CopyMemory Ip_Buf(1), TCP1.TCP_Table(i).dwRemoteAddr, 4 
    Tmp3 = Tmp3 + CStr(Ip_Buf(1)) + "." + CStr(Ip_Buf(2)) + "." _ 
    + CStr(Ip_Buf(3)) + "." + CStr(Ip_Buf(4)) 
    Tmp1 = TCP1.TCP_Table(i).dwRemotePort ' 远程端口 
    Tmp2 = Tmp1 / 256 + (Tmp1 Mod 256) * 256 
    Tmp3 = Tmp3 + ":" + Str(Tmp2) + vbCrLf 
    Text1 = Text1 + Tmp3 
    Next i 
    Case 50&: 
    MsgBox "系统不支持该API函数": End 
    Case 87: 
    MsgBox "无效的参数": End 
    Case 111&: 
    MsgBox "缓冲区溢出": End 
    Case 232&: 
    MsgBox "无数据": End 
    End Select 
    End Sub 
    Private Sub 删除该连接_Click() 
    Dim Return1 As Long 
    If Combo1.ListIndex < 0 Then Exit Sub 
    ' 将欲删连接的状态置为MIB_TCP_STATE_DELETE_TCB(值为12) 
    TCP1.TCP_Table(Combo1.ListIndex).dwState = 12 
    Return1 = SetTcpEntry(TCP1.TCP_Table(Combo1.ListIndex)) ' 执行删除 
    If Return1 = 0 Then 
    MsgBox "成功删除当前连接" 
    Else 
    MsgBox "删除连接失败" 
    End If 
    Timer1_Timer 
    End Sub