VB-Tec.de Visual Basic - Technik, FAQ, Tricks, Beispiele

Historie
27.05.2001	Erste Version (nach einer Idee von Francesco Balena)

Einleitung

Die unten definierte CharType-Funktion gibt für einen String an, aus welchen Zeichen-Gruppen (Kleinbuchstabe, Großbuchstabe, Dezimalzahl, Hex-Zahl, ...) die einzelnen Zeichen stammen.

Mit dem optionalen Restrict-Parameter kann angegeben werden, ob nur Gemeinsamkeiten bestimmt werden sollen (True, Voreinstellung), oder ob alle vorkommenden Zeichen-Gruppen gesammelt werden sollen.

Beispiele

Der folgende Code gibt für den String s = "F3A0" die Meldungen "Alles Hexadezimal-Ziffern" und "Großbuchstaben vorhanden" aus:

If CharType(s) And CTHexDigit Then
  MsgBox "Alles Hexadezimal-Ziffern"
ElseIf CharType(s, False) And CTHexDigit Then
  MsgBox "Hexadezimal-Ziffern vorhanden"
End If

If CharType(s) And CTUppercaseAlpha Then
  MsgBox "Alles Großbuchstaben"
ElseIf CharType(s, False) And CTUppercaseAlpha Then
  MsgBox "Großbuchstaben vorhanden"
End If

Code

Die folgende Enumeration gibt die möglichen Rückgabewerte (die Zeichen-Gruppen) als 2er-Potenzen an:

Public Enum CharTypes
  CTUppercaseAlpha = 1 '[A-Z,Ä,Ö,Ü]
  CTLowercaseAlpha = 2 '[a-z,ä,ö,ü,ß]
  CTDecimalDigit = 4   '[0-9]
  CTDecimalNumber = 8  '[0-9,.+-]
  CTHexDigit = 16      '[0-9,A-Z,a-z]
  CTWhiteSpace = 32    '[Chr$(0,8,10,13,32)]
  CTPunctuation = 64   '[.,;:?!-'(){}[]]
End Enum

Die eigentliche Logik steckt in folgender Funktion. Man beachte, dass die Übersetzungs-Tabelle nur beim ersten Aufruf der Funktion gefüllt wird:

Public Static Function CharType( _
    ByRef Chars As String, _
    Optional ByVal Restrict As Boolean = True _
  ) As CharTypes
  Dim Table(0 To 255) As CharTypes
  Dim i As Long
  Dim v As String
  
  'Übersetzungs-Tabelle nur einmal füllen:
  If i = 0 Then
  
    'Großbuchstaben:
    For i = Asc("A") To Asc("F")
      Table(i) = CTUppercaseAlpha Or CTHexDigit
    Next i
    For i = Asc("G") To Asc("Z")
      Table(i) = CTUppercaseAlpha
    Next i
    v = "ÄÖÜ"
    For i = 1 To Len(v)
      Table(Asc(Mid$(v, i, 1))) = CTUppercaseAlpha
    Next i
    
    'Kleinbuchstaben:
    For i = Asc("a") To Asc("f")
      Table(i) = CTLowercaseAlpha Or CTHexDigit
    Next i
    For i = Asc("g") To Asc("z")
      Table(i) = CTLowercaseAlpha
    Next i
    v = "äöüß"
    For i = 1 To Len(v)
      Table(Asc(Mid$(v, i, 1))) = CTLowercaseAlpha
    Next i
    
    'Satzzeichen:
    v = ".,;:?!'(){}[]"
    For i = 1 To Len(v)
      Table(Asc(Mid$(v, i, 1))) = CTPunctuation
    Next i
    
    'Zahlen:
    For i = Asc("0") To Asc("9")
      Table(i) = CTDecimalDigit Or CTDecimalNumber Or CTHexDigit
    Next i
    
    'Sonstige Dezimal-Zeichen:
    Table(Asc("+")) = CTDecimalNumber
    Table(Asc("-")) = CTPunctuation Or CTDecimalNumber
    i = Asc(Format$(0.1, "."))
    Table(i) = Table(i) Or CTDecimalNumber
    
    'White Spaces:
    v = vbNullChar & vbTab & vbLf & vbCr & " "
    For i = 1 To Len(v)
      Table(Asc(Mid$(v, i, 1))) = CTWhiteSpace
    Next i

  End If 'i = 0

  'Ergebnis je nach Modus berechnen:
  If Restrict Then

    'Nur gemeinsame Gruppen:
    If Len(Chars) Then
      CharType = Table(Asc(Mid$(Chars, 1, 1)))
      For i = 2 To Len(Chars)
        If CharType = 0 Then Exit Function 'nix gemein
        CharType = CharType And Table(Asc(Mid$(Chars, i, 1)))
      Next i
    End If

  Else

    'Alle vorkommenden Gruppen:
    For i = 1 To Len(Chars)
      CharType = CharType Or Table(Asc(Mid$(Chars, i, 1)))
    Next i

  End If
End Function