''''''''''''''''''''
'Token Scanner v1.2'
''''''''''''''''''''
'Token scanner is a small tokenizer class for Visual Basic 6 At the moment it pulls out
'Strings,Numbers, "Quoted Strings" and stores them in an array for you to work with.
'Updated 18:56 28-Jan-12
'Added quoted string support
'Fixed bug with unknown token should not hang program now
'Update 23:16 30-Jan-12
'Converted program to class.
'Cleaned code up a bit.
Option Explicit
'Array of tokens.
Private mTokens() As Tokens
'Token counter.
Private TokCounter As Long
'String source to scan.
Private mSource As String
'Used for quoted strings.
Private mQuoteChar As String
'Current Token.
Private Token As Tokens
'Char Position.
Private CharPos As Long
Private Sub AddToken(ByVal Token As String, ByVal TokenType As TokenTypes)
'Resize array.
ReDim Preserve mTokens(0 To TokenCount) As Tokens
'Add token and type.
mTokens(TokenCount).Value = Token
mTokens(TokenCount).Type = TokenType
'Inc token counter
TokCounter = (TokenCount + 1)
End Sub
Private Sub Inc(Optional ByVal Value As Integer = 1)
'Char position.
CharPos = (CharPos + Value)
End Sub
Private Function NextChar() As String
'Fetch next char from string.
NextChar = Mid$(Source, CharPos, 1)
End Function
Private Function IsSymbol(ByVal c As String) As Boolean
'Return true string is symbol.
If InStr(" :,;<>+-/*%^=[]()&", c) Or c = vbCr Then IsSymbol = True
End Function
Private Function IsWhite(ByVal c As String) As Boolean
'Is white space.
IsWhite = (c = " ") Or (c = vbTab)
End Function
Private Function IsAlpha(ByVal c As String) As Boolean
'Return true if string is letter.
IsAlpha = c Like "[a-z-A-Z]"
End Function
Private Function IsDigit(ByVal c As String) As Boolean
'Return if we have numbers
IsDigit = c Like "[0-9]"
End Function
Private Sub NextToken()
With Token
'Set token type None
.Value = vbNullString
'Check for end of string
If (CharPos >= Len(Source)) Then
.Type = TEop
.Value = vbNullString
Exit Sub
End If
'Skip white space.
While IsWhite(NextChar)
Call Inc
Wend
'Check for vbcr
If NextChar = vbCr Then
'Inc by 2
Call Inc(2)
.Value = vbCr
.Type = TEol
Exit Sub
End If
'Check for symbols.
If IsSymbol(NextChar) Then
'Build token.
.Value = .Value & NextChar
'Inc by 1
Call Inc
.Type = TSymbol
'Check for quoted string
ElseIf IsAlpha(NextChar) Then
While Not IsSymbol(NextChar)
'Build token.
.Value = .Value & NextChar
'Inc by 1
Call Inc
Wend
.Type = TAlpha
'Check for numbers.
ElseIf IsDigit(NextChar) Then
While Not IsSymbol(NextChar)
'Build token.
.Value = .Value & NextChar
'Inc by 1
Call Inc
Wend
.Type = TDigit
'Check for quoted strings.
ElseIf (NextChar = QuoteChar) Then
'Inc by 1
Call Inc
While Not (NextChar = QuoteChar)
.Value = .Value & NextChar
'Inc by 1
Call Inc
Wend
.Type = TQuoteStr
'Inc by 1
Call Inc
Else
'Unknown token.
.Type = TUnknown
.Value = vbNullString
If (CharPos > Len(Source)) Then
Exit Sub
End If
End If
End With
End Sub
Public Property Get Source() As String
'Return source.
Source = mSource
End Property
Public Property Let Source(ByVal Value As String)
'Set new source.
mSource = Value
'Clear tokens array.
Erase mTokens
TokCounter = 0
'Lets get the tokens
Do
'Get tokens
Call NextToken
'Store tokens
Call AddToken(Token.Value, Token.Type)
Loop Until (Token.Type = TUnknown) Or (Token.Type = TEop)
End Property
Public Property Get TokenCount() As Integer
'Returns number of tokens collected from source.
TokenCount = TokCounter
End Property
Private Sub Class_Initialize()
'Init main variables.
QuoteChar = """"
CharPos = 1
TokCounter = 0
End Sub
Private Sub Class_Terminate()
Erase mTokens
End Sub
Public Property Get QuoteChar() As String
'Return quote char.
QuoteChar = mQuoteChar
End Property
Public Property Let QuoteChar(ByVal Value As String)
'Set quote char.
mQuoteChar = Value
End Property
Friend Property Get Tokens(ByVal Index As Long) As Tokens
'Return token type.
Tokens = mTokens(Index)
End Property