home *** CD-ROM | disk | FTP | other *** search
/ Dan Appleman's Visual Bas…s Guide to the Win32 API / Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD / VB5PG32.mdf / articles / vbdev / source / pinlex.bas < prev    next >
Encoding:
BASIC Source File  |  1995-04-26  |  4.6 KB  |  141 lines
  1. Option Explicit
  2.  
  3. Global Separators$  ' Separators between tokens
  4.  
  5. ' State for parsing
  6. ' 0 = Normal
  7. ' 1 = In quote
  8. Dim ParseState%
  9.  
  10. ' Location of special characters in string
  11. Const idComment% = 4    '  ' character
  12. Const idSpace% = 1      ' Space character
  13. Const IdTab% = 6        ' Tab character
  14. Const idQuote% = 7      '  " character
  15.  
  16. '
  17. ' Returns the position of the next separator.
  18. ' Valid separator is any separator unless ParseState% is 1, in which
  19. ' case only a quote is valid.
  20. ' TokenId% is the location of the token in the separator string
  21. '
  22. Function FindSeparator% (InputString$, TokenId%)
  23.     Dim InputLength%
  24.     Dim c%
  25.     
  26.     If ParseState% = 1 Then ' Find next quote only
  27.         c% = InStr(InputString$, Chr$(34))
  28.         If c% > 0 Then
  29.             TokenId% = InStr(Separators$, Chr$(34))
  30.         End If
  31.         FindSeparator = c%
  32.         Exit Function
  33.     End If
  34.  
  35.     InputLength% = Len(InputString$)
  36.     For c% = 1 To InputLength%
  37.         TokenId% = InStr(Separators$, Mid$(InputString$, c%, 1))
  38.         Select Case TokenId%
  39.             Case 0  ' Ignore - it's not a separator
  40.  
  41.             Case Else
  42.                 ' This character is a separator
  43.                 FindSeparator = c%
  44.                 Exit Function
  45.         End Select
  46.         
  47.     Next c%
  48.  
  49.     FindSeparator = 0
  50.     TokenId% = 0
  51.  
  52. End Function
  53.  
  54. '
  55. ' Retrieves the left token from the input string, modifies
  56. ' the input string to remove the token. Ignores white space
  57. ' result% = 0 - on success, 1 - Missing close quote
  58. '
  59. Function GetToken1$ (instring$, result%)
  60.     Dim maxlen%
  61.     Dim Separatorloc%, Quote2%
  62.     Dim TokenId%
  63.     Dim Quote2Loc%
  64.     result% = 0
  65.     maxlen% = Len(instring$)
  66.     If maxlen% = 0 Then ' Empty string
  67.         GetToken1$ = instring$
  68.         result% = 0
  69.     End If
  70.  
  71.     Separatorloc% = FindSeparator(instring$, TokenId%)
  72.     Select Case Separatorloc%
  73.         Case 0  ' Just retrieve through the rest of the line
  74.                 GetToken1 = instring$
  75.                 instring$ = ""
  76.  
  77.         Case 1  ' First char is a separator
  78.                 ' Special cases are comment and quote
  79.                 Select Case TokenId%
  80.                     Case idQuote%   ' Return quoted string as a single token
  81.                         ParseState% = 1
  82.                         Quote2% = FindSeparator(Mid$(instring$, 2), TokenId%) + 1
  83.                         ParseState% = 0
  84.                         If Quote2% <= 1 Then
  85.                             result% = 1
  86.                             Exit Function
  87.                         Else
  88.                             GetToken1$ = Left$(instring$, Quote2%)
  89.                             If maxlen% > Quote2% Then instring$ = Mid$(instring$, Quote2% + 1) Else instring$ = ""
  90.                             Exit Function
  91.                         End If
  92.                     Case idComment% ' Return comment as a single token
  93.                         GetToken1$ = instring$
  94.                         instring$ = ""
  95.                     Case idSpace%, IdTab%   ' It's whitespace
  96.                         If Left$(instring$, 1) = Chr$(9) Then
  97.                             ' Strip off the tab
  98.                             If Len(instring$) > 1 Then instring$ = Mid$(instring$, 2) Else instring$ = ""
  99.                         End If
  100.                         instring$ = LTrim$(instring$)   ' And any extra spaces
  101.                         If Len(instring$) > 0 Then
  102.                             ' Recursive call on rest of string
  103.                             GetToken1 = GetToken1(instring$, TokenId%)
  104.                         Else
  105.                             GetToken1$ = ""
  106.                             instring$ = ""
  107.                         End If
  108.                     Case Else
  109.                         ' All other separators are tokens
  110.                         GetToken1$ = Left$(instring$, 1)
  111.                         If maxlen% > 1 Then
  112.                             instring$ = Mid$(instring$, 2)
  113.                         Else
  114.                             instring$ = ""
  115.                         End If
  116.  
  117.                 End Select
  118.  
  119.         
  120.         Case Else   ' First char is not a separator
  121.                 ' Return the string up to the separator
  122.                 GetToken1$ = UCase$(Left$(instring$, Separatorloc% - 1))
  123.                 instring$ = Mid$(instring$, Separatorloc%)
  124.     End Select
  125.         
  126.  
  127.  
  128.  
  129. End Function
  130.  
  131. '
  132. ' Initialize the constants
  133. '
  134. Sub Initialize ()
  135.     ' Characters that separate the tokens
  136.     Separators$ = " ()'," & Chr$(9) & Chr$(34) & "%#$!@&=/:"
  137.     ' Note: chr$(9) is the tab and chr$(34) is a "
  138.  
  139. End Sub
  140.  
  141.