dxjs_scanner.old

Well known and usefull component for delphi 7

////////////////////////////////////////////////////////////////////////////
//    Component: TDXJavaScript
//       Author: Alexander Baranovsky ([e-mail])
// ========================================================================
// Source Owner: DX, Inc. 2002
//    Copyright: All code is the property of DX, Inc. Licensed for
//               resell by Brain Patchwork DX (tm) and part of the
//               DX (r) product lines, which are (c) 1999-2002
//               DX, Inc. Source may not be distributed without
//               written permission from both Brain Patchwork DX,
//               and DX, Inc.
//      License: (Reminder), None of this code can be added to other
//               developer products without permission. This includes
//               but not limited to DCU's, DCP's, DLL's, OCX's, or
//               any other form of merging our technologies. All of
//               your products released to a public consumer be it
//               shareware, freeware, commercial, etc. must contain a
//               license notification somewhere visible in the
//               application.
// Code Version: 1.2
// ========================================================================
//  Description:
// ========================================================================
////////////////////////////////////////////////////////////////////////////

unit DXJS_SCANNER;
interface
{$I DXJavaScript.def}

uses
   Classes,
   DXJS_SHARE;

type
   TScanner=class
      JScript:Pointer;
      Buff:string;
      P,LineNumber,PosNumber:Integer;
      fCurrentLine:string;

      constructor Create (AJScript:Pointer) ;
      destructor Destroy;override;
      function GetNextChar:Char;
      class function IsEOF (c:Char) :boolean;
      class function IsApostrophe (c:Char) :boolean;
      class function IsDoubleApostrophe (c:Char) :boolean;
      class function IsAlpha (c:Char) :boolean;
      class function IsDigit (c:Char) :boolean;
      class function IsHexDigit (c:Char) :boolean;
      class function IsWhite (c:Char) :boolean;
      function LA (N:Integer) :Char;
      function GetToken (var Token:TToken) :boolean;
      function GetNextToken (var Token:TToken) :boolean;
      function GetText (Pos1,Pos2:Integer) :string;
      function GetRegExpBody:string;
   end;

implementation

uses
   SysUtils,// DecimalSeparator
   DXString,
   DXJS_MAIN;

function ReadName (const S:string;var P:Integer) :string;
begin
   result:='';
   while TScanner.IsAlpha (S[P]) or TScanner.IsDigit (S[P]) do begin
      result:=result+S[P];
      Inc (P) ;
   end;
end;

constructor TScanner.Create (AJScript:Pointer) ;
begin
   JScript:=AJScript;
   Buff:='';

   fCurrentLine:='';
   P:=0;
end;

destructor TScanner.Destroy;
begin
   inherited;
end;

function TScanner.GetNextChar:Char;
begin
   Inc (P) ;
   result:=Buff[P];
   Inc (PosNumber) ;
end;

class function TScanner.IsEOF (c:Char) :boolean;
begin
   result:=c=#255;
end;

