form1.frm

电子书“Visual Basic 6 网络编程实例教程.rar”

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "TCP连接表"
   ClientHeight    =   4350
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8445
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4350
   ScaleWidth      =   8445
   StartUpPosition =   2  '屏幕中心
   Begin MSComctlLib.ListView LvwTcpTable 
      Height          =   3375
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   8175
      _ExtentX        =   14420
      _ExtentY        =   5953
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin VB.CommandButton CmdRun 
      Caption         =   "运行(&R)"
      Default         =   -1  'True
      Height          =   495
      Left            =   3000
      TabIndex        =   0
      Top             =   3720
      Width           =   2055
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Function GetInetStrFromPtr(Address As Long) As String
    GetInetStrFromPtr = GetStrFromPtrA(inet_ntoa(Address))
End Function

Private Function GetStrFromPtrA(ByVal lpszA As Long) As String
    GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
    Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
End Function

Private Sub CmdRun_Click()
    Dim TcpRow As MIB_TCPROW
    Dim buff() As Byte
    Dim cbRequired As Long
    Dim nStructSize As Long
    Dim nRows As Long
    Dim cnt As Long
    Dim tmp As String
    Dim itmx As ListItem
    Call GetTcpTable(ByVal 0&, cbRequired, 1)
    If cbRequired > 0 Then
        ReDim buff(0 To cbRequired - 1) As Byte
        If GetTcpTable(buff(0), cbRequired, 1) = ERROR_SUCCESS Then
            '用下面的CopyMemory调用中的Lenb来保存数据
            nStructSize = LenB(TcpRow)
            '前4个字节是一个长整形，指明了表的入口
            CopyMemory nRows, buff(0), 4
            For cnt = 1 To nRows
                '移动到前面的4个字节之后，提取相应数据，
                '并将其转换为TcpRow类型
                CopyMemory TcpRow, buff(4 + (cnt - 1) * nStructSize), nStructSize
                '将结果填写到列表视
                With TcpRow
                Set itmx = LvwTcpTable.ListItems.Add(, , GetInetStrFromPtr(.dwLocalAddr))
                itmx.SubItems(1) = ntohs(.dwLocalPort)
                itmx.SubItems(2) = GetInetStrFromPtr(.dwRemoteAddr)
                itmx.SubItems(3) = ntohs(.dwRemotePort)
                itmx.SubItems(4) = (.dwState)
                '对于MIB_TCP_STATE_DELETE_TCB中的成员，
                'MSDN只有一些说明性的定义
                Select Case .dwState
                    Case MIB_TCP_STATE_CLOSED:       tmp = "关闭"
                    Case MIB_TCP_STATE_LISTEN:       tmp = "监听"
                    Case MIB_TCP_STATE_SYN_SENT:     tmp = "发送"
                    Case MIB_TCP_STATE_SYN_RCVD:     tmp = "接受"
                    Case MIB_TCP_STATE_ESTAB:        tmp = "建立连接"
                    Case MIB_TCP_STATE_FIN_WAIT1:    tmp = "等待fin 1"
                    Case MIB_TCP_STATE_FIN_WAIT2:    tmp = "等待fin 2"
                    Case MIB_TCP_STATE_CLOSE_WAIT:   tmp = "关闭等待"
                    Case MIB_TCP_STATE_CLOSING:      tmp = "正在关闭"
                    Case MIB_TCP_STATE_LAST_ACK:     tmp = "最近的ack"
                    Case MIB_TCP_STATE_TIME_WAIT:    tmp = "限时等待"
                    Case MIB_TCP_STATE_DELETE_TCB:   tmp = "TCB被删除"
                End Select
                itmx.SubItems(5) = tmp
                tmp = ""
                End With
            Next
        End If
    End If
End Sub

Private Sub Form_Load()
    With LvwTcpTable
        .View = lvwReport
        .ColumnHeaders.Add , , "本机IP地址"
        .ColumnHeaders.Add , , "本地端口"
        .ColumnHeaders.Add , , "远程IP地址"
        .ColumnHeaders.Add , , "远程端口"
        .ColumnHeaders.Add , , "状态(十进制)"
        .ColumnHeaders.Add , , "状态说明"
    End With
End Sub

Private Sub LvwTcpTable_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    LvwTcpTable.SortKey = ColumnHeader.Index - 1
    LvwTcpTable.SortOrder = Abs(Not LvwTcpTable.SortOrder = 1)
    LvwTcpTable.Sorted = True
End Sub