VBspeed / String / WordCount
VBspeed © 2000-10, updated: 28-Nov-2001
WordCount


Function WordCount
Counts the words found within a given text string. Surprised? Now, what's a word? Words are delimited by white space. What's white space? Blanks, tabs, carriage returns, line feeds, nullchars, etc... Let's keep it simple: white space is ASCII 0 thru 32.
  Function WordCount(ByRef sText As String) As Long
  
  WordCount("")                 --> 0
  WordCount("word")             --> 1
  WordCount("wordword")         --> 1
  WordCount(".word.word.")      --> 1
  WordCount("word word")        --> 2
  WordCount(" word word ")      --> 2
  WordCount("  word  word  ")   --> 2
  WordCount("a" & vbCrLf & "B") --> 2
Code
WordCount01
Public Function WordCount01(ByRef sText As String) As Long
' by Chris Lucas, cdl1051@earthlink.net, 20011113
    Dim dest() As Byte
    Dim i As Long

    If LenB(sText) Then
        ' Move the string's byte array into dest()
        ReDim dest(LenB(sText))
        CopyMemory dest(0), ByVal StrPtr(sText), LenB(sText) - 1

        ' Now loop through the array and count the words
        For i = 0 To UBound(dest) Step 2
            If dest(i) > 32 Then
                 Do Until dest(i) < 33
                    i = i + 2
                 Loop
                 WordCount01 = WordCount01 + 1
            End If
        Next i
        Erase dest
    Else
        ' This is easy eh?
        WordCount01 = 0
    End If

End Function
WordCount02
Public Function WordCount02(ByRef sText As String) As Long
' by Chris Lucas, cdl1051@earthlink.net, 20011115
    Dim dest() As Byte
    Dim i As Long
    Dim tmpCount As Long
    
    If LenB(sText) Then
        ReDim dest(LenB(sText))
        CopyMemory dest(0), ByVal StrPtr(sText), LenB(sText) - 1
        For i = 0 To UBound(dest) Step 2
            If dest(i) > 32 Then
                Do Until dest(i) < 33
                   i = i + 2
                Loop
                tmpCount = tmpCount + 1
            End If
        Next i
        Erase dest
    End If
    WordCount02 = tmpCount
End Function
WordCount03
Public Function WordCount03(ByRef sText As String) As Long
' by Donald, donald@xbeat.net, 20011114
' based on WordCount01 by Chris
  Const cCharLow As Byte = 33
  Dim abText() As Byte
  Dim i As Long
  
  If LenB(sText) Then
    ReDim abText(LenB(sText))
    CopyMemory abText(0), ByVal StrPtr(sText), LenB(sText) - 1
    For i = 0 To UBound(abText) Step 2
      If abText(i) >= cCharLow Then
        Do
          i = i + 2
        Loop Until abText(i) < cCharLow
        WordCount03 = WordCount03 + 1
      End If
    Next
  End If

End Function
WordCount04
Public Function WordCount04(ByRef sText As String) As Long
' by Donald, donald@xbeat.net, 20011114
  Dim cCharLow As Byte: cCharLow = 33
  Dim abText() As Byte
  Dim i As Long
  
  If LenB(sText) Then
    ReDim abText(LenB(sText))
    CopyMemory abText(0), ByVal StrPtr(sText), LenB(sText) - 1
    For i = 0 To UBound(abText) Step 2
      If abText(i) >= cCharLow Then
        Do
          i = i + 2
        Loop Until abText(i) < cCharLow
        WordCount04 = WordCount04 + 1
      End If
    Next
  End If

