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

Historie
19.11.2001
17.11.2001	Erste Version

Einleitung

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.

Beispiele

MsgBox WordCount("Hallo Welt!")     '2'
MsgBox WordCount("  Hallo Welt!  ") '2'
MsgBox WordCount("Hallo-Welt!")     '1'

Code / Quelltext

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