class function TScanner.IsApostrophe (c:Char) :boolean;
begin
   result:=c='''';
end;

class function TScanner.IsDoubleApostrophe (c:Char) :boolean;
begin
   result:=c='"';
end;

class function TScanner.IsAlpha (c:Char) :boolean;
begin
   result:=c in ['A'..'Z','a'..'z','_','$'];
end;

class function TScanner.IsDigit (c:Char) :boolean;
begin
   result:=c in ['0'..'9'];
end;

class function TScanner.IsHexDigit (c:Char) :boolean;
begin
   result:=c in ['0'..'9','A'..'F','a'..'f'];
end;

class function TScanner.IsWhite (c:Char) :boolean;
begin
   result:=c in [#8,#9,#10,#13,#32];
end;

function TScanner.LA (N:Integer) :Char;
begin
   result:=Buff[P+N];
end;

function TScanner.GetToken (var Token:TToken) :boolean;
label
   NextComment,Number;
var
   S:string;
   I,J:Integer;
   c:Char;
   ShString:ShortString;
begin
   Token.ID:=0;

   result:=true;

   repeat
      c:=GetNextChar;
      Token.Pos:=P;

      if IsEOF (c) then begin
         result:=false;
         Token.Text:='EOF';
         Token.AClass:=classOPER;
         Token.ID:=OP_EOF;
         Exit;
      end
      else if IsWhite (c) then begin
         if c in [#10,#13] then begin
            Inc (LineNumber) ;
            Inc (TJScript (JScript) .LineCount) ;
            PosNumber:=-1;

            if c=#13 then GetNextChar;

            I:=1;
            while not (Buff[P+I]in [#13,#10,#255]) do Inc (I) ;
            if I>255 then I:=255;
            Move (Buff[P+1],ShString[1],I-1) ;
            ShString[0]:=Chr (I-1) ;
            fCurrentLine:=ShString;

            Token.ID:=BOUND_LINES-LineNumber;
            Token.Text:=fCurrentLine;
            Token.AClass:=classSEPARATOR;
            Exit;
         end;
      end
      else if c='?' then begin
         Token.ID:=OP_COND;
         Token.AClass:=classOPER;
         Token.Text:=c;
         Exit;
      end
      else if c='~' then begin
         Token.ID:=OP_BITWISE_NOT;
         Token.AClass:=classOPER;
         Token.Text:=c;
         Exit;
      end
      else if c='<' then begin
         Token.ID:=OP_LT;
         Token.AClass:=classOPER;
         Token.Text:=c;

         if LA (1) ='<' then begin
            c:=GetNextChar;
            Token.ID:=OP_BITWISE_LEFT_SHIFT;
            Token.AClass:=classOPER;
            Token.Text:=Token.Text+c;

            if LA (1) ='=' then begin
               c:=GetNextChar;
               Token.ID:=OP_ASSIGN_BITWISE_LEFT_SHIFT;
               Token.AClass:=classOPER;
               Token.Text:=Token.Text+c;
            end;
         end
         else if LA (1) ='=' then begin
            c:=GetNextChar;
            Token.ID:=OP_LE;
            Token.AClass:=classOPER;
            Token.Text:=Token.Text+c;
         end;

         Exit;
      end
      else if c='>' then begin
         Token.ID:=OP_GT;
         Token.AClass:=classOPER;
         Token.Text:=c;

         if LA (1) ='>' then begin
            c:=GetNextChar;
            Token.ID:=OP_BITWISE_RIGHT_SHIFT;
            Token.AClass:=classOPER;
            Token.Text:=Token.Text+c;

            if LA (1) ='=' then begin
               c:=GetNextChar;
               Token.ID:=OP_ASSIGN_BITWISE_RIGHT_SHIFT;
               Token.AClass:=classOPER;
               Token.Text:=Token.Text+c;
            end
            else if LA (1) ='>' then begin
               c:=GetNextChar;
               Token.ID:=OP_BITWISE_UNSIGNED_RIGHT_SHIFT;
               Token.AClass:=classOPER;
               Token.Text:=Token.Text+c;

               if LA (1) ='=' then begin
                  c:=GetNextChar;
                  Token.ID:=OP_ASSIGN_BITWISE_UNSIGNED_RIGHT_SHIFT;
                  Token.AClass:=classOPER;
                  Token.Text:=Token.Text+c;
               end;
            end;
         end
         else if LA (1) ='=' then begin
            c:=GetNextChar;
            Token.ID:=OP_GE;
            Token.AClass:=classOPER;
            Token.Text:=Token.Text+c;
         end;

         Exit;
      end
      else if c='^' then begin
         Token.ID:=OP_BITWISE_XOR;
         Token.AClass:=classOPER;
         Token.Text:=c;

         if LA (1) ='=' then begin
            c:=GetNextChar;
            Token.ID:=OP_ASSIGN_BITWISE_XOR;
            Token.AClass:=classOPER;
            Token.Text:=Token.Text+c;
         end;

         Exit;
      end
      else if c='%' then begin
         Token.ID:=OP_MOD;
         Token.AClass:=classOPER;
         Token.Text:=c;

         if LA (1) ='=' then begin
            c:=GetNextChar;
            Token.ID:=OP_ASSIGN_MOD;
            Token.AClass:=classOPER;
            Token.Text:=Token.Text+c;
         end;

         Exit;
      end
      else if c='+' then begin
         Token.ID:=OP_PLUS;
         Token.AClass:=classOPER;
         Token.Text:=c;

         if LA (1) ='=' then begin
            c:=GetNextChar;
            Token.ID:=OP_ASSIGN_PLUS;
            Token.AClass:=classOPER;
            Token.Text:=Token.Text+c;
         end
         else if LA (1) ='+' then begin
            c:=GetNextChar;
            Token.ID:=OP_INC;
            Token.AClass:=classOPER;
            Token.Text:=Token.Text+c;
         end;

         Exit;
      end
      else if c='-' then begin
         Token.ID:=OP_MINUS;
         Token.AClass:=classOPER;
         Token.Text:=c;

         if LA (1) ='=' then begin
            c:=GetNextChar;
            Token.ID:=OP_ASSIGN_MINUS;
            Token.AClass:=classOPER;
            Token.Text:=Token.Text+c;
         end
         else if LA (1) ='-' then begin
            c:=GetNextChar;
            Token.ID:=OP_DEC;
            Token.AClass:=classOPER;
            Token.Text:=Token.Text+c;
         end;

         Exit;
      end
      else if c='*' then begin
         Token.ID:=OP_MULT;
         Token.AClass:=classOPER;
         Token.Text:=c;

         if LA (1) ='=' then begin
            c:=GetNextChar;
            Token.ID:=OP_ASSIGN_MULT;
            Token.AClass:=classOPER;
            Token.Text:=Token.Text+c;
         end;

         Exit;
      end
      else if c='/' then begin
         if LA (1) ='*' then begin
            repeat
               c:=GetNextChar;
               if c in [#10,#13] then begin
                  Inc (LineNumber) ;
                  Inc (TJScript (JScript) .LineCount) ;
                  PosNumber:=-1;
                  if c=#13 then GetNextChar;
               end;
            until IsEOF (c) or ((c='*') and (LA (1) ='/') ) ;
            GetNextChar;
            Continue;
         end;

         if LA (1) ='/' then begin
            repeat
               GetNextChar;
            until LA (1) in [#13,#10];
            Continue;
         end;

         Token.ID:=OP_DIV;
         Token.AClass:=classOPER;
         Token.Text:=c;

         if LA (1) ='=' then begin
            c:=GetNextChar;
            Token.ID:=OP_ASSIGN_DIV;
            Token.AClass:=classOPER;
            Token.Text:=Token.Text+c;
         end;

         Exit;
      end
      else if c='&' then begin
         Token.ID:=OP_BITWISE_AND;
         Token.AClass:=classOPER;
         Token.Text:=c;

         if LA (1) ='=' then begin
            c:=GetNextChar;
            Token.ID:=OP_ASSIGN_BITWISE_AND;
            Token.AClass:=classOPER;
            Token.Text:=Token.Text+c;
         end
         else if LA (1) ='&' then begin
            c:=GetNextChar;
            Token.ID:=OP_LOGICAL_AND;
            Token.AClass:=classOPER;
            Token.Text:=Token.Text+c;