End Function
WordCount05
Public Function WordCount05(ByRef sText As String) As Long
  ' by Paul - wpsjr1@syix.com, 20011117
  ' based on code from Don and Chris
  ' doping - string.tlb
  Dim a() As Byte
  Static b() As Byte
  Dim cCharLow As Byte: cCharLow = 33
  Dim lLen As Long
  Static lPrevLen As Long
  Dim i As Long
  
  lLen = LenB(sText)
  If lLen Then
    If lLen > 100 And lLen < 100000 Then
      ReDim a(lLen) ' faster to blindly redim than check
      CopyMemory a(0), ByVal StrPtr(sText), lLen
      For i = 0 To lLen - 1 Step 2
        If a(i) >= cCharLow Then
          Do
            i = i + 2
          Loop Until a(i) < cCharLow
          WordCount05 = WordCount05 + 1
        End If
      Next
    Else
      lLen = lLen \ 2
      If lPrevLen <> lLen Then ' only redim when necessary
        ReDim b(lLen)
        lPrevLen = lLen
      End If
      FastString.WideCharToMultiByte 0&, 0&, sText, lLen, b(0), lLen, 0&, 0&
      For i = 0 To lLen - 1
        If b(i) >= 33 Then
          Do
            i = i + 1
          Loop Until b(i) < 33
          WordCount05 = WordCount05 + 1
        End If
      Next
    End If
  End If
End Function
WordCount06
Public Static Function WordCount06(ByRef sText As String) As Long
' by Jost Schwider, jost@schwider.de, http://vb-tec.de/, 20011118
  Dim Chars() As Integer
  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, &H7FFFFFFF
  
  'W÷rter zńhlen:
  For i = 1 To Len(sText)
    If Chars(i) > 32 Then
      WordCount06 = WordCount06 + 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
WordCount07
Public Static Function WordCount07(ByRef sText As String) As Long
' by Jost Schwider, jost@schwider.de, http://vb-tec.de/, 20011118
  Dim Chars() As Integer 'ASCII-Codes der Zeichen
  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
    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
      WordCount07 = WordCount07 + 1
      Do
        i = i + 1
      Loop Until Chars(i) < 33
    End If
  Next i
End Function
WordCount08
needs modSafeArray

Public Function WordCount08(ByRef sText As String) As Long ' by Paul - wpsjr1@syix.com, 20011119 Dim lLen As Long Dim lCounter As Long Static saIn As SAFEARRAYHEADER Static lArrayPointer As Long Static iChar() As Integer lLen = Len(sText) If lArrayPointer = 0 Then ReDim iChar(0) lArrayPointer = ArrPtr(iChar) With saIn .DataSize = 2 .dimensions = 1 .sab(0).cElements = &H7FFFFFFF End With RtlMoveMemory ByVal lArrayPointer, VarPtr(saIn), 4 RtlMoveMemory lArrayPointer, ByVal lArrayPointer, 4 End If ' refresh the pointer to the string data RtlMoveMemory ByVal lArrayPointer + 12, StrPtr(sText), 4 If lLen Then lLen = lLen - 1 Do If iChar(lCounter) > 32 Then WordCount08 = WordCount08 + 1 Do lCounter = lCounter + 1 Loop Until iChar(lCounter) < 33 End If lCounter = lCounter + 1 Loop While lCounter <= lLen End If End Function
WordCount09
Public Function WordCount09(ByRef sText As String) As Long
' by Jost Schwider, jost@schwider.de, http://vb-tec.de/, 20011120
  Static Chars() As Integer 'Ascii-Codes der Zeichen
  Static 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
    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
      WordCount09 = WordCount09 + 1&
      Do
        i = i + 1&
      Loop Until Chars(i) < 33
    End If
  Next i
