| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1156 人关注过本帖
标题:求大神帮我看看,用VB写的获得TCP协议网络状态,打开不显示东西
只看楼主 加入收藏
唯月
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2016-5-20
收藏
 问题点数:0 回复次数:0 
求大神帮我看看,用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
搜索更多相关主题的帖子: 网络 
2016-05-20 11:01
快速回复:求大神帮我看看,用VB写的获得TCP协议网络状态,打开不显示东西
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.031185 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved