<%
   DIM  GI_TextArea1
   DIM  GI_ParseMode

   GI_TextArea1 = Request.Form("TextArea1")
   GI_ParseMode = Request.Form("OutputOpt")
%>





<FORM   Method=POST   Action="ParseQBa.ASP"   >

Input &nbsp;( Source code for QBASIC language )<BR>
<TEXTAREA   Name=TextArea1   Cols=79   Rows=10   >
<%IF GI_TextArea1 <> "" THEN%><%=GI_TextArea1%><%ELSE%>   ' Simple program

   PRINT "Hello World..."
<%END IF%></TEXTAREA><BR>


<INPUT   Type=SUBMIT   Value="Run parsing process"   > &nbsp;


Output option
<SELECT   Name=OutputOpt   Size=1   >
   <OPTION   Value="/Same"     <%IF GI_ParseMode = "/Same"      THEN%>   SELECTED<%END IF%>   >/Same</OPTION>
   <OPTION   Value="/Verbose"  <%IF (GI_ParseMode = "/Verbose") or (GI_ParseMode = "") THEN%>   SELECTED<%END IF%>   >/Verbose</OPTION>
   <OPTION   Value="/Parse"    <%IF GI_ParseMode = "/Parse"     THEN%>   SELECTED<%END IF%>   >/Parse</OPTION>
   <OPTION   Value="/NoComment"<%IF GI_ParseMode = "/NoComment" THEN%>   SELECTED<%END IF%>   >/NoComment</OPTION>
   <OPTION   Value="/Compact"  <%IF GI_ParseMode = "/Compact"   THEN%>   SELECTED<%END IF%>   >/Compact</OPTION>
   <OPTION   Value="/PackLine" <%IF GI_ParseMode = "/PackLine"  THEN%>   SELECTED<%END IF%>   >/PackLine</OPTION>
</SELECT><BR>

</FORM>





<%
'
'------------------------------------------------------------------------------
' This file toolbox
'------------------------------------------------------------------------------
'
'
'---------------
' Const: Parser Result prXXXXX
'
' NEXTxxx: Mini parser for QBASIC language
'---------------
'
   CONST  prToken             = 1
   CONST  prSymbol            = 2
   CONST  prSymbol2Ch         = 3
   CONST  prQuotedText        = 4
   CONST  prIllegalToken      = 5

   CONST  prLineComment       = 6
   CONST  prComment           = 7
   CONST  prFilling           = 8

   CONST  prEndQuoteMissing   = 9
   CONST  prEndCommentMissing = 10
   CONST  prEndOfBuffer       = 11


   DIM  C_ParserResultStr(10)      '--- 11 - 1
      C_ParserResultStr(0) = "Token"
      C_ParserResultStr(1) = "Symbol"
      C_ParserResultStr(2) = "Symbol2Ch"
      C_ParserResultStr(3) = "QuotedText"
      C_ParserResultStr(4) = "IllegalToken"
      C_ParserResultStr(5) = "LineComment"
      C_ParserResultStr(6) = "Comment"
      C_ParserResultStr(7) = "Filling"
      C_ParserResultStr(8) = "EndQuoteMissing"
      C_ParserResultStr(9) = "EndCommentMissing"
      C_ParserResultStr(10) = "EndOfBuffer"


'===== NEXTxxx

   DIM  G_StrParseMe
   DIM  G_PBegin
   DIM  G_PAfterEnd

FUNCTION   NEXTxxx   ( I_BuffPLast  _
                     , IO_PBegin    _
                     , O_PAfterEnd )   'Parser Result const, prXXXXX

                                                       '   <>   <=   >=

   CONST  C_OneCharSymbols   = "+-*/>=<(),:\^;?"       '---   _
   CONST  C_CharsEndingToken = "+-*/>=<(),:\^;?'"      '---   _

   DIM  L_Ch

   '----- Controls : nil, non sense values
   IF IsNull(I_BuffPLast) or IsNull(IO_PBegin) or (I_BuffPLast < IO_PBegin) THEN
      NEXTxxx = prEndOfBuffer
      EXIT FUNCTION
   END IF

   G_PBegin = IO_PBegin
'DEBUG:Response.Write (   "DEBUG.NEXTxxx.1:"  &  ""  &  vbCRLF   )
'NEXTxxx = prSymbol2Ch
'EXIT FUNCTION

   '===== 0. Search first char of the token
   '----- Buffer   :  Other...  CRLF  Other...   TokenBeeingSearched
   '----- Pointers :                     G_PBegin^                  ^G_PAfterEnd
   L_Ch = Mid ( G_StrParseMe , G_PBegin , 1 )
   WHILE (L_Ch = " ") or (L_Ch = Chr(9)) or (L_Ch = Chr(10)) or (L_Ch = Chr(13))
      G_PBegin = G_PBegin + 1
      IF I_BuffPLast < G_PBegin THEN  NEXTxxx = prEndOfBuffer  :  EXIT FUNCTION  :  END IF
      L_Ch = Mid ( G_StrParseMe , G_PBegin , 1 )
   WEND
   G_PAfterEnd = G_PBegin

   DO      '--- PATCH  ( 1 / 2 ) , "Not aloud: goto LABEL_Bloc3"

   '===== 1. Special three non alpha chars tokens, like

   '===== 2. Special two non alpha chars tokens, like   <>   <=   >=

   '----- 2.1. case:   <>
   IF L_Ch = "<" THEN
      G_PAfterEnd = G_PAfterEnd + 1
      IF I_BuffPLast < G_PAfterEnd              THEN  G_PAfterEnd = G_PAfterEnd - 1  :  EXIT DO  :  END IF
      IF Mid(G_StrParseMe,G_PAfterEnd,1) <> ">" THEN
         G_PAfterEnd = G_PAfterEnd - 1
      ELSE
         G_PAfterEnd = G_PAfterEnd + 1
         NEXTxxx     = prSymbol2Ch
         EXIT FUNCTION
      END IF
   END IF

   '----- 2.2. case:   <=
   IF L_Ch = "<" THEN
      G_PAfterEnd = G_PAfterEnd + 1
      IF I_BuffPLast < G_PAfterEnd              THEN  G_PAfterEnd = G_PAfterEnd - 1  :  EXIT DO  :  END IF
      IF Mid(G_StrParseMe,G_PAfterEnd,1) <> "=" THEN
         G_PAfterEnd = G_PAfterEnd - 1
      ELSE
         G_PAfterEnd = G_PAfterEnd + 1
         NEXTxxx     = prSymbol2Ch
         EXIT FUNCTION
      END IF
   END IF

   '----- 2.3. case:   >=
   IF L_Ch = ">" THEN
      G_PAfterEnd = G_PAfterEnd + 1
      IF I_BuffPLast < G_PAfterEnd              THEN  G_PAfterEnd = G_PAfterEnd - 1  :  EXIT DO  :  END IF
      IF Mid(G_StrParseMe,G_PAfterEnd,1) <> "=" THEN
         G_PAfterEnd = G_PAfterEnd - 1
      ELSE
         G_PAfterEnd = G_PAfterEnd + 1
         NEXTxxx     = prSymbol2Ch
         EXIT FUNCTION
      END IF
   END IF

   LOOP UNTIL TRUE      '--- PATCH  ( 2 / 2 ) , "Not aloud: goto LABEL_Bloc3"

   '===== 3. Other cases
 '--LABEL_Bloc3:--
   '----- 3.1. case:   '... comment
   IF L_Ch = "'" THEN
      DO
         G_PAfterEnd = G_PAfterEnd + 1
         IF I_BuffPLast < G_PAfterEnd THEN EXIT DO
         L_Ch = Mid ( G_StrParseMe , G_PAfterEnd , 1 )
      LOOP UNTIL (L_Ch = Chr(10)) or (L_Ch = Chr(13))
      NEXTxxx = prLineComment
      EXIT FUNCTION
   ELSE

   '----- 3.2. case:   one char symbol,  like + - * < ; etc
   IF InStr ( C_OneCharSymbols , L_Ch ) >= 1 THEN
      G_PAfterEnd = G_PAfterEnd + 1
      NEXTxxx     = prSymbol
      EXIT FUNCTION
   ELSE

   '----- 3.3. case:   quote "
   IF L_Ch = """" THEN
      '----- Buffer  :  Other...  CRLF  Other...   " Quotes beeing processed "
      '----- Pointers:                     G_PBegin^                          ^G_PAfterEnd
      DO   ' search end quote, skipping double quotes
         G_PAfterEnd = G_PAfterEnd + 1
         IF I_BuffPLast < G_PAfterEnd            THEN  NEXTxxx = prEndQuoteMissing  :  EXIT FUNCTION  :  END IF
         L_Ch = Mid ( G_StrParseMe , G_PAfterEnd , 1 )
         IF (L_Ch = Chr(10)) or (L_Ch = Chr(13)) THEN  NEXTxxx = prEndQuoteMissing  :  EXIT FUNCTION  :  END IF
         IF L_Ch = """" THEN
            G_PAfterEnd = G_PAfterEnd + 1
            IF I_BuffPLast < G_PAfterEnd THEN  NEXTxxx = prQuotedText  :  EXIT FUNCTION  :  END IF
            NEXTxxx = prQuotedText
            EXIT FUNCTION
         END IF
      LOOP UNTIL False
   ELSE

   '----- 3.5. case:   normal token
   '--BEGIN--
      '----- Buffer   :  Other...  CRLF  Other...   TokenBeeingSearched
      '----- Pointers :                     G_PBegin^                  ^G_PAfterEnd
      DO
         G_PAfterEnd = G_PAfterEnd + 1
         IF I_BuffPLast < G_PAfterEnd THEN EXIT DO
         L_Ch = Mid ( G_StrParseMe , G_PAfterEnd , 1 )
         IF InStr ( C_CharsEndingToken , L_Ch ) >= 1 THEN EXIT DO
      LOOP UNTIL (L_Ch = " ") or (L_Ch = Chr(9)) or (L_Ch = Chr(10)) or (L_Ch = Chr(13))
      NEXTxxx = prToken
      EXIT FUNCTION
   '--END--
   END IF
   END IF
   END IF
END FUNCTION

'
'------------------------------------------------------------------------------
' This file toolbox  ( bis )
'------------------------------------------------------------------------------
'
'
'---------------
' ProcessBuffer_Same
' ProcessBuffer_Verbose
' ProcessBuffer_Parse
' ProcessBuffer_NoComment
' ProcessBuffer_Compact
' ProcessBuffer_PackLine
'---------------
'
'===== ProcessBuffer_Same

SUB   ProcessBuffer_Same   ( I_BufFirst , I_BufLast )
   DIM  L_Ptr
   DIM  L_PAfterEnd
   DIM  L_prResult

   DIM  L_Ch

   IF IsNull(I_BufLast) or IsNull(I_BufFirst) THEN
      EXIT SUB
   END IF

   L_PAfterEnd = I_BufFirst

   '----- LOOP 1 , Call parser
   DO

      L_Ptr = L_PAfterEnd

      L_Ch = Mid ( G_StrParseMe , L_Ptr , 1 )

      '----- LOOP 2.1 , OUTPUT : Filling
      WHILE (L_Ch = " ") or (L_Ch = Chr(9)) or (L_Ch = Chr(10)) or (L_Ch = Chr(13))
         Response.Write (   L_Ch   )
         L_Ptr = L_Ptr + 1
         IF I_BufLast < L_Ptr THEN EXIT SUB
         L_Ch = Mid ( G_StrParseMe , L_Ptr , 1 )
      WEND
'DEBUG:Response.Write (   "DEBUG.1:"  &  L_prResult  &  ":"  &  L_Ptr  &  "-->"  &  L_PAfterEnd  &  vbCRLF   )
'EXIT SUB

      '----- PARSER , Get "next token"
      L_prResult = NEXTxxx ( I_BufLast , L_Ptr , L_PAfterEnd )  :  L_Ptr=G_PBegin  :  L_PAfterEnd=G_PAfterEnd

      IF    (L_prResult = prToken) or (L_prResult = prSymbol) or (L_prResult = prSymbol2Ch) or (L_prResult = prQuotedText) or (L_prResult = prIllegalToken)  _
         or (L_prResult = prLineComment) or (L_prResult = prComment)  _
      THEN
         '----- LOOP 2. , OUTPUT : Token, Symbol,... as found
         WHILE L_Ptr < L_PAfterEnd
            L_Ch = Mid ( G_StrParseMe , L_Ptr , 1 )
            Response.Write (   L_Ch   )
            L_Ptr = L_Ptr + 1
         WEND
      END IF

   LOOP UNTIL L_Ptr > I_BufLast
