fs_iparser.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

{******************************************}
{                                          }
{             FastScript v1.8              }
{                  Parser                  }
{                                          }
{  (c) 2003-2005 by Alexander Tzyganenko,  }
{             Fast Reports Inc             }
{                                          }
{******************************************}

unit fs_iparser;

interface

{$i fs.inc}

uses
  SysUtils, Classes, Windows;


type
  TfsIdentifierCharset = set of Char;

  { TfsParser parser the source text and return such elements as identifiers,
    keywords, punctuation, strings and numbers. }

  TfsParser = class(TObject)
  private
    FCommentBlock1: String;
    FCommentBlock11: String;
    FCommentBlock12: String;
    FCommentBlock2: String;
    FCommentBlock21: String;
    FCommentBlock22: String;
    FCommentLine1: String;
    FCommentLine2: String;
    FHexSequence: String;
    FIdentifierCharset: TfsIdentifierCharset;
    FKeywords: TStrings;
    FLastPosition: Integer;
    FPosition: Integer;
    FSize: Integer;
    FSkipChar: String;
    FSkipEOL: Boolean;
    FSkipSpace: Boolean;
    FStringQuotes: String;
    FText: String;
    FYList: TList;
    function DoDigitSequence: Boolean;
    function DoHexDigitSequence: Boolean;
    function DoScaleFactor: Boolean;
    function DoUnsignedInteger: Boolean;
    function DoUnsignedReal: Boolean;
    procedure SetPosition(const Value: Integer);
    procedure SetText(const Value: String);
    function Ident: String;
    procedure SetCommentBlock1(const Value: String);
    procedure SetCommentBlock2(const Value: String);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    procedure ConstructCharset(const s: String);

    { skip all #0..#31 symbols }
    procedure SkipSpaces;
    { get EOL symbol }
    function GetEOL: Boolean;
    { get any valid ident except keyword }
    function GetIdent: String;
    { get any valid punctuation symbol like ,.;: }
    function GetChar: String;
    { get any valid ident or keyword }
    function GetWord: String;
    { get valid hex/int/float number }
    function GetNumber: String;
    { get valid quoted/control string like 'It''s'#13#10'working' }
    function GetString: String;
    { get FR-specific string - variable or db field like [main data."field 1"] }
    function GetFRString: String;
    { get Y:X position }
    function GetXYPosition: String;
    { get plain position from X:Y }
    function GetPlainPosition(pt: TPoint): Integer;
    { is this keyword? }
    function IsKeyWord(const s: String): Boolean;

    // Language-dependent elements
    // For Pascal:
    // CommentLine1 := '//';
    // CommentBlock1 := '{,}';
    // CommentBlock2 := '(*,*)';
    // HexSequence := '$'
    // IdentifierCharset := ['_', '0'..'9', 'a'..'z', 'A'..'Z'];
    // Keywords: 'begin','end', ...
    // StringQuotes := ''''
    property CommentBlock1: String read FCommentBlock1 write SetCommentBlock1;
    property CommentBlock2: String read FCommentBlock2 write SetCommentBlock2;
    property CommentLine1: String read FCommentLine1 write FCommentLine1;
    property CommentLine2: String read FCommentLine2 write FCommentLine2;
    property HexSequence: String read FHexSequence write FHexSequence;
    property IdentifierCharset: TfsIdentifierCharset read FIdentifierCharset
      write FIdentifierCharset;
    property Keywords: TStrings read FKeywords;
    property SkipChar: String read FSkipChar write FSkipChar;
    property SkipEOL: Boolean read FSkipEOL write FSkipEOL;
    property SkipSpace: Boolean read FSkipSpace write FSkipSpace;
    property StringQuotes: String read FStringQuotes write FStringQuotes;

    { Current position }
    property Position: Integer read FPosition write SetPosition;
    { Text to parse }
    property Text: String read FText write SetText;
  end;


implementation


{ TfsParser }

constructor TfsParser.Create;
begin
  FKeywords := TStringList.Create;
  TStringList(FKeywords).Sorted := True;
  FYList := TList.Create;
  Clear;
end;

destructor TfsParser.Destroy;
begin
  FKeywords.Free;
  FYList.Free;
  inherited;
end;

procedure TfsParser.Clear;
begin
  FKeywords.Clear;
  FCommentLine1 := '//';
  CommentBlock1 := '{,}';
  CommentBlock2 := '(*,*)';
  FHexSequence := '$';
  FIdentifierCharset := ['_', '0'..'9', 'a'..'z', 'A'..'Z'];
  FSkipChar := '';
  FSkipEOL := True;
  FStringQuotes := '''';
  FSkipSpace := True;
end;

procedure TfsParser.SetCommentBlock1(const Value: String);
var
  sl: TStringList;
begin
  FCommentBlock1 := Value;
  FCommentBlock11 := '';
  FCommentBlock12 := '';

  sl := TStringList.Create;
  sl.CommaText := FCommentBlock1;
  if sl.Count > 0 then
    FCommentBlock11 := sl[0];
  if sl.Count > 1 then
    FCommentBlock12 := sl[1];
  sl.Free;
end;

procedure TfsParser.SetCommentBlock2(const Value: String);
var
  sl: TStringList;
begin
  FCommentBlock2 := Value;
  FCommentBlock21 := '';
  FCommentBlock22 := '';

  sl := TStringList.Create;
  sl.CommaText := FCommentBlock2;
  if sl.Count > 0 then
    FCommentBlock21 := sl[0];
  if sl.Count > 1 then
    FCommentBlock22 := sl[1];
  sl.Free;
end;

procedure TfsParser.SetPosition(const Value: Integer);
begin
  FPosition := Value;
  FLastPosition := Value;
end;

procedure TfsParser.SetText(const Value: String);
var
  i: Integer;
begin
  FText := Value + #0;
  FLastPosition := 1;
  FPosition := 1;
  FSize := Length(Value);

  FYList.Clear;
  FYList.Add(TObject(0));
  for i := 1 to FSize do
    if FText[i] = #10 then
      FYList.Add(TObject(i));
end;

procedure TfsParser.ConstructCharset(const s: String);
var
  i: Integer;
begin
  FIdentifierCharset := [];
  for i := 1 to Length(s) do
    FIdentifierCharset := FIdentifierCharset + [s[i]];
end;

function TfsParser.GetEOL: Boolean;
begin
  SkipSpaces;
  if FText[FPosition] in [#10, #13] then
  begin
    Result := True;
    while FText[FPosition] in [#10, #13] do
      Inc(FPosition);
  end
  else
    Result := False;
end;

procedure TfsParser.SkipSpaces;
var
  s1, s2: String;
  Flag: Boolean;
  Spaces: set of Char;
begin
  Spaces := [#0..#32];
  if not FSkipEOL then
{$IFDEF LINUX}
    Spaces := Spaces - [#10];
{$ELSE}
    Spaces := Spaces - [#13];
{$ENDIF}
  while (FPosition <= FSize) and (FText[FPosition] in Spaces) do
    Inc(FPosition);
  { skip basic '_' }
  if (FPosition <= FSize) and (FSkipChar <> '') and (FText[FPosition] = FSkipChar[1]) then
  begin
    Inc(FPosition);
    GetEOL;
    SkipSpaces;
  end;

  if FPosition < FSize then
  begin
    if FCommentLine1 <> '' then
      s1 := Copy(FText, FPosition, Length(FCommentLine1)) else
      s1 := ' ';
    if FCommentLine2 <> '' then
      s2 := Copy(FText, FPosition, Length(FCommentLine2)) else
      s2 := ' ';

    if (s1 = FCommentLine1) or (s2 = FCommentLine2) then
    begin
      while (FPosition <= FSize) and (FText[FPosition] <> #10) do
        Inc(FPosition);
      SkipSpaces;
    end
    else
    begin
      Flag := False;

      if FCommentBlock1 <> '' then
      begin
        s1 := Copy(FText, FPosition, Length(FCommentBlock11));
        if s1 = FCommentBlock11 then
        begin
          Flag := True;
          s2 := FCommentBlock12;
        end;
      end;

      if not Flag and (FCommentBlock2 <> '') then
      begin
        s1 := Copy(FText, FPosition, Length(FCommentBlock21));
        if s1 = FCommentBlock21 then
        begin
          Flag := True;
          s2 := FCommentBlock22;
        end;
      end;

      if Flag then
      begin
        Inc(FPosition, Length(s2));
        while (FPosition <= FSize) and (Copy(FText, FPosition, Length(s2)) <> s2) do
          Inc(FPosition);
        Inc(FPosition, Length(s2));
        SkipSpaces;
      end;
    end;
  end;

  FLastPosition := FPosition;
end;

function TfsParser.Ident: String;
begin
  if FSkipSpace then
    SkipSpaces;

  if (FText[FPosition] in FIdentifierCharset - ['0'..'9']) then
  begin
    while FText[FPosition] in FIdentifierCharset do
      Inc(FPosition);
    Result := Copy(FText, FLastPosition, FPosition - FLastPosition);
  end
  else
    Result := '';
end;

function TfsParser.IsKeyWord(const s: String): Boolean;
begin
  Result := FKeywords.IndexOf(s) <> -1;
end;

function TfsParser.GetIdent: String;
begin
  Result := Ident;
  if IsKeyWord(Result) then
    Result := '';