david
2824855ea7
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 - Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
862 lines
24 KiB
ObjectPascal
862 lines
24 KiB
ObjectPascal
unit uDAMacros;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ Data Abstract Library - Core Library }
|
|
{ }
|
|
{ compiler: Delphi 6 and up, Kylix 3 and up }
|
|
{ platform: Win32, Linux }
|
|
{ }
|
|
{ (c)opyright RemObjects Software. all rights reserved. }
|
|
{ }
|
|
{ Using this code requires a valid license of the Data Abstract }
|
|
{ which can be obtained at http://www.remobjects.com. }
|
|
{----------------------------------------------------------------------------}
|
|
|
|
{$I DataAbstract.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils, Classes;
|
|
|
|
type
|
|
TROPasToken = (
|
|
CSTI_EOF,
|
|
{Items that are used internally}
|
|
CSTIINT_Comment,
|
|
CSTIINT_WhiteSpace,
|
|
{Tokens}
|
|
CSTI_Identifier,
|
|
CSTI_SemiColon,
|
|
CSTI_Comma,
|
|
CSTI_Period,
|
|
CSTI_Colon,
|
|
CSTI_OpenRound,
|
|
CSTI_CloseRound,
|
|
CSTI_OpenBlock,
|
|
CSTI_CloseBlock,
|
|
CSTI_Assignment,
|
|
CSTI_Equal,
|
|
CSTI_NotEqual,
|
|
CSTI_Smaller,
|
|
CSTI_SmallerEqual,
|
|
CSTI_Greater,
|
|
CSTI_GreaterEqual,
|
|
CSTI_Plus,
|
|
CSTI_Minus,
|
|
CSTI_Divide,
|
|
CSTI_Multiply,
|
|
CSTI_Integer,
|
|
CSTI_Real,
|
|
CSTI_String,
|
|
CSTI_Date,
|
|
CSTI_HexInt,
|
|
CSTI_Modulus,
|
|
CSTII_In,
|
|
CSTII_like,
|
|
CSTII_And,
|
|
CSTII_Or,
|
|
CSTII_Xor,
|
|
CSTII_Not
|
|
);
|
|
{TROParserErrorKind is used to store the parser error}
|
|
TROParserErrorKind = (iNoError, iCommentError, iStringError, iCharError, iSyntaxError);
|
|
TROParserErrorEvent = procedure(Parser: TObject; Kind: TROParserErrorKind) of object;
|
|
|
|
{TROPacalParser is the parser used to parse the current script}
|
|
TROPascalParser = class(TObject)
|
|
private
|
|
FData: string;
|
|
FRow,
|
|
FCol: Cardinal;
|
|
FLastEnterPos: Longint;
|
|
FText: PChar;
|
|
FRealPosition, FTokenLength: Cardinal;
|
|
FTokenId: TROPasToken;
|
|
FToken: string;
|
|
FOriginalToken: string;
|
|
FParserError: TROParserErrorEvent;
|
|
fOpenBlockEscape: Boolean;
|
|
// only applicable when Token in [CSTI_Identifier, CSTI_Integer, CSTI_Real, CSTI_String, CSTI_Char, CSTI_HexInt]
|
|
public
|
|
{ means you can use [something] to escape identifiers}
|
|
property OpenBlockEscape: Boolean read fOpenBlockEscape write fOpenBlockEscape;
|
|
{Go to the next token}
|
|
procedure Next;
|
|
{Return the token in case it is a string, char, integer, number or idenTROier}
|
|
property GetToken: string read FToken;
|
|
{Return the token but do not uppercase it}
|
|
property OriginalToken: string read FOriginalToken;
|
|
{The current token position}
|
|
property CurrTokenPos: Cardinal read FRealPosition;
|
|
{The current token ID}
|
|
property CurrTokenID: TROPasToken read FTokenId;
|
|
{Row}
|
|
property Row: Cardinal read FRow;
|
|
{Column}
|
|
property Col: Cardinal read FCol;
|
|
{Load a script}
|
|
procedure SetText(const Data: string);
|
|
{Parser error event will be called on (syntax) errors in the script}
|
|
property OnParserError: TROParserErrorEvent read FParserError write FParserError;
|
|
end;
|
|
|
|
TExternalProc = function(Sender: TObject; const Parameters: array of string): string of object;
|
|
|
|
TROMacroProc = class
|
|
private
|
|
FExternalProc: TExternalProc;
|
|
FExternalName: string;
|
|
FExternalNameHash: Longint;
|
|
fParamCount: integer;
|
|
public
|
|
property ExternalName: string read FExternalName write FExternalName;
|
|
property ExternalNameHash: Integer read FExternalNameHash write FExternalNameHash;
|
|
property ExternalProc: TExternalProc read FExternalProc write FExternalProc;
|
|
property ParamCount: integer read fParamCount write fParamCount;
|
|
end;
|
|
|
|
TROMacroVar = class
|
|
private
|
|
FName: string;
|
|
FNameHash: Longint;
|
|
FValue: string;
|
|
public
|
|
constructor Create(const aName: string);
|
|
property Name: string read FName;
|
|
property NameHash: Longint read FNameHash;
|
|
property Value: string read FValue write FValue;
|
|
end;
|
|
|
|
TOnUnknownIdentifier = function(Sender: TObject; const Name, OrgName: string; var Value: string): Boolean of object;
|
|
TROMacroParser = class(TInterfacedObject)
|
|
private
|
|
FProcs: TList;
|
|
FVars: TList;
|
|
FOnUnknownIdentifier: TOnUnknownIdentifier;
|
|
FParser: TROPascalParser;
|
|
procedure ParserError(Parser: TObject; Kind: TROParserErrorKind);
|
|
function GetVarCount: Longint;
|
|
function GetVarNo(I: Integer): TROMacroVar;
|
|
public
|
|
property OnUnknownIdentifier: TOnUnknownIdentifier read FOnUnknownIdentifier write FOnUnknownIdentifier;
|
|
|
|
procedure ClearProcs;
|
|
procedure RegisterProc(const Name: string; ExProc: TExternalProc; aParamCount: integer);
|
|
|
|
property VariableCount: Longint read GetVarCount;
|
|
property Variable[I: Longint]: TROMacroVar read GetVarNo;
|
|
|
|
procedure DeleteVariable(I: Longint);
|
|
procedure ClearVariables;
|
|
function AddVariable(const Name: string): TROMacroVar;
|
|
function IndexOfName(const aName: string): integer;
|
|
constructor Create;
|
|
|
|
function EvalToken(const Text: string): string;
|
|
function Eval(const Text: string; TextDelimiter: char = ''''): string;
|
|
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
function MakeHash(const s: string): Longint;
|
|
function FastUppercase(const s: string): string;
|
|
|
|
implementation
|
|
|
|
function MakeHash(const s: string): Longint;
|
|
{small hash maker}
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := 0;
|
|
for I := 1 to Length(s) do
|
|
Result := ((Result shl 7) or (Result shr 25)) + Ord(s[I]);
|
|
end;
|
|
|
|
function FastUppercase(const s: string): string;
|
|
begin
|
|
Result := Uppercase(s);
|
|
end;
|
|
|
|
procedure TROPascalParser.Next;
|
|
var
|
|
Err: TROParserErrorKind;
|
|
|
|
function _GetToken(CurrTokenPos, CurrTokenLen: Cardinal): string;
|
|
var
|
|
s: string;
|
|
begin
|
|
SetLength(s, CurrTokenLen);
|
|
Move(FText[CurrTokenPos], S[1], CurrtokenLen);
|
|
Result := s;
|
|
end;
|
|
|
|
function ParseToken(var CurrTokenPos, CurrTokenLen: Cardinal; var CurrTokenId: TROPasToken): TROParserErrorKind;
|
|
{Parse the token}
|
|
var
|
|
ct, ci: Cardinal;
|
|
s: string;
|
|
hs: Boolean;
|
|
begin
|
|
ParseToken := iNoError;
|
|
ct := CurrTokenPos;
|
|
case FText[ct] of
|
|
#0: begin
|
|
CurrTokenId := CSTI_EOF;
|
|
CurrTokenLen := 0;
|
|
end;
|
|
'A'..'Z', 'a'..'z', '_': begin
|
|
ci := ct + 1;
|
|
while (FText[ci] in ['_', '0'..'9', 'a'..'z', 'A'..'Z']) do begin
|
|
Inc(ci);
|
|
end;
|
|
CurrTokenLen := ci - ct;
|
|
CurrTokenId := CSTI_Identifier;
|
|
s := FastUppercase(_GetToken(CurrTokenPos, CurrTokenLen));
|
|
case s[1] of
|
|
'I': if s = 'IN' then CurrTokenId := CSTII_In;
|
|
'L': if s = 'LIKE' then CurrTokenId := CSTII_like;
|
|
'A': if s = 'AND' then CurrTokenId := CSTII_And;
|
|
'O': if s = 'OR' then CurrTokenId := CSTII_Or;
|
|
'X': if s = 'XOR' then CurrTokenId := CSTII_Xor;
|
|
'N': if s = 'NOT' then CurrTokenId := CSTII_Not;
|
|
end;
|
|
|
|
end;
|
|
'$': begin
|
|
ci := ct + 1;
|
|
|
|
while (FText[ci] in ['0'..'9', 'a'..'f', 'A'..'F']) do
|
|
Inc(ci);
|
|
|
|
CurrTokenId := CSTI_HexInt;
|
|
CurrTokenLen := ci - ct;
|
|
end;
|
|
|
|
'0'..'9': begin
|
|
hs := False;
|
|
ci := ct;
|
|
while (FText[ci] in ['0'..'9']) do begin
|
|
Inc(ci);
|
|
if (FText[ci] = '.') and (not hs) then begin
|
|
if FText[ci + 1] = '.' then break;
|
|
hs := True;
|
|
Inc(ci);
|
|
end;
|
|
end;
|
|
|
|
if hs then
|
|
CurrTokenId := CSTI_Real
|
|
else
|
|
CurrTokenId := CSTI_Integer;
|
|
|
|
CurrTokenLen := ci - ct;
|
|
end;
|
|
|
|
#39: begin
|
|
ci := ct + 1;
|
|
while (FText[ci] <> #0) and (FText[ci] <> #13) and
|
|
(FText[ci] <> #10) and (FText[ci] <> #39) do begin
|
|
Inc(ci);
|
|
while (FText[ci] = #39) and (FText[ci + 1] = #39) do
|
|
Inc(ci, 2);
|
|
end;
|
|
if FText[ci] = #39 then
|
|
CurrTokenId := CSTI_String
|
|
else begin
|
|
CurrTokenId := CSTI_String;
|
|
ParseToken := iStringError;
|
|
end;
|
|
CurrTokenLen := ci - ct + 1;
|
|
end;
|
|
'#': begin
|
|
ci := ct + 1;
|
|
while (FText[ci] in ['0'..'9', '/']) do begin
|
|
Inc(ci);
|
|
end;
|
|
if FText[ci] <> '#' then begin
|
|
ParseToken := iCharError;
|
|
CurrTokenId := CSTI_Date;
|
|
end
|
|
else begin
|
|
inc(ci);
|
|
CurrTokenId := CSTI_Date;
|
|
end;
|
|
CurrTokenLen := ci - ct;
|
|
end;
|
|
'=': begin
|
|
CurrTokenId := CSTI_Equal;
|
|
CurrTokenLen := 1;
|
|
end;
|
|
'>': begin
|
|
if FText[ct + 1] = '=' then begin
|
|
CurrTokenid := CSTI_GreaterEqual;
|
|
CurrTokenLen := 2;
|
|
end
|
|
else begin
|
|
CurrTokenid := CSTI_Greater;
|
|
CurrTokenLen := 1;
|
|
end;
|
|
end;
|
|
'<': begin
|
|
if FText[ct + 1] = '=' then begin
|
|
CurrTokenId := CSTI_SmallerEqual;
|
|
CurrTokenLen := 2;
|
|
end
|
|
else if FText[ct + 1] = '>' then begin
|
|
CurrTokenId := CSTI_NotEqual;
|
|
CurrTokenLen := 2;
|
|
end
|
|
else begin
|
|
CurrTokenId := CSTI_Smaller;
|
|
CurrTokenLen := 1;
|
|
end;
|
|
end;
|
|
')': begin
|
|
CurrTokenId := CSTI_CloseRound;
|
|
CurrTokenLen := 1;
|
|
end;
|
|
'(': begin
|
|
if FText[ct + 1] = '*' then begin
|
|
ci := ct + 1;
|
|
while (FText[ci] <> #0) do begin
|
|
if (FText[ci] = #13) then begin
|
|
if FText[ci + 1] = #10 then
|
|
Inc(ci);
|
|
FLastEnterPos := ci;
|
|
Inc(FRow);
|
|
end
|
|
else if FText[ci] = #10 then begin
|
|
FLastEnterPos := ci;
|
|
Inc(FRow);
|
|
end;
|
|
if (FText[ci] = '*') and (FText[ci + 1] = ')') then
|
|
Break;
|
|
Inc(ci);
|
|
end;
|
|
if (FText[ci] = #0) then begin
|
|
CurrTokenId := CSTIINT_Comment;
|
|
ParseToken := iCommentError;
|
|
end
|
|
else begin
|
|
CurrTokenId := CSTIINT_Comment;
|
|
Inc(ci, 2);
|
|
end;
|
|
CurrTokenLen := ci - ct;
|
|
end
|
|
else begin
|
|
CurrTokenId := CSTI_OpenRound;
|
|
CurrTokenLen := 1;
|
|
end;
|
|
end;
|
|
'[': begin
|
|
if fOpenBlockEscape then begin
|
|
ci := ct + 1;
|
|
while not (FText[ci] in [']', #0]) do begin
|
|
if FText[ci] = '\' then
|
|
inc(Ci);
|
|
Inc(ci);
|
|
end;
|
|
if FText[ci] = ']' then Inc(ci);
|
|
CurrTokenLen := ci - ct;
|
|
CurrTokenId := CSTI_Identifier;
|
|
end else begin
|
|
CurrTokenId := CSTI_OpenBlock;
|
|
CurrTokenLen := 1;
|
|
end;
|
|
end;
|
|
']': begin
|
|
CurrTokenId := CSTI_CloseBlock;
|
|
CurrTokenLen := 1;
|
|
end;
|
|
',': begin
|
|
CurrTokenId := CSTI_Comma;
|
|
CurrTokenLen := 1;
|
|
end;
|
|
'.': begin
|
|
CurrTokenId := CSTI_Period;
|
|
CurrTokenLen := 1;
|
|
end;
|
|
';': begin
|
|
CurrTokenId := CSTI_Semicolon;
|
|
CurrTokenLen := 1;
|
|
end;
|
|
':': begin
|
|
if FText[ct + 1] = '=' then begin
|
|
CurrTokenId := CSTI_Assignment;
|
|
CurrTokenLen := 2;
|
|
end
|
|
else begin
|
|
CurrTokenId := CSTI_Colon;
|
|
CurrTokenLen := 1;
|
|
end;
|
|
end;
|
|
'+': begin
|
|
CurrTokenId := CSTI_Plus;
|
|
CurrTokenLen := 1;
|
|
end;
|
|
'-': begin
|
|
CurrTokenId := CSTI_Minus;
|
|
CurrTokenLen := 1;
|
|
end;
|
|
'%': begin
|
|
CurrTokenId := CSTI_Modulus;
|
|
CurrTokenLen := 1;
|
|
end;
|
|
'*': begin
|
|
CurrTokenId := CSTI_Multiply;
|
|
CurrTokenLen := 1;
|
|
end;
|
|
'/': begin
|
|
if FText[ct + 1] = '/' then begin
|
|
ci := ct + 1;
|
|
while (FText[ci] <> #0) and (FText[ci] <> #13) and (FText[ci] <> #10) do begin
|
|
Inc(ci);
|
|
end;
|
|
if (FText[ci] = #0) then begin
|
|
CurrTokenId := CSTIINT_Comment;
|
|
ParseToken := iCommentError;
|
|
end
|
|
else begin
|
|
if (FText[ci] = #13) and (FText[ci + 1] = #10) then
|
|
Inc(ci);
|
|
Inc(FRow);
|
|
FLastEnterPos := ci;
|
|
|
|
CurrTokenId := CSTIINT_Comment;
|
|
end;
|
|
CurrTokenLen := ci - ct + 1;
|
|
end
|
|
else begin
|
|
CurrTokenId := CSTI_Divide;
|
|
CurrTokenLen := 1;
|
|
end;
|
|
end;
|
|
#32, #9, #13, #10: begin
|
|
ci := ct + 1;
|
|
while (FText[ci] in [#32, #9, #13, #10]) do begin
|
|
if (FText[ci] = #13) then begin
|
|
if FText[ci + 1] = #10 then
|
|
Inc(ci);
|
|
FLastEnterPos := ci;
|
|
Inc(FRow);
|
|
end
|
|
else if FText[ci] = #10 then begin
|
|
FLastEnterPos := ci;
|
|
Inc(FRow);
|
|
end;
|
|
Inc(ci);
|
|
end;
|
|
CurrTokenId := CSTIINT_WhiteSpace;
|
|
CurrTokenLen := ci - ct;
|
|
end;
|
|
'{': begin
|
|
ci := ct + 1;
|
|
while (FText[ci] <> #0) and (FText[ci] <> '}') do begin
|
|
if (FText[ci] = #13) then begin
|
|
if FText[ci + 1] = #10 then
|
|
Inc(ci);
|
|
FLastEnterPos := ci;
|
|
Inc(FRow);
|
|
end
|
|
else if FText[ci] = #10 then begin
|
|
FLastEnterPos := ci;
|
|
Inc(FRow);
|
|
end;
|
|
Inc(ci);
|
|
end;
|
|
if (FText[ci] = #0) then begin
|
|
CurrTokenId := CSTIINT_Comment;
|
|
ParseToken := iCommentError;
|
|
end
|
|
else
|
|
CurrTokenId := CSTIINT_Comment;
|
|
CurrTokenLen := ci - ct + 1;
|
|
end;
|
|
else begin
|
|
ParseToken := iSyntaxError;
|
|
CurrTokenId := CSTIINT_Comment;
|
|
CurrTokenLen := 1;
|
|
end;
|
|
end;
|
|
end;
|
|
//-------------------------------------------------------------------
|
|
begin
|
|
if FText = nil then begin
|
|
FTokenLength := 0;
|
|
FRealPosition := 0;
|
|
FRow := 1;
|
|
FLastEnterPos := 0;
|
|
FTokenId := CSTI_EOF;
|
|
Exit;
|
|
end;
|
|
repeat
|
|
FRealPosition := FRealPosition + FTokenLength;
|
|
Err := ParseToken(FRealPosition, FTokenLength, FTokenID);
|
|
if Err <> iNoError then begin
|
|
FTokenLength := 0;
|
|
FTokenId := CSTI_EOF;
|
|
FToken := '';
|
|
FOriginalToken := '';
|
|
FCol := Longint(FRealPosition) - FLastEnterPos;
|
|
if @FParserError <> nil then FParserError(Self, Err);
|
|
exit;
|
|
end;
|
|
case FTokenID of
|
|
CSTIINT_Comment, CSTIINT_WhiteSpace: Continue;
|
|
CSTI_Integer, CSTI_Real, CSTI_String, CSTI_Date, CSTI_HexInt: begin
|
|
FOriginalToken := _GetToken(FRealPosition, FTokenLength);
|
|
FToken := FOriginalToken;
|
|
end;
|
|
CSTI_Identifier: begin
|
|
FOriginalToken := _GetToken(FRealPosition, FTokenLength);
|
|
FToken := FastUppercase(FOriginalToken);
|
|
end;
|
|
else begin
|
|
FOriginalToken := '';
|
|
FToken := '';
|
|
end;
|
|
end;
|
|
Break;
|
|
until False;
|
|
FCol := Longint(FRealPosition) - FLastEnterPos;
|
|
end;
|
|
|
|
procedure TROPascalParser.SetText(const Data: string);
|
|
begin
|
|
FData := Data;
|
|
FText := Pointer(FData);
|
|
FTokenLength := 0;
|
|
FRealPosition := 0;
|
|
FRow := 1;
|
|
FLastEnterPos := -1;
|
|
FTokenId := CSTI_EOF;
|
|
Next;
|
|
end;
|
|
|
|
{ TROMacroParser }
|
|
|
|
function TROMacroParser.AddVariable(const Name: string): TROMacroVar;
|
|
begin
|
|
Result := TROMacroVar.Create(Uppercase(Name));
|
|
FVars.Add(Result);
|
|
end;
|
|
|
|
procedure TROMacroParser.ClearProcs;
|
|
var
|
|
i: Longint;
|
|
begin
|
|
for i := FProcs.Count - 1 downto 0 do begin
|
|
TROMacroProc(FPRocs[i]).Free;
|
|
end;
|
|
FProcs.Clear;
|
|
end;
|
|
|
|
procedure TROMacroParser.ClearVariables;
|
|
var
|
|
i: Longint;
|
|
begin
|
|
for i := FVars.Count - 1 downto 0 do begin
|
|
TROMacroVar(FVars[i]).Free;
|
|
end;
|
|
FVars.Clear;
|
|
end;
|
|
|
|
constructor TROMacroParser.Create;
|
|
begin
|
|
inherited Create;
|
|
FProcs := TList.Create;
|
|
FVars := TList.Create;
|
|
FParser := TROPascalParser.Create;
|
|
FParser.OnParserError := ParserError;
|
|
end;
|
|
|
|
procedure TROMacroParser.DeleteVariable(I: Integer);
|
|
var
|
|
f: TROMacroVar;
|
|
begin
|
|
f := FVars[i];
|
|
FVars.Delete(i);
|
|
f.Free;
|
|
end;
|
|
|
|
destructor TROMacroParser.Destroy;
|
|
begin
|
|
FParser.Free;
|
|
ClearProcs;
|
|
ClearVariables;
|
|
FProcs.Free;
|
|
FVars.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function MKString(const s: string): string;
|
|
begin
|
|
Result := StringReplace(s, #39#39, #39, [rfReplaceAll]);
|
|
Delete(Result, 1, 1);
|
|
Delete(Result, Length(Result), 1);
|
|
end;
|
|
|
|
function SQLEscapeStr(const s: string): string;
|
|
var
|
|
i, l: Longint;
|
|
c: char;
|
|
begin
|
|
SetLength(Result, Length(s) + 10);
|
|
Result[1] := '''';
|
|
i := 1;
|
|
l := 1;
|
|
while i <= length(s) do begin
|
|
case s[i] of
|
|
#13: c := 'r';
|
|
#10: c := 'n';
|
|
#9: c := 't';
|
|
'\': c := '\';
|
|
#39: c := #39;
|
|
'"': c := '"';
|
|
else
|
|
c := #0;
|
|
end;
|
|
if c = #0 then begin
|
|
inc(l);
|
|
if L > Length(Result) then
|
|
SetLength(Result, l + 10);
|
|
Result[l] := s[i];
|
|
end
|
|
else begin
|
|
inc(l, 2);
|
|
if L > Length(Result) then
|
|
SetLength(Result, l + 10);
|
|
Result[l - 1] := '\';
|
|
Result[l] := c;
|
|
end;
|
|
Inc(i);
|
|
end;
|
|
SetLength(Result, l + 1);
|
|
Result[l + 1] := '''';
|
|
end;
|
|
|
|
type
|
|
TOperator = (opFirst, opAdd);
|
|
|
|
function TROMacroParser.EvalToken(const Text: string): string;
|
|
|
|
function Evaluate: string;
|
|
var
|
|
h, i: Longint;
|
|
b: Boolean;
|
|
resval: string;
|
|
|
|
procedure CheckParamCount(P: TROMacroProc; Params: array of string);
|
|
begin
|
|
if (Length(Params) < P.ParamCount) then
|
|
raise Exception.CreateFmt('Invalid number of parameters. %d given, %d expected.',
|
|
[Length(Params), P.ParamCount])
|
|
end;
|
|
|
|
function CallProc(P: TROMacroProc): string;
|
|
var
|
|
Params: array of string;
|
|
s: string;
|
|
begin
|
|
FParser.Next;
|
|
if FParser.CurrTokenId <> CSTI_OpenRound then begin
|
|
CheckParamCount(P, Params);
|
|
Result := P.ExternalProc(Self, Params);
|
|
exit;
|
|
end;
|
|
FParser.Next;
|
|
while FParser.CurrTokenID <> CSTI_CloseRound do begin
|
|
s := Evaluate;
|
|
SetLength(Params, Length(Params) + 1);
|
|
Params[Length(Params) - 1] := s;
|
|
if FParser.CurrTokenId = CSTI_CloseRound then begin
|
|
Break;
|
|
end;
|
|
if FParser.CurrTokenId <> CSTI_Comma then
|
|
raise Exception.Create('[' + IntToStr(FParser.Row) + ':' + IntToStr(FParser.Col) + ']: Closing parenthesis expected');
|
|
FParser.Next;
|
|
end;
|
|
FParser.Next;
|
|
|
|
CheckParamCount(P, Params);
|
|
Result := P.ExternalProc(Self, Params);
|
|
end;
|
|
begin
|
|
Result := '';
|
|
while true do begin
|
|
case FParser.CurrTokenID of
|
|
CSTI_Identifier: begin
|
|
h := MakeHash(FParser.GetToken);
|
|
b := False;
|
|
for i := 0 to FProcs.Count - 1 do begin
|
|
with TROMacroProc(FProcs[i]) do begin
|
|
if (ExternalNameHash = h) and SameText(ExternalName, FParser.GetToken) then begin
|
|
resval := CallProc(TROMacroProc(FProcs[i]));
|
|
b := True;
|
|
end;
|
|
end;
|
|
end;
|
|
if (not b) then begin
|
|
for i := 0 to FVars.Count - 1 do begin
|
|
with TROMacroVar(FVars[i]) do begin
|
|
if (NameHash = h) and (Name = FParser.GetToken) then begin
|
|
FParser.Next;
|
|
resval := Value;
|
|
b := True;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
if (not b) and (@FOnUnknownIdentifier <> nil) then begin
|
|
b := FOnUnknownIdentifier(Self, FParser.GetToken, FParser.OriginalToken, resval);
|
|
if b then FParser.Next;
|
|
end;
|
|
if not b then
|
|
raise Exception.Create('[' + IntToStr(FParser.Row) + ':' + IntToStr(FParser.Col) + ']: Unknown identifier ' + FParser.GetToken);
|
|
end;
|
|
CSTI_Real, CSTI_Integer: begin
|
|
Resval := FParser.GetToken;
|
|
FParser.Next;
|
|
end;
|
|
CSTI_HexInt: begin
|
|
Resval := IntToStr(StrToInt(FParser.GetToken));
|
|
FParser.Next;
|
|
end;
|
|
CSTI_String, CSTI_Date: begin
|
|
Resval := '';
|
|
while (FParser.CurrTokenId = CSTI_String) or (FParser.CurrTokenId = CSTI_Date) do begin
|
|
if FParser.CurrTokenId = CSTI_String then
|
|
Resval := resval + MKString(FParser.GetToken)
|
|
else
|
|
Resval := resval + FParser.GetToken;
|
|
FParser.Next;
|
|
end;
|
|
ResVal := SQLEscapeStr(ResVal);
|
|
end;
|
|
end;
|
|
Result := Result + ResVal;
|
|
case FParser.CurrTokenId of
|
|
CSTI_Minus: Result := Result + ' - ';
|
|
CSTI_Plus: Result := Result + ' + ';
|
|
else
|
|
Break;
|
|
end;
|
|
FParser.Next;
|
|
end;
|
|
end;
|
|
begin
|
|
FParser.SetText(Text);
|
|
Result := Evaluate();
|
|
if FParser.CurrTokenID <> CSTI_EOF then
|
|
// Raise Exception.Create('['+IntToStr(FParser.Row)+':'+IntToStr(FParser.Col)+']: End of expression expected');
|
|
end;
|
|
|
|
const
|
|
LenInc = 32;
|
|
|
|
function TROMacroParser.Eval(const Text: string; TextDelimiter: char = ''''): string;
|
|
var
|
|
start, i, l: Longint;
|
|
InStr: Boolean;
|
|
s: string;
|
|
begin
|
|
SetLength(Result, Length(Text) + LenInc);
|
|
i := 1;
|
|
l := 0;
|
|
InStr := False;
|
|
while i <= length(Text) do begin
|
|
if Text[i] = '''' then
|
|
InStr := not InStr;
|
|
if (Text[i] = '{') and not (InStr) then begin
|
|
start := i;
|
|
inc(i);
|
|
InStr := False;
|
|
while i <= Length(Text) do begin
|
|
case Text[i] of
|
|
#39: InStr := not InStr;
|
|
'}': if not InStr then Break;
|
|
end;
|
|
Inc(i);
|
|
end;
|
|
s := EvalToken(Copy(Text, Start + 1, I - Start - 1));
|
|
if L + Length(s) > Length(Result) then
|
|
SetLength(Result, l + Length(s) + LenInc);
|
|
Start := 1;
|
|
while Start <= Length(s) do begin
|
|
Inc(l);
|
|
Result[l] := s[Start];
|
|
Inc(Start);
|
|
end;
|
|
Inc(i);
|
|
end
|
|
else begin
|
|
inc(l);
|
|
if L > Length(Result) then
|
|
SetLength(Result, l + LenInc);
|
|
Result[l] := Text[i];
|
|
Inc(i);
|
|
end;
|
|
end;
|
|
SetLength(Result, l);
|
|
end;
|
|
|
|
function TROMacroParser.GetVarCount: Longint;
|
|
begin
|
|
Result := FVars.Count;
|
|
end;
|
|
|
|
function TROMacroParser.GetVarNo(I: Integer): TROMacroVar;
|
|
begin
|
|
Result := FVars[i];
|
|
end;
|
|
|
|
procedure TROMacroParser.ParserError(Parser: TObject;
|
|
Kind: TROParserErrorKind);
|
|
var
|
|
err: string;
|
|
begin
|
|
case Kind of
|
|
iCommentError: err := 'Comment Error';
|
|
iCharError, iStringError: err := 'String error';
|
|
else
|
|
err := 'Syntax Error';
|
|
end;
|
|
|
|
raise Exception.Create('[' + IntToStr(FParser.Row) + ':' + IntToStr(FParser.Col) + ']: ' + err);
|
|
end;
|
|
|
|
procedure TROMacroParser.RegisterProc(const Name: string; ExProc: TExternalProc; aParamCount: integer);
|
|
var
|
|
R: TROMacroProc;
|
|
begin
|
|
R := TROMacroProc.Create;
|
|
r.ExternalName := UpperCase(Name);
|
|
r.ExternalNameHash := MakeHash(r.ExternalName);
|
|
r.ExternalProc := ExProc;
|
|
r.ParamCount := aParamCount;
|
|
|
|
FProcs.Add(r);
|
|
end;
|
|
|
|
function TROMacroParser.IndexOfName(const aName: string): integer;
|
|
begin
|
|
For Result:= 0 to FVars.Count -1 do
|
|
if SameText(aName, TROMacroVar(FVars[Result]).Name) then Exit;
|
|
Result:=-1;
|
|
end;
|
|
|
|
{ TROMacroVar }
|
|
|
|
constructor TROMacroVar.Create(const aName: string);
|
|
begin
|
|
inherited Create;
|
|
FName := aName;
|
|
FNameHash := MakeHash(aName);
|
|
end;
|
|
|
|
end.
|
|
|