PHP Code:
Option Explicit
' zunächst alle benötigten API-Deklarationen
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 Type MIB_TCPROW
dwState As Long
dwLocalAddr As Long
dwLocalPort As Long
dwRemoteAddr As Long
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
' Hilfsfunktionen
Private Function GetString(ByVal lpszA As Long) As String
GetString = String$(lstrlenA(ByVal lpszA), 0)
Call lstrcpyA(ByVal GetString, ByVal lpszA)
End Function
Private Function GetInetAddrStr(Adresse As Long) As String
GetInetAddrStr = GetString(inet_ntoa(Adresse))
End Function
' alle IP-Adressen ermitteln
Public Function GetIPAdresses() As String
Dim TcpRow As MIB_TCPROW
Dim byBuffer() As Byte
Dim lBenoetigt As Long
Dim lGroesse As Long
Dim lZeilen As Long
Dim lZaehler As Long
Dim sAktAdresse As String
Dim sGefunden() As String
Dim lAnzahl As Long
Dim i As Long
Dim bFound As Boolean
Call GetTcpTable(ByVal 0&, lBenoetigt, 1)
GetIPAdresses = ""
lAnzahl = 0
If lBenoetigt > 0 Then
ReDim Buffer(0 To lBenoetigt - 1) As Byte
If GetTcpTable(Buffer(0), lBenoetigt, 1) = ERROR_SUCCESS Then
lGroesse = LenB(TcpRow)
' Die ersten 4 Bytes enthalten die Anzahl der
' Einträge
CopyMemory lZeilen, Buffer(0), 4
For lZaehler = 1 To lZeilen
bFound = False
' Überspringt die ersten vier Bytes von vorher
' und holt die Daten in die TcpRow-Struktur
CopyMemory TcpRow, Buffer(4 + _
(lZaehler - 1) * lGroesse), lGroesse
With TcpRow
sAktAdresse = GetInetAddrStr(.dwLocalAddr)
' Die IP's können mehrfach vorkommen, deswegen
' hier schauen welche IP's schon vorher
' gefunden wurden
For i = 1 To lAnzahl
bFound = (sAktAdresse = sGefunden(i))
Next i
If Not bFound And Left(sAktAdresse, 1) <> "0" _
And sAktAdresse <> "127.0.0.1" Then
GetIPAdresses = GetIPAdresses & _
GetInetAddrStr(.dwLocalAddr) & ","
lAnzahl = lAnzahl + 1
ReDim Preserve sGefunden(lAnzahl)
sGefunden(lAnzahl) = sAktAdresse
End If
End With
Next lZaehler
' Am Ende das letzte Komma entfernen
GetIPAdresses = Left(GetIPAdresses, _
Len(GetIPAdresses) - 1)
Else
MsgBox "Es trat ein Fehler beim Füllen der " & _
"TCP-Struktur auf!"
End If
End If
End Function
Ein Beispiel, wie die IP's ausgelesen werden können:
PHP Code:
MsgBox "Meine IP's: " & GetIPAdresses()
Quelle: vb@rchive
