Tiny Token Scanner v1.2 Update-VBForums
Results 1 to 4 of 4

Thread: Tiny Token Scanner v1.2 Update

  1. #1

    Thread Starter
    Fanatic Member BenJones's Avatar
    Join Date
    Mar 2010
    Location
    Wales UK
    Posts
    564

    Tiny Token Scanner v1.2 Update

    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:
    1. 'Updated 18:56 28-Jan-12
    2. 'Added quoted string support
    3. 'Fixed bug with unknown token should not hang program now
    4.  
    5. Option Explicit
    6.  
    7. Private Enum TTypes
    8.     TUnknown = 0
    9.     TAlpha = 1
    10.     TQuoteStr = 2
    11.     TDigit = 3
    12.     TSymbol = 4
    13.     EOL = 5
    14.     EOP = 6
    15. End Enum
    16.  
    17. Private Const VbQuote = """"
    18. Dim Expr As String          'Expression / Code to scan
    19. Dim Token As String         'Current Token
    20. Dim TokType As TTypes       'Token Type see TTypes
    21. Private Pos As Integer      'Char Position
    22.  
    23. Private Sub Inc(Optional IncVal As Integer = 1)
    24.     Pos = (Pos + IncVal)
    25. End Sub
    26.  
    27. Private Function IsSymbol(c As String) As Boolean
    28.     'Return true if we have a symbol.
    29.     If InStr(" :,;<>+-/*%^=[]()&", c) Or c = vbCr Then IsSymbol = True
    30. End Function
    31.  
    32. Private Function GetChar() As String
    33.     'Fetch next char from string.
    34.     GetChar = Mid$(Expr, Pos, 1)
    35. End Function
    36.  
    37. Private Function IsWhite(c As String) As Boolean
    38.     'Is white check
    39.     IsWhite = (c = " ") Or (c = vbTab)
    40. End Function
    41.  
    42. Private Function IsAlpha(c As String) As Boolean
    43.     'Return true if string is of alpha
    44.     Select Case UCase$(c)
    45.         Case "A" To "Z"
    46.             IsAlpha = True
    47.         Case Else
    48.             IsAlpha = False
    49.         End Select
    50. End Function
    51.  
    52. Private Function IsDigit(c As String) As Boolean
    53. 'Return if we have numbers
    54.     Select Case c
    55.         Case 0 To 9
    56.             IsDigit = True
    57.         Case Else
    58.             IsDigit = False
    59.     End Select
    60. End Function
    61.  
    62. Private Sub GetToken()
    63.     'Set token type None
    64.     'Eat token
    65.     Token = vbNullString
    66.    
    67.     'Check for end of string
    68.     If (Pos > Len(Expr)) Then
    69.         TokType = EOP
    70.         Pos = Len(Expr)
    71.         Exit Sub
    72.     End If
    73.    
    74.     'Skip white
    75.     While IsWhite(GetChar)
    76.         Call Inc
    77.     Wend
    78.    
    79.     'Check for vbcr
    80.     If GetChar = vbCr Then
    81.         Call Inc(2)
    82.         Token = vbCr
    83.         TokType = EOL
    84.         Exit Sub
    85.     End If
    86.    
    87.     'Check for symbol
    88.     If IsSymbol(GetChar) Then
    89.         'Build token.
    90.         Token = Token & GetChar
    91.         Call Inc
    92.         TokType = TSymbol
    93.     ElseIf IsAlpha(GetChar) Then
    94.         While Not IsSymbol(GetChar)
    95.             'Build token.
    96.             Token = Token & GetChar
    97.             Call Inc
    98.         Wend
    99.         TokType = TAlpha
    100.     'Check for number
    101.     ElseIf IsDigit(GetChar) Then
    102.         While Not IsSymbol(GetChar)
    103.             'Build token.
    104.             Token = Token & GetChar
    105.             Call Inc
    106.         Wend
    107.         TokType = TDigit
    108.     'Check for quoted string
    109.     ElseIf (GetChar = VbQuote) Then
    110.         'Move along one
    111.         Call Inc
    112.         While Not (GetChar = VbQuote)
    113.             Token = Token + GetChar
    114.             Call Inc
    115.         Wend
    116.         TokType = TQuoteStr
    117.         'Inc by one
    118.         Call Inc
    119.     Else
    120.         'Unknown token type
    121.         TokType = TUnknown
    122.         If (Pos > Len(Expr)) Then Exit Sub
    123.     End If
    124.    
    125. End Sub
    126.  
    127. Private Sub Init()
    128.     'Test string example
    129.     Expr = "Var x String = 5" & vbCrLf
    130.     Expr = Expr & "x = Hello + Str(5 + 5)" & vbCrLf
    131.     Expr = Expr & "Print x" & vbCrLf
    132.     Expr = Expr & "Print " + VbQuote + "Hello'-'World" + VbQuote + vbCrLf
    133.     Expr = Expr & "End." & vbCrLf
    134.    
    135.     'Init vars
    136.     Pos = 1
    137. End Sub
    138.  
    139.  
    140. Private Sub Command1_Click()
    141.     Call Init
    142.     'Get First token
    143.     Call GetToken
    144.    
    145.     'Read the tokens until end of source
    146.     While TokType <> EOP
    147.         'Test for unkown token
    148.         If (TokType = TUnknown) Then Exit Sub
    149.        
    150.         'Display token type and token
    151.         Call MsgBox("Token Type =" & TokType & vbCrLf & "Token=" & Token)
    152.         Call GetToken
    153.     Wend
    154.    
    155. End Sub
    Last edited by BenJones; Jan 28th, 2012 at 01:01 PM.

  2. #2
    Fanatic Member Mxjerrett's Avatar
    Join Date
    Apr 2006
    Location
    Oklahoma
    Posts
    939

    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?

    If a post has been helpful please rate it.
    If your question has been answered, pull down the tread tools and mark it as resolved.

  3. #3

    Thread Starter
    Fanatic Member BenJones's Avatar
    Join Date
    Mar 2010
    Location
    Wales UK
    Posts
    564

    Re: Tiny Token Scanner v1.0 Update

    Quote Originally Posted by Mxjerrett View Post
    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.

  4. #4

    Thread Starter
    Fanatic Member BenJones's Avatar
    Join Date
    Mar 2010
    Location
    Wales UK
    Posts
    564

    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:
    1. ''''''''''''''''''''
    2. 'Token Scanner v1.2'
    3. ''''''''''''''''''''
    4. 'Token scanner is a small tokenizer class for Visual Basic 6 At the moment it pulls out
    5. 'Strings,Numbers, "Quoted Strings" and stores them in an array for you to work with.
    6.  
    7.  
    8. 'Updated 18:56 28-Jan-12
    9. 'Added quoted string support
    10. 'Fixed bug with unknown token should not hang program now
    11.  
    12. 'Update 23:16 30-Jan-12
    13. 'Converted program to class.
    14. 'Cleaned code up a bit.
    15.  
    16. Option Explicit
    17.  
    18. 'Array of tokens.
    19. Private mTokens() As Tokens
    20. 'Token counter.
    21. Private TokCounter As Long
    22. 'String source to scan.
    23. Private mSource As String
    24. 'Used for quoted strings.
    25. Private mQuoteChar As String
    26. 'Current Token.
    27. Private Token As Tokens
    28. 'Char Position.
    29. Private CharPos As Long
    30.  
    31. Private Sub AddToken(ByVal Token As String, ByVal TokenType As TokenTypes)
    32.     'Resize array.
    33.     ReDim Preserve mTokens(0 To TokenCount) As Tokens
    34.     'Add token and type.
    35.     mTokens(TokenCount).Value = Token
    36.     mTokens(TokenCount).Type = TokenType
    37.     'Inc token counter
    38.     TokCounter = (TokenCount + 1)
    39. End Sub
    40.  
    41. Private Sub Inc(Optional ByVal Value As Integer = 1)
    42.     'Char position.
    43.     CharPos = (CharPos + Value)
    44. End Sub
    45.  
    46. Private Function NextChar() As String
    47.     'Fetch next char from string.
    48.     NextChar = Mid$(Source, CharPos, 1)
    49. End Function
    50.  
    51. Private Function IsSymbol(ByVal c As String) As Boolean
    52.     'Return true string is symbol.
    53.     If InStr(" :,;<>+-/*%^=[]()&", c) Or c = vbCr Then IsSymbol = True
    54. End Function
    55.  
    56. Private Function IsWhite(ByVal c As String) As Boolean
    57.     'Is white space.
    58.     IsWhite = (c = " ") Or (c = vbTab)
    59. End Function
    60.  
    61. Private Function IsAlpha(ByVal c As String) As Boolean
    62.     'Return true if string is letter.
    63.     IsAlpha = c Like "[a-z-A-Z]"
    64. End Function
    65.  
    66. Private Function IsDigit(ByVal c As String) As Boolean
    67.     'Return if we have numbers
    68.     IsDigit = c Like "[0-9]"
    69. End Function
    70.  
    71. Private Sub NextToken()
    72.     With Token
    73.         'Set token type None
    74.         .Value = vbNullString
    75.  
    76.         'Check for end of string
    77.         If (CharPos >= Len(Source)) Then
    78.             .Type = TEop
    79.             .Value = vbNullString
    80.             Exit Sub
    81.         End If
    82.    
    83.         'Skip white space.
    84.         While IsWhite(NextChar)
    85.             Call Inc
    86.         Wend
    87.    
    88.         'Check for vbcr
    89.         If NextChar = vbCr Then
    90.             'Inc by 2
    91.             Call Inc(2)
    92.             .Value = vbCr
    93.             .Type = TEol
    94.             Exit Sub
    95.         End If
    96.    
    97.         'Check for symbols.
    98.         If IsSymbol(NextChar) Then
    99.             'Build token.
    100.             .Value = .Value & NextChar
    101.             'Inc by 1
    102.             Call Inc
    103.             .Type = TSymbol
    104.         'Check for quoted string
    105.         ElseIf IsAlpha(NextChar) Then
    106.             While Not IsSymbol(NextChar)
    107.                 'Build token.
    108.                 .Value = .Value & NextChar
    109.                 'Inc by 1
    110.                 Call Inc
    111.             Wend
    112.             .Type = TAlpha
    113.         'Check for numbers.
    114.         ElseIf IsDigit(NextChar) Then
    115.             While Not IsSymbol(NextChar)
    116.                 'Build token.
    117.                 .Value = .Value & NextChar
    118.                 'Inc by 1
    119.                 Call Inc
    120.             Wend
    121.             .Type = TDigit
    122.         'Check for quoted strings.
    123.         ElseIf (NextChar = QuoteChar) Then
    124.             'Inc by 1
    125.             Call Inc
    126.             While Not (NextChar = QuoteChar)
    127.                 .Value = .Value & NextChar
    128.                 'Inc by 1
    129.                 Call Inc
    130.             Wend
    131.             .Type = TQuoteStr
    132.             'Inc by 1
    133.             Call Inc
    134.         Else
    135.             'Unknown token.
    136.             .Type = TUnknown
    137.             .Value = vbNullString
    138.             If (CharPos > Len(Source)) Then
    139.                 Exit Sub
    140.             End If
    141.         End If
    142.     End With
    143.    
    144. End Sub
    145.  
    146. Public Property Get Source() As String
    147.     'Return source.
    148.     Source = mSource
    149. End Property
    150.  
    151. Public Property Let Source(ByVal Value As String)
    152.     'Set new source.
    153.     mSource = Value
    154.     'Clear tokens array.
    155.     Erase mTokens
    156.     TokCounter = 0
    157.     'Lets get the tokens
    158.     Do
    159.         'Get tokens
    160.         Call NextToken
    161.         'Store tokens
    162.         Call AddToken(Token.Value, Token.Type)
    163.     Loop Until (Token.Type = TUnknown) Or (Token.Type = TEop)
    164.    
    165. End Property
    166.  
    167. Public Property Get TokenCount() As Integer
    168.     'Returns number of tokens collected from source.
    169.     TokenCount = TokCounter
    170. End Property
    171.  
    172. Private Sub Class_Initialize()
    173.     'Init main variables.
    174.     QuoteChar = """"
    175.     CharPos = 1
    176.     TokCounter = 0
    177. End Sub
    178.  
    179. Private Sub Class_Terminate()
    180.     Erase mTokens
    181. End Sub
    182.  
    183. Public Property Get QuoteChar() As String
    184.     'Return quote char.
    185.     QuoteChar = mQuoteChar
    186. End Property
    187.  
    188. Public Property Let QuoteChar(ByVal Value As String)
    189.     'Set quote char.
    190.     mQuoteChar = Value
    191. End Property
    192.  
    193. Friend Property Get Tokens(ByVal Index As Long) As Tokens
    194.     'Return token type.
    195.     Tokens = mTokens(Index)
    196. End Property

    Next add the code to the module UDT

    vb Code:
    1. Option Explicit
    2.  
    3. 'Token types
    4. Public Enum TokenTypes
    5.     TUnknown = 0
    6.     TAlpha = 1
    7.     TQuoteStr = 2
    8.     TDigit = 3
    9.     TSymbol = 4
    10.     TEol = 5
    11.     TEop = 6
    12. End Enum
    13.  
    14. 'Hold token and type
    15. Public Type Tokens
    16.     Value As String
    17.     Type As TokenTypes
    18. 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:
    1. Dim Scanner As Tokenizer
    2. Dim Counter As Long
    3. Dim Expr As String
    4. Dim TokTypes(0 To 6) As String
    5.  
    6.     'Create tokenizer object.
    7.     Set Scanner = New Tokenizer
    8.    
    9.     'Just token types as strings.
    10.     TokTypes(0) = "TUnknown"
    11.     TokTypes(1) = "TAlpha"
    12.     TokTypes(2) = "TQuoteStr"
    13.     TokTypes(3) = "TDigit"
    14.     TokTypes(4) = "TSymbol"
    15.     TokTypes(5) = "TEol"
    16.     TokTypes(6) = "TEop"
    17.  
    18.     'Test Example
    19.     Expr = "Var x String = 5" & vbCrLf
    20.     Expr = Expr & "x = Hello + Str(5 + 5)" & vbCrLf
    21.     Expr = Expr & "Print x" & vbCrLf
    22.     Expr = Expr & "Print " + """" + "Hello-World" + """" + vbCrLf
    23.     Expr = Expr & "End."
    24.    
    25.     With Scanner
    26.         'The source to tokenize.
    27.         .Source = Expr
    28.         'used for quoteing strings.
    29.         .QuoteChar = """"
    30.         'Loop tho the tokens.
    31.         For Counter = 0 To (.TokenCount - 1)
    32.             'Display token and token type.
    33.             Call MsgBox("Token= " & .Tokens(Counter).Value & vbCrLf & "Type=" & TokTypes(.Tokens(Counter).Type))
    34.         Next Counter
    35.     End With

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width

Survey posted by VBForums.