vb@rchiv · Tipps & Tricks · Eigene Online IP-Adresse ermitteln

Rubrik: HTML/Internet/Netzwerk · Internet / Browser / IE | VB-Versionen: VB6

30.03.11

Eigene Online IP-Adresse ermitteln Mit dieser Funktion lässt sich schnell die eigene Online IP-Adresse ermitteln, mit der man im Internet unterwegs ist.
Autor: Dieter Otter	Bewertung:	Views: 12.355
www.tools4vb.de	System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Die lokale Rechner IP-Adresse unterscheidet sich bekanntlich von der IP-Adresse mit der man online im Internet unterwegs ist.

Durch Aufruf der Internetseite http://checkip.dyndns.org bekommt seine eigene Online IP-Adresse angezeigt.

Was liegt also näher, als einfach den Inhalt dieser Seite auszulesen, wenn man zur Laufzeit die Online IP-Adresse des Anwenders ermitteln muss.
Und genau das erledigt nachfolgender Code:

Option Explicit
 
' benötigte API-Deklarationen
Private Declare Function URLDownloadToFile Lib "urlmon" _
  Alias "URLDownloadToFileA" ( _
  ByVal pCaller As Long, _
  ByVal szURL As String, _
  ByVal szFileName As String, _
  ByVal dwReserved As Long, _
  ByVal lpfnCB As Long) As Long
 
Private Declare Function DeleteUrlCacheEntry Lib "wininet.dll" _
  Alias "DeleteUrlCacheEntryA" ( _
  ByVal lpszUrlName As String) As Long

' Datei-Download mit oder ohne Leerung des URL-Cache
Public Function FileDownload(ByVal sURL As String, _
  ByVal sLocalFile As String, _
  Optional ByVal bClearCache As Boolean = True) As Boolean
 
  Dim lResult As Long
 
  ' URL-Cache leeren?
  If bClearCache Then
    lResult = DeleteUrlCacheEntry(sURL)
  End If
 
  ' Download ausführen
  Screen.MousePointer = vbHourglass
  lResult = URLDownloadToFile(0, sURL, sLocalFile, 0, 0)
  Screen.MousePointer = vbNormal
 
  FileDownload = (lResult = 0)
End Function

' Eigene Online IP-Adresse ermitteln
Public Function GetOnlineIPAddress() As String
  Dim sURL As String
  Dim sTempFile As String
  Dim nResult As Long
  Dim sBuffer As String
  Dim sIP As String
 
  ' URL, die uns die eigene Online IP-Adresse verrät
  sURL = "http://checkip.dyndns.org"
 
  ' temporärer Datei (ggf. löschen, falls vorhanden)
  sTempFile = App.Path & "\ip.tmp"
  If Len(Dir$(sTempFile, vbNormal)) > 0 Then Kill sTempFile
 
  If FileDownload(sURL, sTempFile) Then
    ' temporäre Datei auslesen
    sBuffer = ReadFile(sTempFile)
 
    ' Inhalt prüfen
    If InStr(1, sBuffer, "Current IP Address: ", vbTextCompare) > 0 Then
      ' IP-Adresse aus Inhalt extrahieren
      sBuffer = Mid$(sBuffer, InStr(1, sBuffer, "Current IP Address: ", vbTextCompare) + 20)
      If InStr(sBuffer, "<") > 0 Then
        ' Eigene IP-Adresse zurückgeben
        sIP = Left$(sBuffer, InStr(sBuffer, "<") - 1)
      End If
    End If
  End If
 
  GetOnlineIPAddress = sIP
End Function

' Hilfsfunktion: Inhalt der angegebenen Datei auslesen
Private Function ReadFile(ByVal sFile As String) As String
  Dim F As Integer
  Dim sBuffer As String
 
  F = FreeFile
  Open sFile For Binary As #F
  sBuffer = Space$(LOF(F))
  Get #F, , sBuffer
  Close #F
 
  ReadFile = sBuffer
End Function

Aufrufbeispiel:

' Online IP-Adresse ermitteln
Dim sIP As String
 
sIP = GetOnlineIPAddress()
If Len(sIP) > 0 Then
  MsgBox "Eigene Online IP-Adresse: " & sIP
Else
  MsgBox "Die Online IP-Adresse konnte nicht ermittelt werden!"
End If