Tiny Token Scanner v1.2 Update

[BenJones]

Hi was out today did some shopping then went to the library so I thought I have a play on there computers anyway found my self in Microsoft Word and decided to play with the macro editor anyway this is what I came up with a basic small token scanner I made for scanning tokens in a string hope it comes in handy you could more than likely use something like this for a expression parser or if your building a interpter. Anyway the code is very basic but easy to understand. If i get time I may try and add more features to it

Comments suggestions welcome.

Update 1.2
Here a small update agian of the scanner now with quoted string support
Bug fix for unkown tokens.

'Updated 18:56 28-Jan-12
'Added quoted string support
'Fixed bug with unknown token should not hang program now
 
Option Explicit
 
Private Enum TTypes
    TUnknown = 0
    TAlpha = 1
    TQuoteStr = 2
    TDigit = 3
    TSymbol = 4
    EOL = 5
    EOP = 6
End Enum
 
Private Const VbQuote = """"
Dim Expr As String          'Expression / Code to scan
Dim Token As String         'Current Token
Dim TokType As TTypes       'Token Type see TTypes
Private Pos As Integer      'Char Position
 
Private Sub Inc(Optional IncVal As Integer = 1)
    Pos = (Pos + IncVal)
End Sub
 
Private Function IsSymbol(c As String) As Boolean
    'Return true if we have a symbol.
    If InStr(" :,;<>+-/*%^=[]()&", c) Or c = vbCr Then IsSymbol = True
End Function
 
Private Function GetChar() As String
    'Fetch next char from string.
    GetChar = Mid$(Expr, Pos, 1)
End Function
 
Private Function IsWhite(c As String) As Boolean
    'Is white check
    IsWhite = (c = " ") Or (c = vbTab)
End Function
 
Private Function IsAlpha(c As String) As Boolean
    'Return true if string is of alpha
    Select Case UCase$(c)
        Case "A" To "Z"
            IsAlpha = True
        Case Else
            IsAlpha = False
        End Select
End Function
 
Private Function IsDigit(c As String) As Boolean
'Return if we have numbers
    Select Case c
        Case 0 To 9
            IsDigit = True
        Case Else
            IsDigit = False
    End Select
End Function
 
Private Sub GetToken()
    'Set token type None
    'Eat token
    Token = vbNullString
    
    'Check for end of string
    If (Pos > Len(Expr)) Then
        TokType = EOP
        Pos = Len(Expr)
        Exit Sub
    End If
    
    'Skip white
    While IsWhite(GetChar)
        Call Inc
    Wend
    
    'Check for vbcr
    If GetChar = vbCr Then
        Call Inc(2)
        Token = vbCr
        TokType = EOL
        Exit Sub
    End If
    
    'Check for symbol
    If IsSymbol(GetChar) Then
        'Build token.
        Token = Token & GetChar
        Call Inc
        TokType = TSymbol
    ElseIf IsAlpha(GetChar) Then
        While Not IsSymbol(GetChar)
            'Build token.
            Token = Token & GetChar
            Call Inc
        Wend
        TokType = TAlpha
    'Check for number
    ElseIf IsDigit(GetChar) Then
        While Not IsSymbol(GetChar)
            'Build token.
            Token = Token & GetChar
            Call Inc
        Wend
        TokType = TDigit
    'Check for quoted string
    ElseIf (GetChar = VbQuote) Then
        'Move along one
        Call Inc
        While Not (GetChar = VbQuote)
            Token = Token + GetChar
            Call Inc
        Wend
        TokType = TQuoteStr
        'Inc by one
        Call Inc
    Else
        'Unknown token type
        TokType = TUnknown
        If (Pos > Len(Expr)) Then Exit Sub
    End If
    
End Sub
 
Private Sub Init()
    'Test string example
    Expr = "Var x String = 5" & vbCrLf
    Expr = Expr & "x = Hello + Str(5 + 5)" & vbCrLf
    Expr = Expr & "Print x" & vbCrLf
    Expr = Expr & "Print " + VbQuote + "Hello'-'World" + VbQuote + vbCrLf
    Expr = Expr & "End." & vbCrLf
    
    'Init vars
    Pos = 1
End Sub
 
 
Private Sub Command1_Click()
    Call Init
    'Get First token
    Call GetToken
    
    'Read the tokens until end of source
    While TokType <> EOP
        'Test for unkown token
        If (TokType = TUnknown) Then Exit Sub
        
        'Display token type and token
        Call MsgBox("Token Type =" & TokType & vbCrLf & "Token=" & Token)
        Call GetToken
    Wend
    
End Sub