Code aus Module1.bas
Public Declare Function GetTcpTable Lib "IPHLPAPI.DLL" (ByRef _
    pTcpTable As MIB_TCPTABLE, ByRef pdwSize As Long, ByVal border _
    As Long) As Long
Public Type MIB_TCPROW
  dwState As tcpStates
  dwLocalAddr(0 To 3) As Byte
  dwLocalPort As String * 4
  dwRemoteAddr(0 To 3) As Byte
  dwRemotePort As String * 4
End Type
Public Type MIB_TCPTABLE
  dwNumEntries As Long
  Table(100) As MIB_TCPROW
End Type
Public Enum tcpStates
  TCP_STATE_CLOSED = 1
  TCP_STATE_LISTEN = 2
  TCP_STATE_SYN_SENT = 3
  TCP_STATE_SYN_RCVD = 4
  TCP_STATE_ESTAB = 5
  TCP_STATE_FIN_WAIT1 = 6
  TCP_STATE_FIN_WAIT2 = 7
  TCP_STATE_CLOSE_WAIT = 8
  TCP_STATE_CLOSING = 9
  TCP_STATE_LAST_ACK = 10
  TCP_STATE_TIME_WAIT = 11
  TCP_STATE_DELETE_TCB = 12
End Enum
Public Sub ListConnections()
  Dim ret As Long, tcpTable As MIB_TCPTABLE, intLoop As Integer
  Dim strState As String, strLocalAddr As String, strLocalPort As String
  Dim strRemoteAddr As String, strRemotePort As String
  Dim itemX As ListItem
    
    Form1.ListView1.ListItems.Clear
    
    ret = GetTcpTable(tcpTable, 2004, True)
    Select Case ret
      Case 0
        'Alles ok
        For intLoop = 0 To tcpTable.dwNumEntries - 1
          With tcpTable.Table(intLoop)
            strState = StateText(.dwState)
            strLocalAddr = .dwLocalAddr(0) & "." & .dwLocalAddr(1) _
                & "." & .dwLocalAddr(2) & "." & .dwLocalAddr(3)
            
            strLocalPort = CStr(GetPort(.dwLocalPort))
            strRemoteAddr = .dwRemoteAddr(0) & "." & _
                .dwRemoteAddr(1) & "." & .dwRemoteAddr(2) & "." & _
                .dwRemoteAddr(3)
            
            If .dwState = TCP_STATE_ESTAB Then
              strRemotePort = CStr(GetPort(.dwRemotePort))
            Else
              strRemotePort = "0"
            End If
          End With
          
          Set itemX = Form1.ListView1.ListItems.Add(, , strLocalAddr)
          itemX.SubItems(1) = strLocalPort
          itemX.SubItems(2) = strRemoteAddr
          itemX.SubItems(3) = strRemotePort
          itemX.SubItems(4) = strState
        Next intLoop
      Case 232
        'Kein Netzwerk vorhanden
      Case Else
        'Unbekannter Fehler
    End Select
End Sub
Public Function StateText(State As Long) As String
    Select Case State
      Case TCP_STATE_CLOSED:      StateText = "Closed"
      Case TCP_STATE_LISTEN:      StateText = "Listening"
      Case TCP_STATE_SYN_SENT:    StateText = "SYN Sent"
      Case TCP_STATE_SYN_RCVD:    StateText = "SYN Recieved"
      Case TCP_STATE_ESTAB:       StateText = "Established"
      Case TCP_STATE_FIN_WAIT1:   StateText = "FIN Wait 1"
      Case TCP_STATE_FIN_WAIT2:   StateText = "FIN Wait 2"
      Case TCP_STATE_CLOSE_WAIT:  StateText = "Close Wait"
      Case TCP_STATE_CLOSING:     StateText = "Closing"
      Case TCP_STATE_LAST_ACK:    StateText = "Last ACK"
      Case TCP_STATE_TIME_WAIT:   StateText = "Time Wait"
      Case TCP_STATE_DELETE_TCB:  StateText = "PCB Deleted"
    End Select
End Function
Private Function GetPort(Port) As Long
    GetPort = Asc(Mid(Port, 1, 1))
    GetPort = GetPort * 256
    GetPort = GetPort + Asc(Mid(Port, 2, 1))
End Function