Dynamische IP ohne WMI ermitteln Ermitteln der IP-Adressen durch Auswertung der TCP-Kontrollstrukturen.
Autor:   Thomas Theiner	Bewertung:     [ Jetzt bewerten ]	Views:  32.220
ohne Homepage	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 54 Bewertung insgesamt: gut Durchschnittliche Bewertung: 3.5 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Will man seine eigene dynamische IP ermitteln, so kann man dies im allgemeinen natürlich über das Winsock-Control machen.

MsgBox "Meine eigene IP: " & Winsock1.LocalIP

Dieses Vorgehen hat aber einen entscheidenden Nachteil, sobald sich der Rechner in einem LAN mit TCP/IP-Protokoll befindet. Dann nämlich liefert "LocalIP" immer nur die LAN-IP. Will man dann trotzdem die dynamische IP herausfinden, so gibt es mindestens zwei Wege.

Der erste davon wurde bereits in  Dynamische IP-Adresse schnell ermittelt - dank WMI gezeigt. Wenn man jedoch (wie ich) kein WMI installiert hat, so kann man die Information auch durch eine Auswertung der TCP-Kontrollstrukturen erhalten. Dazu benötigt man lediglich die "iphlpapi.dll", die aber bei Aktivieren von TCP/IP von Windows im allgemeinen automatisch installiert wird.

Die folgende Funktion "GetIPAdresses" gibt alle verfügbaren IP's des eigenen Rechners in einem String durch Komma getrennt zurück:

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:

MsgBox "Meine IP's: " & GetIPAdresses()