Tipp 0441 Online-IP auslesen
Autor/Einsender:
Datum:
  Frank Grimm
09.03.2005
Entwicklungsumgebung:   VB 6
Dieser Tipp enthält eine Klasse mit der es möglich ist, die "echte" Online-IP des PCs in Erfahrung zu bringen. Dies ist z. B. hinter einem Router o. ä. notwendig. Es sind drei öffentliche Websites integriert, die Klasse ist jedoch leicht erweiterbar, damit beispielsweise ein eigenes PHP-Skript benutzt werden kann.
In NT basierten Windows-Versionen (2000/XP) wird zum Herunterladen der Daten keine Datei benutzt, sondern die WinInet.dll, mit der man den Quelltext der Internetseite direkt in den Speicher laden kann. Unter Windows 9x werden die Daten wie in unserem Tipp Datei aus dem Internet downloaden gezeigt, heruntergeladen.
Code im Klassenmodul COnlineIP
 
Option Explicit

Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_FLAG_RELOAD = &H80000000

Private Const mc_USER_AGENT = "Gecko based"

Private Declare Function InternetOpen Lib "wininet" Alias _
      "InternetOpenA" (ByVal sAgent As String, _
      ByVal lAccessType As Long, ByVal sProxyName As String, _
      ByVal sProxyBypass As String, ByVal lFlags As Long) As Long

Private Declare Function InternetCloseHandle Lib "wininet" _
      (ByRef hInet As Long) As Long

Private Declare Function InternetReadFile Lib "wininet" _
      (ByVal hFile As Long, ByVal sBuffer As String, _
      ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) _
      As Integer

Private Declare Function InternetOpenUrl Lib "wininet" Alias _
      "InternetOpenUrlA" (ByVal hInternetSession As Long, _
      ByVal lpszUrl As String, ByVal lpszHeaders As String, _
      ByVal dwHeadersLength As Long, ByVal dwFlags As Long, _
      ByVal dwContext As Long) As Long

Private Declare Function URLDownloadToFile Lib "urlmon.dll" _
      Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
      ByVal szURL As String, ByVal szFileName As String, _
      ByVal Reserved As Long, ByVal fnCB As Long) As Long

Private Declare Function GetVersionEx Lib "kernel32" Alias _
      "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) _
      As Long

Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Public Enum eOIPService
  Germany = 0
  America = 1
  Germany2 = 2
End Enum

Public Property Get IP( _
      Optional ByVal UsedService As eOIPService = 1, _
      Optional strTempFile As String = "C:\IP.TXT") As String

  Dim strUrlIP  As String
  Dim strLeft   As String, strRight As String
  Dim strBuffer As String
  Dim hOpen     As Long, hFile As Long
  Dim nRetVal   As Long
  Dim strRes    As String
  Dim lngLeft   As Long, lngRight As Long
  Dim strWebsource As String
  Dim iFN       As Integer

  On Error GoTo IP_Error

  Select Case UsedService
    Case Is = eOIPService.Germany
      strUrlIP = "http://www.wasistmeineip.de/"
      strLeft = "CopyToClipboard('"
      strRight = "');"
    Case Is = eOIPService.Germany2
      strUrlIP = "http://www.showmyip.de/"
      strLeft = "<br>REMOTE HOST: "
      strRight = vbLf & "<br>PRO"
    Case Else
      strLeft = "<h1>Your IP is "
      strRight = " <br></h1>"
      strUrlIP = "http://www.whatismyip.com/"
  End Select

  If IsWinNT Then
    hOpen = InternetOpen(mc_USER_AGENT, _
          INTERNET_OPEN_TYPE_DIRECT, vbNullString, _
          vbNullString, 0)
    If hOpen <> 0 Then
      hFile = InternetOpenUrl(hOpen, strUrlIP, vbNullString, _
            ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&)
      If hFile <> 0 Then
        strBuffer = Space$(1000)
        nRetVal = 1
        While nRetVal > 0
          InternetReadFile hFile, strBuffer, 1000, nRetVal
          strWebsource = strWebsource & Trim$(strBuffer)
          strBuffer = Space$(1000)
        Wend
      Else
        strRes = "Fehler beim Zugriff auf die Web-Seite"
      End If
    Else
      strRes = "Fehler bei INet-Verbindung"
    End If
    InternetCloseHandle hFile
    InternetCloseHandle hOpen

  Else
    nRetVal = URLDownloadToFile(0, strUrlIP, strTempFile, 0, 0)
    If nRetVal = 0 Then
      If FileExists(strTempFile) Then
        iFN = FreeFile
        Open strTempFile For Input As #iFN
        strWebsource = Input(LOF(iFN), 1)
        Close #iFN
        Kill strTempFile
      Else
        strRes = "Temporäre Datei konnte nicht angelegt werden"
      End If
    Else
      strRes = "Fehler beim Zugriff auf die Web-Seite"
    End If
  End If

  If LenB(strWebsource) > 0 Then
    lngLeft = InStr(1, strWebsource, strLeft)
    lngRight = InStr(1, strWebsource, strRight)

    If (lngLeft > 0) And (lngRight > 0) Then
      strWebsource = Mid$(strWebsource, lngLeft + Len(strLeft))
      lngRight = InStr(1, strWebsource, strRight)
      strWebsource = Left$(strWebsource, lngRight - 1)
      strRes = Trim$(strWebsource)
    Else
      strRes = "Fehler beim Auslesen der IP"
    End If
  End If

  IP = strRes

  On Error GoTo 0
  Exit Property

IP_Error:
  MsgBox "Fehler " & Err.Number & vbCrLf & Err.Description
End Property

Private Function FileExists(File As String) As Boolean
  On Error Resume Next
  FileExists = False
  FileExists = Dir(File) <> ""
  On Error GoTo 0
End Function

Private Function IsWinNT() As Boolean
  Dim osvi As OSVERSIONINFO

  On Error Resume Next
  osvi.dwOSVersionInfoSize = 148
  osvi.szCSDVersion = Space$(128)
  GetVersionEx osvi
  If osvi.dwMajorVersion > 4 Then IsWinNT = True
  On Error GoTo 0
End Function
 
Code im Codebereich der Form
 
Option Explicit

Private Sub cmdReadIP_Click()
  Dim mIP As COnlineIP

  Set mIP = New COnlineIP

  txtIP.Text = "- Bitte warten -"
  txtIP.Text = mIP.IP(cboIPService.ItemData( _
        cboIPService.ListIndex))

  Set mIP = Nothing
End Sub

Private Sub Form_Load()
  With Me.cboIPService
    .Clear
    .AddItem "WasIstMeineIP.de"
    .ItemData(.NewIndex) = 0
    .AddItem "WhatIsMyIP.com"
    .ItemData(.NewIndex) = 1
    .AddItem "ShowMyIP.com"
    .ItemData(.NewIndex) = 2

    .ListIndex = 0
  End With
End Sub
 
Hinweis für VBA-Anwender
Im Download befindet sich ein Excel 2000-Beispiel, das so ergänzt wurde, dass es auch in Office 97 eingesetzt werden kann. Da in VBA 5 die Enum-Anweisung noch nicht integriert ist, wurde in dem Beispiel mit bedingter Kompilierung zwischen den Office-Versionen unterschieden.
Die im VBA-Ordner enthaltenen *.frm- und *.cls-Dateien können beispielsweise auch in Word und PowerPoint im VB-Editor importiert werden.
Weitere Links zum Thema
Lokale IP- und MAC-Adresse ermitteln (WMI)

Windows-Version
95
98
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (38,7 kB) Downloads bisher: [ 2043 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Mittwoch, 31. August 2011