VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmTcpTable
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Get TCP Table using IP Helper API"
   ClientHeight    =   4965
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7695
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   4965
   ScaleWidth      =   7695
   StartUpPosition =   3  'Windows Default
   Begin VB.CheckBox Check1
      Caption         =   "on't show rows for 0.0.0.0 and  127.0.0.1 IP addresses"
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   4440
      Width           =   4335
   End
   Begin VB.CommandButton Command2
      Cancel          =   -1  'True
      Caption         =   "Close"
      Height          =   375
      Left            =   6120
      TabIndex        =   2
      Top             =   4440
      Width           =   1455
   End
   Begin VB.CommandButton Command1
      Caption         =   "Get Tcp Table"
      efault         =   -1  'True
      Height          =   375
      Left            =   4560
      TabIndex        =   1
      Top             =   4440
      Width           =   1455
   End
   Begin MSComctlLib.ListView ListView1
      Height          =   4215
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   7455
      _ExtentX        =   13150
      _ExtentY        =   7435
      View            =   3
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   5
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         Text            =   "Loacal IP"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         SubItemIndex    =   1
         Text            =   "Local Port"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         SubItemIndex    =   2
         Text            =   "Remote IP"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         SubItemIndex    =   3
         Text            =   "Remote Port"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         SubItemIndex    =   4
         Text            =   "State"
         Object.Width           =   2540
      EndProperty
   End
End
Attribute VB_Name = "frmTcpTable"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'
Private Type MIB_TCPROW
    dwState As Long
    dwLocalAddr As Long
    dwLocalPort As Long
    dwRemoteAddr As Long
    dwRemotePort As Long
End Type
'
Private Const ERROR_BUFFER_OVERFLOW = 111&
Private Const ERROR_INVALID_PARAMETER = 87
Private Const ERROR_NO_DATA = 232&
Private Const ERROR_NOT_SUPPORTED = 50&
Private Const ERROR_SUCCESS = 0&
'
Private Const MIB_TCP_STATE_CLOSED = 1
Private Const MIB_TCP_STATE_LISTEN = 2
Private Const MIB_TCP_STATE_SYN_SENT = 3
Private Const MIB_TCP_STATE_SYN_RCVD = 4
Private Const MIB_TCP_STATE_ESTAB = 5
Private Const MIB_TCP_STATE_FIN_WAIT1 = 6
Private Const MIB_TCP_STATE_FIN_WAIT2 = 7
Private Const MIB_TCP_STATE_CLOSE_WAIT = 8
Private Const MIB_TCP_STATE_CLOSING = 9
Private Const MIB_TCP_STATE_LAST_ACK = 10
Private Const MIB_TCP_STATE_TIME_WAIT = 11
Private Const MIB_TCP_STATE_DELETE_TCB = 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" (ByRef pDest As Any, ByRef pSource As Any, ByVal Length As Long)
'

Private Sub Command1_Click()
    '
    Dim arrBuffer() As Byte
    Dim lngSize As Long
    Dim lngRetVal As Long
    Dim lngRows As Long
    Dim i As Long
    Dim TcpTableRow As MIB_TCPROW
    Dim lvItem As ListItem
    '
    ListView1.ListItems.Clear
    '
    lngSize = 0
    '
    'Call the GetTcpTable just to get the buffer size into the lngSize variable
    lngRetVal = GetTcpTable(ByVal 0&, lngSize, 0)
    '
    If lngRetVal = ERROR_NOT_SUPPORTED Then
        '
        'This API works only on Win 98//2000 and NT4 with SP4
        MsgBox "IP Helper is not supported by this system."
        Exit Sub
        '
    End If
    '
    'Prepare the buffer
    ReDim arrBuffer(0 To lngSize - 1) As Byte
    '
    'And call the function one more time
    lngRetVal = GetTcpTable(arrBuffer(0), lngSize, 0)
    '
    If lngRetVal = ERROR_SUCCESS Then
        '
        'The first 4 bytes contain the quantity of the table rows
        'Get that value to the lngRows variable
        CopyMemory lngRows, arrBuffer(0), 4
        '
        For i = 1 To lngRows
            '
            'Copy the table row data to the TcpTableRow structure
            CopyMemory TcpTableRow, arrBuffer(4 + (i - 1) * Len(TcpTableRow)), Len(TcpTableRow)
            '
            If Not ((Check1.Value = vbChecked) And (GetIpFromLong(TcpTableRow.dwLocalAddr) = "0.0.0.0" Or GetIpFromLong(TcpTableRow.dwLocalAddr) = "127.0.0.1") Then
                '
                'Add the data to the ListView control
                With TcpTableRow
                    Set lvItem = ListView1.ListItems.Add(, , GetIpFromLong(.dwLocalAddr))
                    lvItem.SubItems(1) = .dwLocalPort
                    lvItem.SubItems(2) = GetIpFromLong(.dwRemoteAddr)
                    lvItem.SubItems(3) = .dwRemotePort
                    lvItem.SubItems(4) = GetState(.dwState)
                End With
                '
            End If
            '
        Next i
        '
    End If
    '
End Sub

Private Sub Command2_Click()
    Unload Me
End Sub

Private Function GetIpFromLong(lngIPAddress As Long) As String
    '
    Dim arrIpParts(3) As Byte
    '
    CopyMemory arrIpParts(0), lngIPAddress, 4
    '
    GetIpFromLong = CStr(arrIpParts(0)) & "." & CStr(arrIpParts(1)) & "." & CStr(arrIpParts(2)) & "." & CStr(arrIpParts(3))
    '
End Function

Private Function GetState(lngState As Long) As String
    '
    Select Case lngState
        Case MIB_TCP_STATE_CLOSED: GetState = "CLOSED"
        Case MIB_TCP_STATE_LISTEN: GetState = "LISTEN"
        Case MIB_TCP_STATE_SYN_SENT: GetState = "SYN_SENT"
        Case MIB_TCP_STATE_SYN_RCVD: GetState = "SYN_RCVD"
        Case MIB_TCP_STATE_ESTAB: GetState = "ESTAB"
        Case MIB_TCP_STATE_FIN_WAIT1: GetState = "FIN_WAIT1"
        Case MIB_TCP_STATE_FIN_WAIT2: GetState = "FIN_WAIT2"
        Case MIB_TCP_STATE_CLOSE_WAIT: GetState = "CLOSE_WAIT"
        Case MIB_TCP_STATE_CLOSING: GetState = "CLOSING"
        Case MIB_TCP_STATE_LAST_ACK: GetState = "LAST_ACK"
        Case MIB_TCP_STATE_TIME_WAIT: GetState = "TIME_WAIT"
        Case MIB_TCP_STATE_DELETE_TCB: GetState = "ELETE_TCB"
    End Select
    '
End Function