Dieser Tipp beinhaltet eine Erweiterung des Tipps Intelligente TextBox für IP-Adressen von Gerhard Kuklau Erweiterungen/Änderungen von mir:
QUELLCODE (Modul modIPNumCheck.bas): Public Sub CheckIPAddress(tboIPAddress As TextBox, _ intKeyAscii As Integer) ' Es werden nur positive Zahlenwerte und der Punkt ' zugelassen. ' Als Komfort wird das Komma in einen Punkt konvertiert. Select Case intKeyAscii ' Zahlen, Backspace und Return Case 48 To 57, 8, 13 ' Aus Komma wird autom. Punkt Case 46, 44 If intKeyAscii = 44 Then intKeyAscii = 46 ' alle anderen Zeichen ignorieren Case Else intKeyAscii = 0 End Select ' 13=CR [ENTER] If intKeyAscii = 13 Then intKeyAscii = 0 With tboIPAddress If fCheckIP(.Text, tboIPAddress) = False Then Beep On Error Resume Next .SetFocus .SelStart = 0 .SelLength = Len(.Text) On Error GoTo 0 Else MsgBox "IP-Adresse=" & .Text & " ist in Ordnung!", _ vbInformation, "IP-Check" End If End With End If End Sub
QUELLCODE (Modul modIPNumCheck.bas): Private Function fCheckIP(strIP As String, _ tboIPAddress As TextBox) As Boolean ' Funktion zum Checken der IP-Adresse: ' ==================================== ' Die IP-Adresse wird als ganzes, also kpl. geprüft ' Sie wird in ihre einzelnen Octetts zerlegt und jedes ' einzeln geprüft und ggf. korrigiert (s.u. führende Nullen). ' Führende Nullen in IP-Adressen sind nicht erlaubt! ' Aus diesem Grund werden sie von der Function entfernt. ' Wenn eine Unstimmigkeit auftritt, wird die Function ' abgebrochen und False zurückgegeben ' Bei bestandener Prüfung gibt die Function True zurück Dim strOctett() As String Dim lngZahl As Long Dim intIndex As Integer ' IP überschreitet maximale Länge (15 Zeichen): ' ============================================== If Len(strIP) > 15 Then fCheckIP = False Exit Function End If ' IP enthält zu viele Octetts (mehr als 4): ' ========================================= strOctett = Split(strIP, ".", -1, vbTextCompare) If UBound(strOctett) <> 3 Then fCheckIP = False Exit Function End If For intIndex = 0 To UBound(strOctett) ' die Ip-Adresse wird in ihre Bestandteile (Octetts) zerlegt: ' =========================================================== lngZahl = CLng(strOctett(intIndex)) Select Case intIndex Case 0: ' 1. Octett Select Case lngZahl Case 10 To 255: ' Wert im erlaubten Bereich strOctett(intIndex) = CStr(lngZahl) Case Else: ' Wert ungültig fCheckIP = False Exit Function End Select Case 1, 2: ' 2. + 3. Octett Select Case lngZahl Case 0 To 255: ' Wert im erlaubten Bereich strOctett(intIndex) = CStr(lngZahl) Case Else: ' Wert ungültig fCheckIP = False Exit Function End Select Case 3: ' 4. Octett Select Case lngZahl Case 1 To 255: ' Wert im erlaubten Bereich strOctett(intIndex) = CStr(lngZahl) Case Else: ' Wert ungültig fCheckIP = False Exit Function End Select Case Else: ' die IP ist formal falsch fCheckIP = False Exit Function End Select Next intIndex ' jetzt nur noch die IP wieder richtig zusammen bauen und fertig: ' =============================================================== strIP = Join(strOctett, ".") tboIPAddress.Text = strIP fCheckIP = True End Function
QUELLCODE (Form1.frm): Private Sub txtIPAddress_KeyPress(KeyAscii As Integer) ' beim Drücken einer Taste wird die Gültigkeit ' geprüft, und nur der Wert "durchgelassen", der ' auch für die Erstellung einer IP-Adresse gültig ist: CheckIPAddress txtIPAddress, KeyAscii End Sub Private Sub txtIPAddress_LostFocus() ' wenn das Control den Focus verliert, ' wird auf Gültigkeit geprüft, und nur der Wert "durchgelassen", ' der auch für die Erstellung einer IP-Adresse gültig ist: CheckIPAddress txtIPAddress, 13 End Sub Hinweis: Private Sub Command1_Click() ' IP-Adresse auf Gültigkeit prüfen CheckIPAddress txtIPAddress, 13 End Sub |