vbAccelerator - Contents of code file: CTokenizer.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CTokenizer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'***********************************************************************
'*         Copyright 1999 Robert Heinig, All Rights Reserved          *
'*                         mailto:rheinig@gmx.net                      *
'***********************************************************************
'* You are free to use this tool within your own applications, but you *
'* are expressly forbidden from selling or otherwise distributing this *
'* source code without prior written consent. Free distribution of     *
'* this tool is only allowed in form of its original, unmodified ZIP   *
'* file, including the executable, the source, the readme and the      *
'* sample program. Additionally, distribution must not charge any fee. *
'***********************************************************************

Option Explicit


Private Const cAllocChunk = 8

' Arbeitsvariablen Tokenizer
Private masTokens() As String
Private mnTokens As Long


Private Sub Class_Terminate()
    Zap
End Sub

Private Sub Zap()
    mnTokens = 0
    Erase masTokens
End Sub

Public Sub Tokenize(sQuery As String)
    Dim i As Long, st As Long, En As Long, j As Long
    Dim bInWord As Boolean, bInQuote As Boolean
    Dim bStoreToken As Boolean, bQuoteBeginInWord As Boolean

    Zap
    
    ReDim masTokens(0 To 3)
    mnTokens = 0
    i = 1
    Do Until i > Len(sQuery) + 1
        If i > Len(sQuery) Then
            bStoreToken = bInWord
            En = i
            i = i + 1
        Else
            bStoreToken = False
            Select Case Asc(Mid$(sQuery, i, 1))
            Case 32, 9, 10, 13  ' Whitespace
                If Not bInQuote And bInWord Then
                    En = i
                    bStoreToken = True
                    bInWord = False
                End If
                i = i + 1
            Case 34     ' Quote
                If bInQuote Then
                    bInQuote = False
                    If Not bQuoteBeginInWord Then
                        En = i
                        bStoreToken = True
                        bInWord = False
                    End If
                Else
                    bInQuote = True
                    bQuoteBeginInWord = bInWord
                    If Not bInWord Then
                        st = i + 1
                        bInWord = True
                    End If
                End If
                i = i + 1
            Case Else
                If Not bInWord Then
                    st = i
                    bInWord = True
                End If
                i = i + 1
            End Select
        End If
        If bStoreToken Then
            If mnTokens >= UBound(masTokens) Then
                ReDim Preserve masTokens(0 To mnTokens + cAllocChunk)
            End If
            masTokens(mnTokens) = Mid$(sQuery, st, En - st)
            mnTokens = mnTokens + 1
        End If
    Loop
End Sub

Public Property Get Token(ByVal Index As Long) As String
    Token = masTokens(Index)
End Property
Public Property Let Token(ByVal Index As Long, ByVal sData As String)
    masTokens(Index) = sData
End Property

Public Property Get OptionName(ByVal Index As Long) As String
    Dim s As String, i As Long
    s = masTokens(Index)
    i = InStr(s, ":"): If i = 0 Then i = Len(s) + 1
    If Left$(s, 1) = "/index.html" And i > 2 Then OptionName = Mid$(s, 2, i - 2)
End Property

Public Property Get TokenCount() As Long
    TokenCount = mnTokens
End Property

Public Function Rebuild() As String
    Dim i As Long, s As String, st As String

    s = ""
    For i = 0 To mnTokens - 1
        st = masTokens(i)
        If InStr(st, " ") Then
            st = """" & st & """"
        End If
        If Len(s) > 0 Then
            s = s & " " & st
        Else
            s = st
        End If
    Next
    Rebuild = s
End Function

Public Sub Insert(sData As String, Optional ByVal lBefore As Long = -1)
    Dim i As Long
    
    If mnTokens = 0 Then
        ReDim masTokens(0 To cAllocChunk \ 2 - 1)
    End If
    If mnTokens >= UBound(masTokens) Then
        ReDim Preserve masTokens(0 To mnTokens + cAllocChunk)
    End If
    If lBefore < 0 Or lBefore > mnTokens Then lBefore = mnTokens
    For i = mnTokens - 1 To lBefore Step -1
        masTokens(i + 1) = masTokens(i)
    Next
    masTokens(lBefore) = sData
    mnTokens = mnTokens + 1
End Sub

Public Sub Remove(ByVal lIndex As Long)
    Dim i As Long

    If lIndex < 0 Or lIndex >= mnTokens Then Exit Sub
    For i = lIndex + 1 To mnTokens - 1
        masTokens(i - 1) = masTokens(i)
    Next
    masTokens(mnTokens - 1) = ""
    mnTokens = mnTokens - 1
End Sub