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 Dieser Tipp wurde bereits 10.325 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
sevWizard für VB5/6 Professionelle Assistenten im Handumdrehen Erstellen Sie eigene Assistenten (Wizards) im Look & Feel von Windows 2000/XP - mit allem Komfort und zwar in Windeseile :-) Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 Access-Tools Vol.1 Über 400 MByte Inhalt Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |