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
 
  frm_PortScan.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 = frm_PortScan.ListView1.ListItems.Add(, , strLocalAddr)
          itemX.SubItems(1) = strLocalPort
          itemX.SubItems(2) = strRemoteAddr
          itemX.SubItems(3) = strRemotePort
          itemX.SubItems(4) = strState
          Select Case strState
            Case "Listening"
              itemX.SubItems(4) = "Listening"
              itemX.ListSubItems(4).ForeColor = vbCyan
            Case "Time Wait"
              itemX.ListSubItems(4).ForeColor = vbYellow
              itemX.SubItems(4) = "Warten..."
            Case "Established"
              itemX.ListSubItems(4).ForeColor = vbGreen
              itemX.SubItems(4) = "OK"
          Case "Closing"
              itemX.ListSubItems(4).ForeColor = vbRed
              itemX.SubItems(4) = "Closing"
      End Select
        Next intLoop
      Case 232
        MsgBox "Auf Netzwerk kann nicht zugegriffen werden!", 16, _
          "Netzwerk-Fehler"
      Case 122
        'Buffer-Problem
      Case Else
        MsgBox "Es ist ein Fehler aufgetreten!", 16, "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

beatSOFT
Daniel Petri
VB, Access, SQL, MySQL