END SUB

'===== ProcessBuffer_Verbose

SUB   ProcessBuffer_Verbose   ( I_BufFirst , I_BufLast )
   DIM  L_Ptr
   DIM  L_PAfterEnd
   DIM  L_prResult

   DIM  L_Ch

   DIM  L_TmpStr

   IF IsNull(I_BufLast) or IsNull(I_BufFirst) THEN
      EXIT SUB
   END IF

   L_PAfterEnd = I_BufFirst

   '----- LOOP 1 , Call parser
   DO

      L_Ptr = L_PAfterEnd

      '----- PARSER , Get "next token"
      L_prResult = NEXTxxx ( I_BufLast , L_Ptr , L_PAfterEnd )  :  L_Ptr=G_PBegin  :  L_PAfterEnd=G_PAfterEnd

      IF TRUE THEN
         '----- LOOP 2. , OUTPUT : Token, Symbol,... as found
         WHILE L_Ptr < L_PAfterEnd
            L_Ch = Mid ( G_StrParseMe , L_Ptr , 1 )
            Response.Write (   L_Ch   )
            L_Ptr = L_Ptr + 1
         WEND

         '----- OUTPUT : Token type
         L_TmpStr = C_ParserResultStr(L_prResult-1)
         WHILE Len(L_TmpStr) < 11  :  L_TmpStr = " "  &  L_TmpStr  :  WEND
         IF Len(L_TmpStr) > 11 THEN L_TmpStr = Mid ( L_TmpStr , 1 , 11 )
         Response.Write (   "   ' "  &  L_TmpStr   )

         Response.Write (   vbCRLF   )
      END IF

   LOOP UNTIL L_Ptr > I_BufLast
END SUB

'===== ProcessBuffer_Parse

SUB   ProcessBuffer_Parse   ( I_BufFirst , I_BufLast )
   DIM  L_Ptr
   DIM  L_PAfterEnd
   DIM  L_prResult

   DIM  L_Ch

   IF IsNull(I_BufLast) or IsNull(I_BufFirst) THEN
      EXIT SUB
   END IF

   L_PAfterEnd = I_BufFirst

   '----- LOOP 1 , Call parser
   DO

      L_Ptr = L_PAfterEnd

      '----- PARSER , Get "next token"
      L_prResult = NEXTxxx ( I_BufLast , L_Ptr , L_PAfterEnd )  :  L_Ptr=G_PBegin  :  L_PAfterEnd=G_PAfterEnd

      IF    (L_prResult = prToken) or (L_prResult = prSymbol) or (L_prResult = prSymbol2Ch) or (L_prResult = prQuotedText) or (L_prResult = prIllegalToken)  _
         or (L_prResult = prLineComment) or (L_prResult = prComment)  _
      THEN
         '----- LOOP 2. , OUTPUT : Token, Symbol,... as found
         WHILE L_Ptr < L_PAfterEnd
            L_Ch = Mid ( G_StrParseMe , L_Ptr , 1 )
            Response.Write (   L_Ch   )
            L_Ptr = L_Ptr + 1
         WEND

         Response.Write (   vbCRLF   )
      END IF

   LOOP UNTIL L_Ptr > I_BufLast
END SUB

'===== ProcessBuffer_NoComment

