IP-Adresse aus beliebigem String ermitteln Diese Funktion sucht nach der ersten IP-Adresse im übergebenen String und gibt diese zurück.
Autor:   Richard Mittelstädt	Bewertung:     [ Jetzt bewerten ]	Views:  10.320
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: 10 Bewertung insgesamt: sehr gut Durchschnittliche Bewertung: 4.8 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Eine vielleicht nicht allzu häufig benötigte Funktion - aber manchmal doch nützlich: das Prüfen eines String, ob darin eine IP-Adresse vorhanden ist und anschließender Rückgabe der IP-Adresse.

' ****************************************************************
' Ermittelt den ersten IP-Adressen-String (von links gelesen)
' aus einem beliebigen String und gibt diesen zurück
'
' Konnte keine IP-Adresse ermittelt werden, wird ein Leerstring
' zurückgegebe.
'
' Bsp:  "\\218.21.48.52\_FSUPDATE"         ->  "218.21.48.52"
'       "\\21X.21.48.52\_FSUPDATE"         ->  ""
'       "\\21X.21.48.52.0\_FSUPDATE"       ->  "21.48.52.0"
'       "\\218.21.X8.52\_FSUPDATE.1.2.3.4" -> "1.2.3.4"
'
' ---- 2008-04-29 Fixes Signum +/- und Mehrfach-Punkte -----------
'       "\\5zuk-21.49.52.17\_FSUPDATE"       ->  "21.49.52.17"
'       "\\5zuk+21.49.52.17\_FSUPDATE"       ->  "21.49.52.17"
'       "\\5zuk+21.-49.52.17\_FSUPDATE"      ->  ""
'       "\\218..21.48.52\_FSUPDATE"          ->  ""
'       "\\218..21.48.52\_FSUPDATE1.22.33.4" ->  "1.22.33.4"
' ****************************************************************
Public Function IP_AusString(ByVal IP_STRG As String) As String
  Dim S_FLD() As Variant ' Dyn. Datenfeld mit allen Strings zwischen Punkten
                         ' 0-Spalte  (frei)
                         ' 1-Spalte  Punkt-Positionen
                         ' 2-Spalte  Strings zwischen den Punkten
  Dim Pos1 As Long       ' Akt. String-Position
  Dim IP(4) As String    ' Feld mit IP-Anteilen
                         ' Adresse= IP(1).IP(2).IP(3).IP(4)
  Dim i As Integer
  Dim z As Integer
  Dim n As Integer
 
  Dim IP_FOUND As Boolean ' Merker, ob akt. gefundene IP (noch) gültig ist
 
  ' nach dem ersten Vorkommen von "." suchen
  Pos1 = InStr(1, IP_STRG, ".")
  If Pos1 = 0 Then Exit Function
 
  ' alle Punkte am Anfang und Ende löschen
  While Left$(IP_STRG, 1) = "."
    IP_STRG = Mid$(IP_STRG, 2)
  Wend
  While Right$(IP_STRG, 1) = "."
    IP_STRG = Left$(IP_STRG, Len(IP_STRG) - 1)
  Wend
 
  ' Sicherstellen, dass IP-STRG mit Punkt endet
  If Right$(IP_STRG, 1) <> "." Then IP_STRG = IP_STRG & "."
 
  ' Länge muss jetzt mindestens 8 sein! (1.1.1.1.)
  If Len(IP_STRG) < 8 Then Exit Function
 
  ' Positionen aller Punkte in Datenfeld eintragen
  ' Pos. des 1. Punktes
  Pos1 = InStr(1, IP_STRG, ".")
  i = 0
  Do While Pos1 > 0
    i = i + 1
    ReDim Preserve S_FLD(2, i)
    ' Pos. des i. Punktes merken
    S_FLD(1, i) = Pos1
    ' nach weiteren Punkte suchen
    Pos1 = InStr(Pos1 + 1, IP_STRG, ".")
  Loop
  S_FLD(1, 0) = 0  ' Dummy-Pos. des 0. Punktes eintragen
 
  ' Stringanteile zwischen den Punkten in Datenfeld eintragen
  For i = 1 To UBound(S_FLD, 2)
    S_FLD(2, i) = Mid$(IP_STRG, S_FLD(1, i - 1) + 1, _
      S_FLD(1, i) - S_FLD(1, i - 1) - 1)
  Next i
 
  ' von links das erste 4-malige Vorkommen von IP-Komponenten suchen
  For i = 1 To UBound(S_FLD, 2) - 3
    IP_FOUND = False
    For z = 0 To 3
      IP(z + 1) = S_FLD(2, i + z) ' Feld mit evtl. IP-Anteilen füllen
    Next z
 
    ' alle Nicht-Ziffern im 1. Teilstring von links entfernen
    ' angepasst am 2008-04-29
    n = 0
    For z = 1 To Len(IP(1))
      If InStr("0123456789", Mid$(IP(1), z, 1)) = 0 Then n = z
    Next z
    If n > 0 Then IP(1) = Mid$(IP(1), n + 1)
 
    ' alle Nicht-Ziffern im 4. Teilstring von rechts entfernen
    While InStr("0123456789", Right$(IP(4), 1)) = 0
      IP(4) = Left$(IP(4), Len(IP(4)) - 1)
    Wend
 
    ' alle 4 Anteile prüfen
    For z = 1 To 4
      If Not IsNumeric(IP(z)) Then
        IP_FOUND = False
        Exit For  ' keine Zahl -> Nächster Test
 
      ElseIf InStr("+-", Left$(IP(z), 1)) > 0 Then
        IP_FOUND = False
        Exit For  ' 2008-04-29 Vorzeichen +/- abblocken ! -> Nächster Test
 
      ElseIf Len(IP(z)) > 3 Or IP(z) > 255 Then
        IP_FOUND = False
        Exit For  ' Zahl > 3 Ziffern oder > 255 -> Nächster Test
 
      Else
        IP_FOUND = True ' gültigen IP-Anteil gefunden
      End If
    Next z
 
    ' Alle 4 Anteile gültig, IP komplett
    If IP_FOUND = True Then Exit For
  Next i
  If Not IP_FOUND Then Exit Function
 
  ' Ausgabe aus Feld mit den IP-Anteilen bilden
  For i = 1 To 4
    IP_AusString = IP_AusString & "." & IP(i)
  Next i
  ' Linken Punkt löschen !
  IP_AusString = Mid$(IP_AusString, 2)
End Function

Aufrufbeispiel:

Dim sText As String
sText = "\\218.21.48.52\_FSUPDATE"
 
Dim sIP As String
sIP = IP_AusString(sText)
If Len(sIP) > 0 Then
  MsgBox "IP-Adresse: " & sIP
Else
  MsgBox "keine IP-Adresse vorhanden!"
End If