bas.frm

vb编程+从基础到实践光盘代码

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   4395
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8865
   LinkTopic       =   "Form1"
   ScaleHeight     =   4395
   ScaleWidth      =   8865
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   5880
      TabIndex        =   2
      Top             =   3960
      Width           =   1215
   End
   Begin VB.CommandButton CmdRun 
      Caption         =   "Command1"
      Height          =   375
      Left            =   1200
      TabIndex        =   1
      Top             =   3960
      Width           =   1215
   End
   Begin MSComctlLib.ListView LvwTcpTable 
      Height          =   3855
      Left            =   120
      TabIndex        =   0
      Top             =   0
      Width           =   8655
      _ExtentX        =   15266
      _ExtentY        =   6800
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      AllowReorder    =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Private Sub CmdRun_Click()
Dim TcpRow As MIB_TCPROW
Dim buff() As Byte
Dim cbRequired As Long
Dim nStructSize As Long
Dim nRow 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, True) = ERROR_SUCCESS Then
    nStructSize = LenB(TcpRow)
    CopyMemory nrows, buff(0), 4
    For cnt = 1 To nrows
        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)
    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 wait 1"
        Case MIB_TCP_STATE_FIN_WAIT2: tmp = "fin wait 2"
        Case MIB_TCP_STATE_CLOSE_WAIT: tmp = "关闭等待"
        Case MIB_TCP_STATE_CLOSING: tmp = "正在关闭"
        Case MIB_TCP_STATE_LAST_ACK: tmp = "最近的尝试"
        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 Command1_Click()
End
End Sub

Private Sub Form_Load()
With LvwTcpTable
    .View = lvwReport
    .ColumnHeaders.Add , , "本机IP地"
    .ColumnHeaders.Add , , "本地端口"
    .ColumnHeaders.Add , , "远程IP地址"
    .ColumnHeaders.Add , , "远程端口"
    .ColumnHeaders.Add , , "状态"
    .ColumnHeaders.Add , , "状态说明"
    CmdRun.Caption = "运行"
    Command1.Caption = "退出"
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