SUB   ProcessBuffer_NoComment   ( I_BufFirst , I_BufLast )
   DIM  L_Ptr
   DIM  L_PAfterEnd
   DIM  L_prResult

   DIM  L_Ch

   IF IsNull(I_BufLast) or IsNull(I_BufFirst) THEN
      EXIT SUB
   END IF

   L_PAfterEnd = I_BufFirst

   '----- LOOP 1 , Call parser
   DO

      L_Ptr = L_PAfterEnd

      '----- PARSER , Get "next token"
      L_prResult = NEXTxxx ( I_BufLast , L_Ptr , L_PAfterEnd )  :  L_Ptr=G_PBegin  :  L_PAfterEnd=G_PAfterEnd

      IF (L_prResult = prToken) or (L_prResult = prSymbol) or (L_prResult = prSymbol2Ch) or (L_prResult = prQuotedText) or (L_prResult = prIllegalToken) THEN
         '----- LOOP 2. , OUTPUT : Token, Symbol,... as found
         WHILE L_Ptr < L_PAfterEnd
            L_Ch = Mid ( G_StrParseMe , L_Ptr , 1 )
            Response.Write (   L_Ch   )
            L_Ptr = L_Ptr + 1
         WEND

         Response.Write (   vbCRLF   )
      END IF

   LOOP UNTIL L_Ptr > I_BufLast
END SUB

'===== ProcessBuffer_Compact

   DIM  G_TmpBuf_LineCompacted
   DIM  G_PREV_prResult

SUB   ProcessBuffer_Compact   ( I_BufFirst , I_BufLast )
   DIM  L_Ptr
   DIM  L_PAfterEnd
   DIM  L_prResult

   DIM  L_String0
   DIM  L_TokenLen
   DIM  L_String1

   IF IsNull(I_BufLast) or IsNull(I_BufFirst) THEN
      IF IsNull(I_BufFirst) = False THEN   ' Before Process
         G_TmpBuf_LineCompacted = ""
         G_PREV_prResult        = prFilling
      ELSE   ' After Process
         IF G_TmpBuf_LineCompacted <> "" THEN
            Response.Write (   G_TmpBuf_LineCompacted  &  vbCRLF   )
         END IF
      END IF
      EXIT SUB
   END IF

   L_PAfterEnd = I_BufFirst

   '----- LOOP 1 , Call parser
   DO

      L_Ptr = L_PAfterEnd

      '----- PARSER , Get "next token"
      L_prResult = NEXTxxx ( I_BufLast , L_Ptr , L_PAfterEnd )  :  L_Ptr=G_PBegin  :  L_PAfterEnd=G_PAfterEnd

      IF (L_prResult = prToken) or (L_prResult = prSymbol) or (L_prResult = prSymbol2Ch) or (L_prResult = prQuotedText) or (L_prResult = prIllegalToken) THEN
         '----- Put a space between 2 tokens ?
         IF (G_PREV_prResult = prToken) and (L_prResult = prToken) THEN
            L_String0 = " "
         ELSE
            L_String0 = ""
         END IF

         '----- CONTROL : Current token too long ?
         L_TokenLen = L_PAfterEnd - L_Ptr
         IF L_TokenLen > 126 THEN
            '----- OUTPUT : Previous temp buffer
            Response.Write (   G_TmpBuf_LineCompacted  &  vbCRLF   )
            G_TmpBuf_LineCompacted = ""

            '----- OUTPUT : Current token
            L_String1 = Mid ( G_StrParseMe , L_Ptr , 126 )
            Response.Write (   L_String1  &  vbCRLF   )

            '----- OUTPUT : Error message
            Response.Write (   "ERROR: "  &  "Token too long."  &  vbCRLF   )
            EXIT SUB '--throw ( 1 );--
         END IF

         '----- Copy current token ==> TmpString
         L_String1 = Mid ( G_StrParseMe , L_Ptr , L_TokenLen )

         '----- "Temp line buffer" would be full ?
         IF ( Len(G_TmpBuf_LineCompacted) + Len(L_String0) + Len(L_String1) ) > 79 THEN
            '----- OUTPUT : Previous temp buffer
            Response.Write (   G_TmpBuf_LineCompacted  &  vbCRLF   )
            G_TmpBuf_LineCompacted = ""
            L_String0              = ""   ' Token sent to next line
         END IF

         '----- Temp line buffer : add "token"
         G_TmpBuf_LineCompacted = G_TmpBuf_LineCompacted  &  L_String0  &  L_String1

         G_PREV_prResult = L_prResult
      END IF

   LOOP UNTIL L_Ptr > I_BufLast
END SUB

'===== ProcessBuffer_PackLine

