VB检测TCP连接
2009-5-11 11:05
提问者：luker1004 | 悬赏分：50 | 浏览次数：1148次
需要一个VB程序，监测vb listview控件TCP连接，动态刷新IP地址清单（或者5秒刷新一次）。
需要源代码。
2009-5-11 12:31
最佳答案
'新建工程，部件-控件 Microsoft windows Common Controls 6.0(SP6)
'在窗体中添加listview1以及Timer1
'Timer1.Interval=500
'窗体中复制如下代码
  '  取得  TCP  连接状态表
     
  Option Explicit
   
  Private Type MIB_TCPROW
          dwState  As Long                    '  TCP连接状态
          dwLocalAddr  As Long            '  本机IP   
          dwLocalPort  As Long            '  本机端口编号
          dwRemoteAddr  As Long          '  远程IP   
          dwRemotePort  As Long          '  远程端口编号
  End Type
   
  Private Const ERROR_SUCCESS                            As Long = 0
  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 Declare Function GetTcpTable Lib "iphlpapi.dll" (ByRef pTcpTable As Any, ByRef pdwSize As Long, ByVal bOrder As Long) As Long
  Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dst As Any, src As Any, ByVal bcount As Long)
  Private Declare Function lstrcpyA Lib "kernel32" (ByVal RetVal As String, ByVal Ptr As Long) As Long
  Private Declare Function lstrlenA Lib "kernel32" (ByVal Ptr As Any) As Long
  Private Declare Function inet_ntoa Lib "wsock32.dll" (ByVal addr As Long) As Long
  Private Declare Function ntohs Lib "wsock32.dll" (ByVal addr As Long) As Long
         
  Public Function GetInetAddrStr(Address As Long) As String
          '呼叫  wsock32.dll  并且取得地址所使用的  Handle  值
          GetInetAddrStr = GetString(inet_ntoa(Address))
  End Function
   
  Private Sub Form_Load()
   
          '  初始化  ListView1  控件的行标题
          With ListView1
                  .View = lvwReport
                  .ColumnHeaders.Add , , "本机IP地址    "
                  .ColumnHeaders.Add , , "本机端口        "
                  .ColumnHeaders.Add , , "远程IP    "
                  .ColumnHeaders.Add , , "远程端口      "
                  .ColumnHeaders.Add , , "状态      "
          End With
          Me.Caption = "TCP  连接表监视清单"
          Timer1.Enabled = True
  End Sub
   
  Private Sub Form_Resize()
   
          ListView1.Height = Me.Height - 30 * Screen.TwipsPerPixelY
          ListView1.Width = Me.Width - 12 * Screen.TwipsPerPixelX
  End Sub
   
  '将长整数转换为字符串
  Public Function GetString(ByVal lpszA As Long) As String
          GetString = String$(lstrlenA(ByVal lpszA), 0)
          Call lstrcpyA(ByVal GetString, ByVal lpszA)
  End Function
   
  Private Sub GetTCPDatas()
   
  Dim TcpRow    As MIB_TCPROW
  Dim Buffer()    As Byte
  Dim LngRequired    As Long
  Dim LngStructureSize    As Long
  Dim LngRows    As Long
  Dim LngCounter    As Long
  Dim strTemps    As String
  Dim ListX    As ListItem
   
  ListView1.ListItems.Clear
  Call GetTcpTable(ByVal 0&, LngRequired, 1)
   
  If LngRequired > 0 Then
          ReDim Buffer(0 To LngRequired - 1) As Byte
          If GetTcpTable(Buffer(0), LngRequired, 1) = ERROR_SUCCESS Then
                  LngStructureSize = LenB(TcpRow)
   
                  '起始的四个字节，是做为表示进入点的数字
                  CopyMemory LngRows, Buffer(0), 4
                  For LngCounter = 1 To LngRows
   
                          '  将上述获得四个字节的相关数据，拷贝到  TcpRow  的结构之中
                          CopyMemory TcpRow, Buffer(4 + (LngCounter - 1) * LngStructureSize), LngStructureSize
                           
                          '  将结果传送到  ListView  之中
                          With TcpRow
                                  Set ListX = ListView1.ListItems.Add(, , GetInetAddrStr(.dwLocalAddr))
                                  ListX.SubItems(1) = ntohs(.dwLocalPort)

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。