End Function
WordCount10
Public Function WordCount10(ByRef sText As String) As Long
' by Jost Schwider, jost@schwider.de, http://vb-tec.de/, 20011122
  Static Chars() As Integer 'Ascii-Codes der Zeichen
  Static Pointer As Long    'Safe Array Descriptor und co.
  Static SavePtr As Long    'Original Array Data Pointer
  Dim i As Long
  
  'Ggf. Integer-Array einrichten:
  If Pointer = 0& Then
    ReDim Chars(1& To 1&)
    SavePtr = VarPtr(Chars(1))
    PokeLng VarPtr(Pointer), ByVal ArrPtr(Chars)
    PokeLng Pointer + 16&, &H7FFFFFFF
    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
      WordCount10 = WordCount10 + 1&
      Do
        i = i + 1&
      Loop Until Chars(i) < 33
    End If
  Next i
  
  'Integer-Array restaurieren, sonst ggf. GPF:
  PokeLng Pointer, SavePtr
End Function
WordCount11
It's a class:

' by Olaf Schmidt, os@datenhaus.de, 20011128 Option Explicit Private Declare Function ArrPtr& Lib "msvbvm60.dll" Alias "VarPtr" (ptr() As Any) Private Declare Sub RtlMoveMemory Lib "kernel32" (dst As Any, src As Any, ByVal nBytes&) Private Declare Function SysAllocStringByteLen& Lib "oleaut32" (ByVal olestr&, ByVal BLen&) Private saSrcL&(5), SrcL&()
Private Sub Class_Initialize() saSrcL(0) = 1: saSrcL(1) = 4: saSrcL(4) = &H7FFFFFFF RtlMoveMemory ByVal ArrPtr(SrcL), VarPtr(saSrcL(0)), 4 End Sub
Friend Function WordCount(s$) As Long Dim i&, SLen&, ub&: Static C32&, C32L& SLen = Len(s): If SLen = 0 Then Exit Function ub = (SLen - 1) \ 2 saSrcL(3) = StrPtr(s): C32& = &H20: C32L& = &H20FFFF For i = 0 To ub If (SrcL(i) And &HFF&) > C32 Then WordCount = WordCount + 1 If SrcL(i) <= C32L Then GoTo m2 i = i + 1: If (SrcL(i) And &HFF&) <= C32 Then GoTo m1 If SrcL(i) <= C32L Then GoTo m2 i = i + 1: If (SrcL(i) And &HFF&) <= C32 Then GoTo m1 If SrcL(i) <= C32L Then GoTo m2 i = i + 1: If (SrcL(i) And &HFF&) <= C32 Then GoTo m1 If SrcL(i) <= C32L Then GoTo m2 i = i + 1: If (SrcL(i) And &HFF&) <= C32 Then GoTo m1 Do If SrcL(i) <= C32L Then GoTo m2 i = i + 1: If (SrcL(i) And &HFF&) <= C32 Then GoTo m1 Loop End If m1: If SrcL(i) > C32L And i <= ub Then WordCount = WordCount + 1 i = i + 1: If (SrcL(i) And &HFF&) <= C32 Then GoTo m1 If SrcL(i) <= C32L Then GoTo m2 i = i + 1: If (SrcL(i) And &HFF&) <= C32 Then GoTo m1 If SrcL(i) <= C32L Then GoTo m2 i = i + 1: If (SrcL(i) And &HFF&) <= C32 Then GoTo m1 If SrcL(i) <= C32L Then GoTo m2 i = i + 1: If (SrcL(i) And &HFF&) <= C32 Then GoTo m1 If SrcL(i) <= C32L Then GoTo m2 Do i = i + 1: If (SrcL(i) And &HFF&) <= C32 Then GoTo m1 If SrcL(i) <= C32L Then GoTo m2 Loop End If m2: Next i End Function
Private Sub Class_Terminate() RtlMoveMemory ByVal ArrPtr(SrcL), 0&, 4 'important End Sub
Calls
1sText = Replicate(10, "word ")
2sText = Replicate(1000, "word ")
3sText = Replicate(1000, "longlonglongword ")
4sText = Replicate(10000, "w" & vbCrLf)
5sText = Replicate(1000, "The WordCount charts outdate faster than the green party's value system. ") ' (Probably the most realistic call ;))
Charts
 VB5 Charts