SUB   ProcessBuffer_PackLine   ( I_BufFirst , I_BufLast )
   DIM  L_Ptr
   DIM  L_PAfterEnd
   DIM  L_prResult

   DIM  L_Ch

   DIM  L_NewLineQ

   DIM  L_String0
   DIM  L_TokenLen
   DIM  L_String1

   IF IsNull(I_BufLast) or IsNull(I_BufFirst) THEN
      IF IsNull(I_BufFirst) = False THEN   ' Before Process
         G_TmpBuf_LineCompacted = ""
         G_PREV_prResult        = prFilling
      ELSE   ' After Process
         IF G_TmpBuf_LineCompacted <> "" THEN
            Response.Write (   G_TmpBuf_LineCompacted  &  vbCRLF   )
         END IF
      END IF
      EXIT SUB
   END IF

   L_PAfterEnd = I_BufFirst

   '----- LOOP 1 , Call parser
   DO

      L_Ptr = L_PAfterEnd

      L_Ch = Mid ( G_StrParseMe , L_Ptr , 1 )

      '----- LOOP 2.1 , Skip filling
      DO WHILE (L_Ch = " ") or (L_Ch = Chr(9))
         L_Ptr = L_Ptr + 1
         IF I_BufLast < L_Ptr THEN EXIT DO
         L_Ch = Mid ( G_StrParseMe , L_Ptr , 1 )
      LOOP

      '----- Check NewLine
      IF L_Ch = Chr(10) THEN
         L_Ptr = L_Ptr + 1
         L_NewLineQ = TRUE
      ELSE
         IF L_Ch = Chr(13) THEN
            L_Ptr = L_Ptr + 1
            IF L_Ptr <= I_BufLast THEN
               L_Ch = Mid ( G_StrParseMe , L_Ptr , 1 )
               IF L_Ch = Chr(10) THEN
                  L_Ptr = L_Ptr + 1
               END IF
            END IF
            L_NewLineQ = TRUE
         ELSE
            L_NewLineQ = False
         END IF
      END IF
      IF L_NewLineQ = TRUE THEN
         '----- OUTPUT : temp line buffer
         IF G_TmpBuf_LineCompacted <> "" THEN
            Response.Write (   G_TmpBuf_LineCompacted  &  vbCRLF   )
            G_TmpBuf_LineCompacted = ""
            G_PREV_prResult        = prFilling
         END IF
      END IF
      IF I_BufLast < L_Ptr THEN EXIT DO

      '----- PARSER , Get "next token"
      L_prResult = NEXTxxx ( I_BufLast , L_Ptr , L_PAfterEnd )  :  L_Ptr=G_PBegin  :  L_PAfterEnd=G_PAfterEnd

      IF (L_prResult = prToken) or (L_prResult = prSymbol) or (L_prResult = prSymbol2Ch) or (L_prResult = prQuotedText) or (L_prResult = prIllegalToken) THEN
         '----- Put a space between 2 tokens ?
         IF (G_PREV_prResult = prToken) and (L_prResult = prToken) THEN
            L_String0 = " "
         ELSE
            L_String0 = ""
         END IF

         '----- CONTROL : Current token too long ?
         L_TokenLen = L_PAfterEnd - L_Ptr
         IF L_TokenLen > 126 THEN
            '----- OUTPUT : Previous temp buffer
            Response.Write (   G_TmpBuf_LineCompacted  &  vbCRLF   )
            G_TmpBuf_LineCompacted = ""

            '----- OUTPUT : Current token
            L_String1 = Mid ( G_StrParseMe , L_Ptr , 126 )
            Response.Write (   L_String1  &  vbCRLF   )

            '----- OUTPUT : Error message
            Response.Write (   "ERROR: "  &  "Token too long."  &  vbCRLF   )
            EXIT SUB '--throw ( 1 );--
         END IF

         '----- Copy current token ==> TmpString
         L_String1 = Mid ( G_StrParseMe , L_Ptr , L_TokenLen )

         '----- "Temp line buffer" would be full ?
         IF ( Len(G_TmpBuf_LineCompacted) + Len(L_String0) + Len(L_String1) ) > 126 THEN
            '----- OUTPUT : Previous temp buffer
            Response.Write (   G_TmpBuf_LineCompacted  &  vbCRLF   )
            G_TmpBuf_LineCompacted = ""

            '----- OUTPUT : Current token
            Response.Write (   L_String1  &  vbCRLF   )

            '----- OUTPUT : Error message
            Response.Write (   "ERROR: "  &  "Line too long."  &  vbCRLF   )
            EXIT SUB '--throw ( 1 );--
         END IF

         '----- Temp line buffer : add "token"
         G_TmpBuf_LineCompacted = G_TmpBuf_LineCompacted  &  L_String0  &  L_String1

         G_PREV_prResult = L_prResult
      END IF

   LOOP UNTIL L_Ptr > I_BufLast
