dxjs_scanner.pas

Well known and usefull component for delphi 7

////////////////////////////////////////////////////////////////////////////
//    Component: TDXJavaScript
//       Author: Alexander Baranovsky ([e-mail])
//               G.E. Ozz Nixon Jr. ([e-mail])
// ========================================================================
// Source Owner: DX, Inc. 2002, 2004
//    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: (3rd Generation)
// ========================================================================
//  Description: JavaScript Tokenizer Routines
// ========================================================================
////////////////////////////////////////////////////////////////////////////

unit DXJS_SCANNER;
interface
{$I DXJavaScript.def}

uses
   Classes,
   DXJS_SHARE;

type
   TScanner=class
      JScript:Pointer;
      Buff:string;
      P,LineNumber,PosNumber:Integer;
      fCurrentLine:string;
      BuffToken: TToken; // Sept 2003
      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:='';
   FillChar2(BuffToken, SizeOf(BuffToken), #0); // Sept 2003
   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; // Sept 2003
begin
   if BuffToken.Text <> '' then result := BuffToken.Text[N]
   Else result:=Buff[P+N];
end;

function TScanner.GetToken (var Token:TToken) :boolean; // sept 2003
label
   NextComment,Number;
var
   S:string;
   I,J:Integer;
   c:Char;
   tmpc:Char;
   ShString:ShortString;
begin
   result:=true;
   if BuffToken.Text <> '' then begin
     Token := BuffToken;
     BuffToken.Text := '';
     Exit;
   end;
   Token.ID:=0;
   repeat
      c:=GetNextChar;
      Token.Pos:=P;
      Case C of
         #255:Begin
            result:=false;
            Token.Text:='EOF';
            Token.AClass:=classOPER;
            Token.ID:=OP_EOF;
            Exit;
         end;
         #8,#9,#10,#13,#32: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;
               FastMove (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;
         '?':Begin
            Token.ID:=OP_COND;
            Token.AClass:=classOPER;
            Token.Text:=c;
            Exit;
         end;
         '~':Begin
            Token.ID:=OP_BITWISE_NOT;
            Token.AClass:=classOPER;
            Token.Text:=c;
            Exit;
         end;
         '<':Begin
            Token.ID:=OP_LT;
            Token.AClass:=classOPER;
            Token.Text:=c;
            tmpc:=LA (1);
            case tmpc of
               '<':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;
               '=':Begin
                  c:=GetNextChar;
                  Token.ID:=OP_LE;
                  Token.AClass:=classOPER;
                  Token.Text:=Token.Text+c;
               end;
            end;
            Exit;
         end;
         '>':Begin
            Token.ID:=OP_GT;
            Token.AClass:=classOPER;
            Token.Text:=c;
            tmpc:=LA (1);
            Case tmpC of
               '>':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;
               '=':Begin
                  c:=GetNextChar;
                  Token.ID:=OP_GE;
                  Token.AClass:=classOPER;
                  Token.Text:=Token.Text+c;
               end;
            end;
            Exit;
         end;
         '^':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;
         '%':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;
         '+':Begin
            Token.ID:=OP_PLUS;
            Token.AClass:=classOPER;
            Token.Text:=c;
            tmpc:=LA (1);
            Case tmpc of
               '=':Begin
                  c:=GetNextChar;
                  Token.ID:=OP_ASSIGN_PLUS;
                  Token.AClass:=classOPER;
                  Token.Text:=Token.Text+c;
               end;
               '+':Begin
                  c:=GetNextChar;
                  Token.ID:=OP_INC;
                  Token.AClass:=classOPER;
                  Token.Text:=Token.Text+c;
               end;
            end;
            Exit;
         end;
         '-':Begin
            Token.ID:=OP_MINUS;
            Token.AClass:=classOPER;
            Token.Text:=c;
            tmpC:=LA (1);
            Case tmpC of
               '=':Begin
                  c:=GetNextChar;
                  Token.ID:=OP_ASSIGN_MINUS;
                  Token.AClass:=classOPER;
                  Token.Text:=Token.Text+c;
               end;
               '-':Begin
                  c:=GetNextChar;
                  Token.ID:=OP_DEC;
                  Token.AClass:=classOPER;
                  Token.Text:=Token.Text+c;
               end;
            end;
            Exit;
         end;
         '*':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;
         '/':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;
         '&':Begin
            Token.ID:=OP_BITWISE_AND;
            Token.AClass:=classOPER;
            Token.Text:=c;