Kontakt
DSVGO
Historie | |
19.11.2001 | |
17.11.2001 | Erste Version |
Die unten gezeigte WordCount-Funktion bestimmt sehr schnell, aus wieviel Wörtern ein gegebener Text besteht.
Als Trennzeichen für Worte werden hier alle "Whitespaces" berücksichtigt (das sind die nicht sichtbaren Zeichen wie Leerzeichen, Zeilenvorschub, etc.). Der Einfachheit halber werden einfach alle Zeichen mit einem ASCII-Code <= 32 verwendet.
Besonders interessant ist hier, wie jegliche (bremsende) String-Routine vermieden wird. Stattdessen wird durch einen kleinen Trick direkt mit den ASCII-Zeichen (genauer: Unicode-Zeichen, 16Bit) gearbeitet.
MsgBox WordCount("Hallo Welt!") '2' MsgBox WordCount(" Hallo Welt! ") '2' MsgBox WordCount("Hallo-Welt!") '1'
Die folgenden API-Routinen müssen im Deklarationsteil des Moduls bekanntgemacht werden:
Private Declare Function ArrPtr Lib "msvbvm50.dll" _ Alias "VarPtr" (Ptr() As Any) As Long '<-- VB5 Private Declare Function ArrPtr Lib "msvbvm60.dll" _ Alias "VarPtr" (Ptr() As Any) As Long '<-- VB6 Private Declare Sub PokeLng Lib "kernel32" Alias "RtlMoveMemory" ( _ ByVal dest As Long, source As Long, _ Optional ByVal bytes As Long = 4)
Die eigentliche Funktion benutzt das in "Strings blitzschnell ver- und entschlüsseln" beschriebene "Speicher-Mapping"-Verfahren, um den Text in Unicode-Darstellung zur Verfügung zu stellen. Dadurch kann sehr schnell nach Wörtern (ASCII/Unicode > 32) bzw. Leerräumen/Whitespaces (ASCII/Unicode < 33) gesucht werden:
Public Static Function WordCount(ByRef sText As String) As Long Dim Chars() As Integer 'Unicode-Darstellung des Textes Dim SavePtr As Long 'Original Daten-Pointer Dim SADescrPtr As Long 'Safe Array Descriptor Dim DataPtr As Long 'pvData - Daten-Pointer Dim CountPtr As Long 'Pointer zu nElements Dim i As Long 'Ggf. Integer-Array einrichten: If SavePtr = 0 Then ReDim Chars(1 To 1) SavePtr = VarPtr(Chars(1)) PokeLng VarPtr(SADescrPtr), ByVal ArrPtr(Chars) DataPtr = SADescrPtr + 12 CountPtr = SADescrPtr + 16 End If 'String durch Integer-Array mappen: PokeLng DataPtr, StrPtr(sText) PokeLng CountPtr, Len(sText) 'Wörter zählen: For i = 1 To Len(sText) If Chars(i) > 32 Then WordCount = WordCount + 1 Do i = i + 1 Loop Until Chars(i) < 33 End If Next i 'Integer-Array restaurieren: PokeLng DataPtr, SavePtr PokeLng CountPtr, 1 End Function
Wenn es auf die letzte Picosekunde ankommt, kann auch die folgende optimierte Version verwendet werden:
Public Static Function WordCount12(ByRef sText As String) As Long Dim Chars() As Integer 'Unicode-Darstellung des Textes Dim Pointer As Long 'Safe Array Descriptor und co. Dim i As Long 'Ggf. Integer-Array einrichten: If Pointer = 0& Then ReDim Chars(1& To 1&) PokeLng VarPtr(Pointer), ByVal ArrPtr(Chars) PokeLng Pointer + 16&, &H7FFFFFFF 'längstmöglicher String Pointer = Pointer + 12& End If 'String durch Integer-Array mappen: PokeLng Pointer, StrPtr(sText) 'Wörter zählen: For i = 1& To Len(sText) If Chars(i) > 32 Then WordCount12 = WordCount12 + 1& Do i = i + 1& Loop Until Chars(i) < 33 End If Next i End Function
© Jost Schwider, 17.11.2001-19.11.2001 - http://vb-tec.de/wordcnt.htm