END SUB

'
'------------------------------------------------------------------------------
' This file routines
'------------------------------------------------------------------------------
'
'
'---------------
' ProcessBuffer
'---------------
'
   CONST  pmSame      = 0
   CONST  pmVerbose   = 1
   CONST  pmParse     = 2
   CONST  pmNoComment = 3
   CONST  pmCompact   = 4
   CONST  pmPackLine  = 5

   DIM  G_ParseMode

'===== ProcessBuffer

SUB   ProcessBuffer   ( I_BufFirst , I_BufLast )
   SELECT CASE G_ParseMode
      CASE pmSame       :  ProcessBuffer_Same        I_BufFirst , I_BufLast
      CASE pmVerbose    :  ProcessBuffer_Verbose     I_BufFirst , I_BufLast
      CASE pmParse      :  ProcessBuffer_Parse       I_BufFirst , I_BufLast
      CASE pmNoComment  :  ProcessBuffer_NoComment   I_BufFirst , I_BufLast
      CASE pmCompact    :  ProcessBuffer_Compact     I_BufFirst , I_BufLast
      CASE pmPackLine   :  ProcessBuffer_PackLine    I_BufFirst , I_BufLast
   END SELECT

'--
'--   IF IsNull(I_BufLast) or IsNull(I_BufFirst) THEN
'--      IF IsNull(I_BufFirst) = False THEN
'--         Response.Write (   "***** Begin"  &  vbCRLF   )      '--- Before Process
'--      ELSE
'--         Response.Write (   "***** End"  &  vbCRLF     )      '--- After Process
'--      END IF
'--      EXIT SUB
'--   END IF
'--
'--   '----- Input ==> Output, char by char
'--   L_Ptr = I_BufFirst
'--   WHILE L_Ptr <= I_BufLast
'--      L_Ch = Mid ( G_StrParseMe , L_Ptr , 1 )
'--      Response.Write (   L_Ch   )
'--      L_Ptr = L_Ptr + 1
'--   WEND
'--
END SUB


'===============


   DIM  G_Time1
   DIM  G_Time2

   IF GI_TextArea1 <> "" THEN
      G_StrParseMe = GI_TextArea1

      '----- OPTIONAL : Parameter 2
      G_ParseMode = pmVerbose
      IF GI_ParseMode = "/Same"      THEN G_ParseMode = pmSame
      IF GI_ParseMode = "/Verbose"   THEN G_ParseMode = pmVerbose
      IF GI_ParseMode = "/Parse"     THEN G_ParseMode = pmParse
      IF GI_ParseMode = "/NoComment" THEN G_ParseMode = pmNoComment
      IF GI_ParseMode = "/Compact"   THEN G_ParseMode = pmCompact
      IF GI_ParseMode = "/PackLine"  THEN G_ParseMode = pmPackLine

      Response.Write (   "<BR>"  &  vbCRLF   )
      Response.Write (   "<XMP>"  &  "***** OUTPUT"  &  vbCRLF   )
      G_Time1 = Now
      ProcessBuffer   1 , Null      '--- Before Process
      ProcessBuffer   1 , Len(G_StrParseMe)
      ProcessBuffer   Null , Null      '--- After Process
      G_Time2 = Now
      Response.Write (   "*****  "  &  ((G_Time2-G_Time1)*(24*60*60*1000))  &  "  milliseconds"  &  vbCRLF   )
      Response.Write (   "</XMP>"  &  vbCRLF   )
   END IF
%>
