Ver Mensaje Individual
  #3 (permalink)  
Antiguo 29/12/2005, 17:47
LeandroA
 
Fecha de Ingreso: abril-2005
Mensajes: 351
Antigüedad: 19 años
Puntos: 3
una mejor forma que utilizar winsock

agrega un listview1 , un command1 y un modulo

en el form


Private Sub Command1_Click()
ListConnections
End Sub

Private Sub Form_Load()
With ListView1
.View = lvwReport

Set clmX = .ColumnHeaders.Add(, , "Local Address")
Set clmX = .ColumnHeaders.Add(, , "Local Port")
Set clmX = .ColumnHeaders.Add(, , "Remote Address")
Set clmX = .ColumnHeaders.Add(, , "Remote Port")
Set clmX = .ColumnHeaders.Add(, , "State")
End With
End Sub

y en el modulo

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

'### Hier Daten übergeben
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

'### Hier Daten übergeben
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