Kontakt
DSVGO
Historie | |
27.05.2001 | Erste Version (nach einer Idee von Francesco Balena) |
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.
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
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
© Jost Schwider, 27.05.2001-27.05.2001 - http://vb-tec.de/chartype.htm