CodeAuthorDopingNotes
WordCount01 ChrisAPI 
WordCount02 ChrisAPI 
WordCount03 DonaldAPI 
WordCount04 DonaldAPI 
WordCount05 PaulTLB 
WordCount06 JostAPI 
WordCount07 JostAPI 
WordCount08 PaulAPI 
WordCount09 JostAPI 
WordCount10 JostAPI 
WordCount11 OlafAPI 
Call 1
1011.957.597Ás
1112.507.947Ás
811.537.331Ás
911.807.499Ás
77.024.466Ás
63.992.534Ás
32.121.345Ás
21.701.082Ás
52.541.614Ás
42.331.483Ás
11.000.636Ás
Call 2
113.87188Ás
103.27159Ás
82.95143Ás
92.96144Ás
72.95143Ás
51.9092Ás
41.7786Ás
21.1355Ás
62.21107Ás
31.2058Ás
11.0048Ás
Call 3
103.05571Ás
113.05572Ás
83.01563Ás
93.01564Ás
73.00563Ás
52.06386Ás
42.02378Ás
31.32248Ás
62.49467Ás
21.27238Ás
11.00187Ás
Call 4
92.551,114Ás
102.621,144Ás
72.411,054Ás
82.461,074Ás
112.641,154Ás
61.58692Ás
51.48646Ás
21.07466Ás
11.00437Ás
41.25546Ás
31.08470Ás
Call 5
72.953,014Ás
92.993,060Ás
82.963,028Ás
103.053,124Ás
115.715,840Ás
62.202,248Ás
42.032,081Ás
31.531,567Ás
52.132,176Ás
21.491,528Ás
11.001,023Ás
 VB6 Charts
CodeAuthorDopingNotes
WordCount01 ChrisAPI 
WordCount02 ChrisAPI 
WordCount03 DonaldAPI 
WordCount04 DonaldAPI 
WordCount05 PaulTLB 
WordCount06 JostAPI 
WordCount07 JostAPI 
WordCount08 PaulAPI 
WordCount09 JostAPI 
WordCount10 JostAPI 
WordCount11 OlafAPI 
Call 1
1012.237.809Ás
912.187.778Ás
811.977.643Ás
1112.447.943Ás
76.694.269Ás
64.142.647Ás
42.091.333Ás
31.971.257Ás
21.921.226Ás
52.381.521Ás
11.000.639Ás
Call 2
113.64176Ás
103.63175Ás
93.45166Ás
83.40164Ás
73.32160Ás
61.9293Ás
51.7986Ás
31.2158Ás
41.2159Ás
21.1455Ás
11.0048Ás
Call 3
113.12581Ás
103.11580Ás
83.07573Ás
93.09575Ás
72.95550Ás
62.04380Ás
52.01375Ás
41.44268Ás
31.44268Ás
21.28238Ás
11.00187Ás
Call 4
102.551,121Ás
92.531,113Ás
72.351,035Ás
82.421,062Ás
112.561,124Ás
61.60702Ás
51.50660Ás
11.00440Ás
31.01446Ás
41.39609Ás
21.00441Ás
Call 5
93.033,155Ás
83.023,145Ás
72.993,115Ás
103.053,174Ás
115.755,991Ás
62.132,216Ás
52.062,144Ás
21.511,570Ás
31.511,570Ás
41.581,650Ás
11.001,042Ás
Notes & Conclusions
Don't read this. These comments are outdated faster than the green party's value system.

The only difference between WordCount01 and WordCount02 is the use of a temp var in the latter. The results vary ...
Also note the subtle difference between WordCount03: Const cCharLow As Byte = 33, and WordCount04: Dim cCharLow As Byte: cCharLow = 33. The results vary ...
But who cares after seeing WordCount07. Uh, WordCount08.
Uff, look at WordCount11. Competition is the major doping at work.
Got comments? How to read all those numbers

top




VBspeed © 2000-10 by Donald Lessau