Tiny Token Scanner v1.2 Update

Printable View

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.

vb Code:

'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

Jan 24th, 2012, 06:10 PM
Mxjerrett

Re: Tiny Token Scanner v1.0 Update

As I don't have vb6 installed to test this out, I'm not entirely what the purpose of the application is. From the code it seems to parse out the special characters and specify a token type based off of alphanumeric characters.

My real question is, what would the real world use of this application be?
Jan 24th, 2012, 06:16 PM
BenJones

Re: Tiny Token Scanner v1.0 Update

Quote:

Originally Posted by Mxjerrett

As I don't have vb6 installed to test this out, I'm not entirely what the purpose of the application is. From the code it seems to parse out the special characters and specify a token type based off of alphanumeric characters.

My real question is, what would the real world use of this application be?

Can be used for many things maybe as I said an expression evalulator. or maybe for lexical analysis used in createing compilers. or maybe you wanted to maybe make a translator I duno maybe VB to C++ just an idea.
I am sure people can think of other uses.

Re: Tiny Token Scanner v1.3 Class

Hi this is a new update of my scanner project and has now been converted to a Class.
To use First add a new class to your project and name it Tokenizer
Next add a module and name it UDT

Next add the code into the Tokenizer class.

vb Code:

''''''''''''''''''''
'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

Next add the code to the module UDT

vb Code:

Option Explicit
 
'Token types
Public Enum TokenTypes
    TUnknown = 0
    TAlpha = 1
    TQuoteStr = 2
    TDigit = 3
    TSymbol = 4
    TEol = 5
    TEop = 6
End Enum
 
'Hold token and type
Public Type Tokens
    Value As String
    Type As TokenTypes
End Type

Ok now add a command button to your form1 and name it cmdRun

Next add this code to the buttons click event. This will be your example project.

vb Code:

Dim Scanner As Tokenizer
Dim Counter As Long
Dim Expr As String
Dim TokTypes(0 To 6) As String
 
    'Create tokenizer object.
    Set Scanner = New Tokenizer
    
    'Just token types as strings.
    TokTypes(0) = "TUnknown"
    TokTypes(1) = "TAlpha"
    TokTypes(2) = "TQuoteStr"
    TokTypes(3) = "TDigit"
    TokTypes(4) = "TSymbol"
    TokTypes(5) = "TEol"
    TokTypes(6) = "TEop"
 
    'Test Example
    Expr = "Var x String = 5" & vbCrLf
    Expr = Expr & "x = Hello + Str(5 + 5)" & vbCrLf
    Expr = Expr & "Print x" & vbCrLf
    Expr = Expr & "Print " + """" + "Hello-World" + """" + vbCrLf
    Expr = Expr & "End."
    
    With Scanner
        'The source to tokenize.
        .Source = Expr
        'used for quoteing strings.
        .QuoteChar = """"
        'Loop tho the tokens.
        For Counter = 0 To (.TokenCount - 1)
            'Display token and token type.
            Call MsgBox("Token= " & .Tokens(Counter).Value & vbCrLf & "Type=" & TokTypes(.Tokens(Counter).Type))
        Next Counter
    End With