当前位置: 源码素材网 » VB教程 » 详情页

Vb获取基于TCP协议连接的网络状态

  •   时间:2018-12-31
  • 概述:TCP 网络连接 协议

VB获取网络状态,只获取基于TCP协议的状态,程序运行后稍等2秒即可显示运行结果,将列出本地IP、本地端口、远程IP、远程端口、连接状态、PID和进程及程序路径信息,以下为代码:

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form Frm_Main
   BorderStyle     =   1  'Fixed Single
   Caption         =   "获取TCP协议网络状态"
   ClientHeight    =   5580
   ClientLeft      =   150
   ClientTop       =   435
   ClientWidth     =   13455
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   5580
   ScaleWidth      =   13455
   StartUpPosition =   1  '所有者中心
   Begin VB.Timer Timer1
      Interval        =   2000
      Left            =   1560
      Top             =   600
   End
   Begin MSComctlLib.ListView ListView1
      Height          =   5520
      Left            =   0
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   30
      Width           =   13410
      _ExtentX        =   23654
      _ExtentY        =   9737
      View            =   3
      MultiSelect     =   -1  'True
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      FullRowSelect   =   -1  'True
      _Version        =   393217
      ForeColor       =   16711680
      BackColor       =   16777215
      BorderStyle     =   1
      Appearance      =   0
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      NumItems        =   9
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         Text            =   "协议"
         Object.Width           =   1060
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         SubItemIndex    =   1
         Text            =   "本地 IP"
         Object.Width           =   2469
      EndProperty
      BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         SubItemIndex    =   2
         Text            =   "本地端口"
         Object.Width           =   1764
      EndProperty
      BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         SubItemIndex    =   3
         Text            =   "远程 IP"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         SubItemIndex    =   4
         Text            =   "远程端口"
         Object.Width           =   1764
      EndProperty
      BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         SubItemIndex    =   5
         Text            =   "状态"
         Object.Width           =   2117
      EndProperty
      BeginProperty ColumnHeader(7) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         SubItemIndex    =   6
         Text            =   "PID"
         Object.Width           =   1236
      EndProperty
      BeginProperty ColumnHeader(8) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         SubItemIndex    =   7
         Text            =   "进程"
         Object.Width           =   2469
      EndProperty
      BeginProperty ColumnHeader(9) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         SubItemIndex    =   8
         Text            =   "路径"
         Object.Width           =   8114
      EndProperty
   End
End
Attribute VB_Name = "Frm_Main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load()
    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

 

bas类文件:

Attribute VB_Name = "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 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
    On Error Resume Next
    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)
            End With
        Next i
    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
    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

    相关声明:

      若“Vb获取基于TCP协议连接的网络状态”有损您的权益,请告之我们删除内容。
      部分文章来源于网络,版权归原作者所有。