pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity
Files
6f9a29a9cc758f92f35d8cdf24a13ccc47e64c21
lazarus-ccr/components/flashfiler/sourcelaz/ffsql.pas
wp_xxyyzz 27aea1d1ad flashfiler: Initial commit (ported by A.Soner). Not working yet (server error). 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5438 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2016-12-07 13:31:59 +00:00

3579 lines
98 KiB
ObjectPascal
Raw Blame History

{$I ffdefine.inc} //<-- soner added
unit FFSQL;
{==============================================================================
FFSQL
0.0.0.102
Date of Generation: 11/19/2002 2:45 PM
Comment:
Author:
Copyright:
This unit was generated by Coco/R for Delphi (www.tetzel.com) Any code in
this file that you edit manually will be over-written when the file is
regenerated.
==============================================================================}
interface
uses SysUtils,Classes,CocoBase,FFSQLDef,FFSQLDB,Dialogs;
const
maxT = 125;
type
SymbolSet = array[0..maxT div setsize] of TBitSet;
EFFSQL = class(Exception);
TFFSQL = class;
TFFSQLScanner = class(TCocoRScanner)
private
FOwner : TFFSQL;
function CharInIgnoreSet(const Ch : char) : boolean;
procedure CheckLiteral(var Sym : integer);
function Equal(s : string) : boolean;
function Comment : boolean;
protected
procedure NextCh; override;
public
constructor Create;
procedure Get(var sym : integer); override; // Gets next symbol from source file
property CurrentSymbol;
property NextSymbol;
property OnStatusUpdate;
property Owner : TFFSQL read fOwner write fOwner;
property ScannerError;
property SrcStream;
end; { TFFSQLScanner }
TFFSQL = class(TCocoRGrammar)
private
{ strictly internal variables }
symSet : array[0..7] of SymbolSet; // symSet[0] = allSyncSyms
function GetBuildDate : TDateTime;
function GetVersion : string;
function GetVersionStr : string;
procedure SetVersion(const Value : string);
function GetVersionInfo : string;
function _In(var s : SymbolSet; x : integer) : boolean;
procedure InitSymSet;
{Production methods}
procedure _SimpleAlias (var TableRef: TffSqlTableRef);
procedure _BooleanLiteral (Parent: TFFSqlNode; var BooleanLiteral: TFFSqlBooleanLiteral);
procedure _IntervalLiteral (Parent: TFFSqlNode;
var IntervalLiteral: TFFSqlIntervalLiteral);
procedure _TimestampLiteral (Parent: TFFSqlNode;
var TimestampLiteral: TFFSqlTimestampLiteral);
procedure _TimeLiteral (Parent: TFFSqlNode;
var TimeLiteral: TFFSqlTimeLiteral);
procedure _DateLiteral (Parent: TFFSqlNode;
var DateLiteral: TFFSqlDateLiteral);
procedure _StringLiteral (Parent: TFFSqlNode;
var StringLiteral: TFFSqlStringLiteral);
procedure _IntegerLiteral (Parent: TFFSqlNode;
var IntegerLiteral: TFFSqlIntegerLiteral);
procedure _FloatLiteral (Parent: TFFSqlNode;
var FloatLiteral: TFFSqlFloatLiteral);
procedure _WhenClause (Parent : TFFSqlNode;
var WhenClause : TFFSqlWhenClause);
procedure _WhenClauseList (Parent: TFFSqlNode;
var WhenClauseList : TFFSqlWhenClauseList);
procedure _CoalesceExpression (Parent: TFFSqlNode;
var CoalesceExp: TFFSqlCoalesceExpression);
procedure _CaseExpression (Parent: TFFSqlNode;
var CaseExp: TFFSqlCaseExpression);
procedure _ScalarFunction (Parent: TFFSqlNode;
var Func: TFFSqlScalarFunc);
procedure _Param (Parent: TFFSqlNode;
var Param: TFFSqlParam);
procedure _Literal (Parent: TFFSqlNode;
var Literal: TFFSqlLiteral);
procedure _Factor (Parent: TFFSqlNode;
var Factor : TFFSqlFactor;
MulOp: TFFSqlMulOp);
procedure _Term (Parent: TFFSqlNode; var Term : TFFSqlTerm; AddOp : TFFSqlAddOp);
procedure _SimpleExpressionList (Parent: TFFSqlNode;
var SimpleExpressionList: TFFSqlSimpleExpressionList);
procedure _IsTest (Parent: TFFSqlNode;
var IsTest: TFFSqlIsTest);
procedure _MatchClause (Parent: TFFSqlNode;
var MatchClause: TFFSqlMatchClause);
procedure _InClause (Parent: TFFSqlNode;
var InClause: TFFSqlInClause;
Negated: Boolean);
procedure _LikeClause (Parent: TFFSqlNode;
var LikeClause: TFFSqlLikeClause;
Negated: Boolean);
procedure _BetweenClause (Parent: TFFSqlNode;
var BetweenClause: TFFSqlBetweenClause;
Negated: Boolean);
procedure _AllOrAnyClause (Parent: TFFSqlNode;
var AllOrAny: TFFSqlAllOrAnyClause);
procedure _UniqueClause (Parent: TFFSqlNode;
var Unique: TFFSqlUniqueClause);
procedure _ExistsClause (Parent: TFFSqlNode;
var Exists: TFFSqlExistsClause);
procedure _CondPrimary (Parent: TFFSqlNode;
var CondPrimary : TFFSqlCondPrimary);
procedure _CondFactor (Parent: TFFSqlNode;
var CondFactor: TFFSqlCondFactor);
procedure _CondTerm (Parent: TFFSqlNode;
var CondTerm : TFFSqlCondTerm);
procedure _GroupColumn (Parent: TFFSqlNode;
var Col : TFFSqlGroupColumn);
procedure _FieldRef (Parent: TFFSqlNode; var FieldRef: TFFSqlFieldRef);
procedure _Aggregate (Parent: TFFSqlNode; var Aggregate : TFFSqlAggregate);
procedure _Column (Parent: TFFSqlNode;
var Col : TFFSqlColumn);
procedure _ColumnAlias (var Selection : TFFSqlSelection);
procedure _Selection (SelectionList: TFFSqlSelectionList);
procedure _OrderColumn (Parent: TFFSqlNode; var Col : TFFSqlOrderColumn);
procedure _OrderItem (Parent: TFFSqlNode;
var OrderItem : TFFSqlOrderItem);
procedure _UpdateItem (Parent: TFFSqlNode;
var UpdateItem : TFFSqlUpdateItem);
procedure _UpdateList (Parent: TFFSqlNode;
var UpdateList : TFFSqlUpdateList);
procedure _SimpleTableRef (Parent: TFFSqlNode; var TableRef: TffSqlTableRef);
procedure _SimpleExpression (Parent: TFFSqlNode;
var SimpleExpression : TFFSqlSimpleExpression);
procedure _ValueItem (Parent: TFFSqlNode;
var ValueItem : TFFSqlValueItem);
procedure _InsertItem (Parent: TFFSqlNode;
var InsertItem : TFFSqlInsertItem);
procedure _ValueList (Parent: TFFSqlNode;
var ValueList : TFFSqlValueList);
procedure _TableConstructor (Parent: TFFSqlNode; var ValueList: TffSqlValueList);
procedure _NonJoinTablePrimary (Parent: TffSqlNode; var NonJoinTablePrimary: TffSqlNonJoinTablePrimary);
procedure _NonJoinTableTerm (Parent:TffSqlNode; var NonJoinTableTerm: TffSqlNonJoinTableTerm);
procedure _UsingItem (Parent: TFFSqlNode;
var UsingItem : TFFSqlUsingItem);
procedure _UsingList (Parent: TFFSqlNode;
var UsingList : TFFSqlUsingList);
procedure _TableRef (Parent: TFFSqlNode; var TableRef: TffSqlTableRef);
procedure _NonJoinTableExp (Parent:TffSqlNode; var NonJoinTableExp: TffSqlNonJoinTableExp);
procedure _JoinTableExp (Parent:TffSqlNode; const JoinTableExp: TffSqlJoinTableExp);
procedure _SimpleTableRefOrParenTableExp (Parent: TFFSqlNode; var TableRef: TffSqlTableRef);
procedure _InsertColumnList (Parent: TFFSqlNode;
var InsertColumnList : TFFSqlInsertColumnList);
procedure _SQLName (var aName : string);
procedure _OrderList (Parent: TFFSqlNode;
var OrderList : TFFSqlOrderList);
procedure _GroupColumnList (Parent: TFFSqlNode;
var ColumnList : TFFSqlGroupColumnList);
procedure _CondExp (Parent: TFFSqlNode;
var CondExp: TFFSqlCondExp);
procedure _TableRefList (Parent: TFFSqlNode;
var TableRefList: TFFSqlTableRefList);
procedure _SelectionList (Parent: TFFSqlSELECT; var SelectionList: TFFSqlSelectionList);
procedure _SelectStatement (Parent: TFFSqlNode;
var Select : TFFSqlSELECT);
procedure _DeleteStatement (Parent: TFFSqlNode;
var DeleteSt : TFFSqlDELETE);
procedure _UpdateStatement (Parent: TFFSqlNode;
var UpdateSt : TFFSqlUPDATE);
procedure _InsertStatement (Parent: TFFSqlNode;
var InsertSt : TFFSqlINSERT);
procedure _TableExp (Parent:TffSqlNode; var TableExp: TffSqlTableExp);
procedure _FFSQL;
private
FRootNode : TFFSQLStatement;
FReservedWordList : TStringList;
FAllowReservedWordNames : boolean;
procedure Init;
procedure Final;
procedure InitReservedWordList;
function CheckSQLName(const SQLNameString : string) : string;
function IsColumnList : Boolean;
function Matches(n : integer) : Boolean;
function IsSymbol(n: integer): boolean; {mwr}
function IsParenNonJoinTableExp : Boolean;
function IsParenJoinTableExp: Boolean;
function IsParenTableExp: Boolean;
function IsNonJoinTableExp : Boolean;
function IsJoinTableExp: Boolean;
function IsTableExp: Boolean;
function IsTableRef: Boolean;
protected
{ Protected Declarations }
procedure Get; override;
public
{ Public Declarations }
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
function ErrorStr(const ErrorCode : integer; const Data : string) : string; override;
procedure Execute;
function GetScanner : TFFSQLScanner;
procedure Parse;
property ErrorList;
property ListStream;
property SourceStream;
property Successful;
property BuildDate : TDateTime read GetBuildDate;
property VersionStr : string read GetVersionStr;
property VersionInfo : string read GetVersionInfo;
public
property RootNode : TFFSqlStatement read FRootNode write FRootNode;
property AllowReservedWordNames : boolean read FAllowReservedWordNames write FAllowReservedWordNames;
published
{ Published Declarations }
property AfterGet;
property AfterParse;
property AfterGenList;
property BeforeGenList;
property BeforeParse;
property ClearSourceStream;
property GenListWhen;
property SourceFileName;
property Version : string read GetVersion write SetVersion;
property OnCustomError;
property OnError;
property OnFailure;
property OnStatusUpdate;
property OnSuccess;
end; { TFFSQL }
implementation
const
EOFSYMB = 0; identSym = 1; integer_Sym = 2; floatSym = 3;
SQLStringSym = 4; SQLNameStringSym = 5; NOINDEXSym = 6; NOREDUCESym = 7;
_semicolonSym = 8; SELECTSym = 9; ALLSym = 10; DISTINCTSym = 11;
FROMSym = 12; WHERESym = 13; GROUPSym = 14; BYSym = 15; HAVINGSym = 16;
ORDERSym = 17; INSERTSym = 18; INTOSym = 19; DEFAULTSym = 20;
VALUESSym = 21; _lparenSym = 22; _rparenSym = 23; CROSSSym = 24;
JOINSym = 25; NATURALSym = 26; INNERSym = 27; LEFTSym = 28; OUTERSym = 29;
RIGHTSym = 30; FULLSym = 31; UNIONSym = 32; ONSym = 33; USINGSym = 34;
_commaSym = 35; TABLESym = 36; NULLSym = 37; DELETESym = 38;
UPDATESym = 39; SETSym = 40; _equalSym = 41; ASCSym = 42; DESCSym = 43;
_pointSym = 44; _starSym = 45; ASSym = 46; COUNTSym = 47; MINSym = 48;
MAXSym = 49; SUMSym = 50; AVGSym = 51; ORSym = 52; ANDSym = 53;
NOTSym = 54; _less_equalSym = 55; _lessSym = 56; _greaterSym = 57;
_greater_equalSym = 58; _less_greaterSym = 59; ANYSym = 60; SOMESym = 61;
EXISTSSym = 62; UNIQUESym = 63; ISSym = 64; TRUESym = 65; FALSESym = 66;
UNKNOWNSym = 67; BETWEENSym = 68; LIKESym = 69; ESCAPESym = 70;
IGNORESym = 71; CASESym = 72; INSym = 73; MATCHSym = 74; PARTIALSym = 75;
_plusSym = 76; _minusSym = 77; _bar_barSym = 78; _slashSym = 79;
CHARACTER_underscoreLENGTHSym = 80; CHAR_underscoreLENGTHSym = 81;
COALESCESym = 82; CURRENT_underscoreDATESym = 83;
CURRENT_underscoreTIMESym = 84; CURRENT_underscoreTIMESTAMPSym = 85;
CURRENT_underscoreUSERSym = 86; USERSym = 87; LOWERSym = 88; UPPERSym = 89;
POSITIONSym = 90; SESSION_underscoreUSERSym = 91; SUBSTRINGSym = 92;
FORSym = 93; SYSTEM_underscoreUSERSym = 94; TRIMSym = 95; LEADINGSym = 96;
TRAILINGSym = 97; BOTHSym = 98; EXTRACTSym = 99; YEARSym = 100;
MONTHSym = 101; DAYSym = 102; HOURSym = 103; MINUTESym = 104;
SECONDSym = 105; NULLIFSym = 106; ABSSym = 107; CEILINGSym = 108;
FLOORSym = 109; EXPSym = 110; LOGSym = 111; POWERSym = 112; RANDSym = 113;
ROUNDSym = 114; ELSESym = 115; ENDSym = 116; WHENSym = 117; THENSym = 118;
_querySym = 119; DATESym = 120; TIMESym = 121; TIMESTAMPSym = 122;
INTERVALSym = 123; TOSym = 124; NOSYMB = 125; _noSym = NOSYMB; {error token code}
{ --------------------------------------------------------------------------- }
{ Arbitrary Code from ATG file }
procedure TFFSQL.InitReservedWordList;
begin
FReservedWordList.Add('ABS'); {!!.11}
FReservedWordList.Add('ALL');
FReservedWordList.Add('AND');
FReservedWordList.Add('ANY');
FReservedWordList.Add('AS');
FReservedWordList.Add('ASC');
FReservedWordList.Add('AVG');
FReservedWordList.Add('BETWEEN');
FReservedWordList.Add('BOTH');
FReservedWordList.Add('BY');
FReservedWordList.Add('CASE');
FReservedWordList.Add('CEILING'); {!!.11}
FReservedWordList.Add('CHARACTER_LENGTH');
FReservedWordList.Add('CHAR_LENGTH');
FReservedWordList.Add('COALESCE');
FReservedWordList.Add('COUNT');
FReservedWordList.Add('CROSS');
FReservedWordList.Add('CURRENT_DATE');
FReservedWordList.Add('CURRENT_TIME');
FReservedWordList.Add('CURRENT_TIMESTAMP');
FReservedWordList.Add('CURRENT_USER');
FReservedWordList.Add('DATE');
FReservedWordList.Add('DAY');
FReservedWordList.Add('DEFAULT');
FReservedWordList.Add('DELETE');
FReservedWordList.Add('DESC');
FReservedWordList.Add('DISTINCT');
FReservedWordList.Add('ELSE');
FReservedWordList.Add('END');
FReservedWordList.Add('EXP'); {!!.11}
FReservedWordList.Add('ESCAPE');
FReservedWordList.Add('EXISTS');
FReservedWordList.Add('EXTRACT');
FReservedWordList.Add('FALSE');
FReservedWordList.Add('FLOOR'); {!!.11}
FReservedWordList.Add('FOR');
FReservedWordList.Add('FROM');
FReservedWordList.Add('FULL');
FReservedWordList.Add('GROUP');
FReservedWordList.Add('HAVING');
FReservedWordList.Add('HOUR');
FReservedWordList.Add('IN');
FReservedWordList.Add('INNER');
FReservedWordList.Add('INSERT');
FReservedWordList.Add('INTERVAL');
FReservedWordList.Add('IS');
FReservedWordList.Add('JOIN');
FReservedWordList.Add('LEADING');
FReservedWordList.Add('LEFT');
FReservedWordList.Add('LIKE');
FReservedWordList.Add('LOG'); {!!.11}
FReservedWordList.Add('LOWER');
FReservedWordList.Add('MATCH');
FReservedWordList.Add('MAX');
FReservedWordList.Add('MIN');
FReservedWordList.Add('MINUTE');
FReservedWordList.Add('MONTH');
FReservedWordList.Add('NOINDEX');
FReservedWordList.Add('NOREDUCE');
FReservedWordList.Add('NOT');
FReservedWordList.Add('NULL');
FReservedWordList.Add('NULLIF');
FReservedWordList.Add('OR');
FReservedWordList.Add('ORDER');
FReservedWordList.Add('OUTER');
FReservedWordList.Add('PARTIAL');
FReservedWordList.Add('POSITION');
FReservedWordList.Add('POWER'); {!!.11}
FReservedWordList.Add('RAND'); {!!.11}
FReservedWordList.Add('RIGHT');
FReservedWordList.Add('ROUND'); {!!.11}
FReservedWordList.Add('SECOND');
FReservedWordList.Add('SELECT');
FReservedWordList.Add('SESSION_USER');
FReservedWordList.Add('SET');
FReservedWordList.Add('SOME');
FReservedWordList.Add('SUBSTRING');
FReservedWordList.Add('SUM');
FReservedWordList.Add('SYSTEM_USER');
FReservedWordList.Add('TABLE');
FReservedWordList.Add('THEN');
FReservedWordList.Add('TIME');
FReservedWordList.Add('TIMESTAMP');
FReservedWordList.Add('TO');
FReservedWordList.Add('TRAILING');
FReservedWordList.Add('TRIM');
FReservedWordList.Add('TRUE');
FReservedWordList.Add('UNIQUE');
FReservedWordList.Add('UNKNOWN');
FReservedWordList.Add('UPDATE');
FReservedWordList.Add('UPPER');
FReservedWordList.Add('USER');
FReservedWordList.Add('USING');
FReservedWordList.Add('VALUES');
FReservedWordList.Add('WHEN');
FReservedWordList.Add('WHERE');
FReservedWordList.Add('YEAR');
FReservedWordList.Sorted := TRUE;
end;
procedure TFFSQL.Init;
begin
fRootNode := TFFSqlStatement.Create;
fRootNode.UseIndex := True;
fRootNode.Reduce := True;
InitReservedWordList;
end;
procedure TFFSQL.Final;
begin
if successful and fRootNode.Reduce then
fRootNode.ReduceStrength;
end;
function TFFSQL.CheckSQLName(const SQLNameString : string) : string;
var
Idx : integer;
begin
Result := copy(SQLNameString,2,length(SQLNameString) - 2);
if NOT fAllowReservedWordNames
AND fReservedWordList.Find(UpperCase(Result), Idx) then
SemError(203, Result);
end;
function TFFSQL.IsSymbol(n : integer) : boolean;
begin
if CurrentInputSymbol = n then
Result := True
else
Result := False;
end;
function TFFSQL.Matches(n: integer): boolean;
begin
Result := IsSymbol(n);
if Result then
Get;
end; {Expect}
function TFFSQL.IsColumnList : boolean;
var
BS: string;
begin
Result := False;
BS := Bookmark;
try
if not Matches(_lparenSym) then exit;
if not Matches(identSym)
and not Matches(SQLNameStringSym) then exit;
while (fCurrentInputSymbol = _commaSym) do begin
Get;
if not Matches(identSym)
and not Matches(SQLNameStringSym) then exit;
end;
if not Matches(_rparenSym) then exit;
Result := True;
finally
GotoBookmark(BS);
end;
end;
function TFFSQL.IsParenNonJoinTableExp : boolean;
var
BS: string;
begin
Result := False;
BS := Bookmark;
try
if not Matches(_lparenSym) then exit;
if not IsParenNonJoinTableExp
and not (fCurrentInputSymbol in [SELECTsym, TABLEsym, VALUESsym]) then
exit;
Result := True;
finally
GotoBookmark(BS);
end;
end;
function TFFSQL.IsNonJoinTableExp : boolean;
var
BS: string;
begin
Result := False;
BS := Bookmark;
try
if not IsParenNonJoinTableExp
and not (fCurrentInputSymbol in [SELECTsym, TABLEsym, VALUESsym]) then
exit;
Result := True;
finally
GotoBookmark(BS);
end;
end;
function TFFSQL.IsTableRef : boolean;
begin
Result := False;
if (fCurrentInputSymbol = identSym) OR
(fCurrentInputSymbol = SQLNameStringSym) then begin
Get;
if (fCurrentInputSymbol = _pointSym) then begin
Get;
Get;
end;
Result := True;
end;
end;
function TFFSQL.IsParenJoinTableExp : boolean;
var
BS: string;
begin
Result := False;
BS := Bookmark;
try
if not Matches(_lparenSym) then exit;
if not IsTableRef then exit;
if not (fCurrentInputSymbol in [CROSSSym, NATURALSym, INNERSym, LEFTSym, RIGHTSym, FULLSym, UNIONSym, JOINSym]) then
exit;
Result := True;
finally
GotoBookmark(BS);
end;
end;
function TFFSQL.IsJoinTableExp : boolean;
var
BS: string;
begin
Result := False;
BS := Bookmark;
try
if not IsTableRef then exit;
if IsSymbol(ASSym) then
Get;
if IsSymbol(identSym) then
Get;
if not (fCurrentInputSymbol in [CROSSSym, NATURALSym, INNERSym, LEFTSym, RIGHTSym, FULLSym, UNIONSym, JOINSym]) then
exit;
Result := True;
finally
GotoBookmark(BS);
end;
end;
function TFFSQL.IsParenTableExp : boolean;
begin
Result := IsParenNonJoinTableExp or IsParenJoinTableExp;
end;
function TFFSQL.IsTableExp : boolean;
begin
Result := IsNonJoinTableExp or IsJoinTableExp or IsParenTableExp;
end;
(* End of Arbitrary Code *)
{ --------------------------------------------------------------------------- }
{ ---- implementation for TFFSQLScanner ---- }
procedure TFFSQLScanner.NextCh;
{ Return global variable ch }
begin
LastInputCh := CurrInputCh;
BufferPosition := BufferPosition + 1;
SrcStream.Seek(BufferPosition,soFromBeginning);
CurrInputCh := CurrentCh(BufferPosition);
if (CurrInputCh = _EL) OR ((CurrInputCh = _LF) AND (LastInputCh <> _EL)) then
begin
CurrLine := CurrLine + 1;
if Assigned(OnStatusUpdate) then
OnStatusUpdate(Owner, cstLineNum, '', CurrLine);
StartOfLine := BufferPosition;
end
end; {NextCh}
function TFFSQLScanner.Comment : boolean;
var
level : integer;
startLine : integer;
oldLineStart : longint;
CommentStr : string;
begin
level := 1;
startLine := CurrLine;
oldLineStart := StartOfLine;
CommentStr := CharAt(BufferPosition);
//Result := false;
if (CurrInputCh = '/') then
begin
NextCh;
CommentStr := CommentStr + CharAt(BufferPosition);
if (CurrInputCh = '/') then
begin
NextCh;
CommentStr := CommentStr + CharAt(BufferPosition);
while true do
begin
if (CurrInputCh = CHR(13)) then
begin
level := level - 1;
NumEOLInComment := CurrLine - startLine;
NextCh;
CommentStr := CommentStr + CharAt(BufferPosition);
if level = 0 then
begin
Result := true;
Exit;
end;
end
else if CurrInputCh = _EF then
begin
Result := false;
Exit;
end
else
begin
NextCh;
CommentStr := CommentStr + CharAt(BufferPosition);
end;
end; { WHILE TRUE }
end
else
begin
if (CurrInputCh = _CR) OR (CurrInputCh = _LF) then
begin
CurrLine := CurrLine - 1;
StartOfLine := oldLineStart
end;
BufferPosition := BufferPosition - 1;
CurrInputCh := LastInputCh;
//Result := false;
end;
end;
//Result := false;
if (CurrInputCh = '-') then
begin
NextCh;
CommentStr := CommentStr + CharAt(BufferPosition);
if (CurrInputCh = '-') then
begin
NextCh;
CommentStr := CommentStr + CharAt(BufferPosition);
while true do
begin
if (CurrInputCh = CHR(13)) then
begin
level := level - 1;
NumEOLInComment := CurrLine - startLine;
NextCh;
CommentStr := CommentStr + CharAt(BufferPosition);
if level = 0 then
begin
Result := true;
Exit;
end;
end
else if CurrInputCh = _EF then
begin
Result := false;
Exit;
end
else
begin
NextCh;
CommentStr := CommentStr + CharAt(BufferPosition);
end;
end; { WHILE TRUE }
end
else
begin
if (CurrInputCh = _CR) OR (CurrInputCh = _LF) then
begin
CurrLine := CurrLine - 1;
StartOfLine := oldLineStart
end;
BufferPosition := BufferPosition - 1;
CurrInputCh := LastInputCh;
//Result := false;
end;
end;
Result := false;
if (CurrInputCh = '/') then
begin
NextCh;
CommentStr := CommentStr + CharAt(BufferPosition);
if (CurrInputCh = '*') then
begin
NextCh;
CommentStr := CommentStr + CharAt(BufferPosition);
while true do
begin
if (CurrInputCh = '*') then
begin
NextCh;
CommentStr := CommentStr + CharAt(BufferPosition);
if (CurrInputCh = '/') then
begin
level := level - 1;
NextCh;
CommentStr := CommentStr + CharAt(BufferPosition);
if level = 0 then
begin
Result := true;
Exit;
end
end
end
else if (CurrInputCh = '/') then
begin
NextCh;
CommentStr := CommentStr + CharAt(BufferPosition);
if (CurrInputCh = '*') then
begin
level := level + 1;
NextCh;
CommentStr := CommentStr + CharAt(BufferPosition);
end
end
else if CurrInputCh = _EF then
begin
Result := false;
Exit;
end
else
begin
NextCh;
CommentStr := CommentStr + CharAt(BufferPosition);
end;
end; { WHILE TRUE }
end
else
begin
if (CurrInputCh = _CR) OR (CurrInputCh = _LF) then
begin
CurrLine := CurrLine - 1;
StartOfLine := oldLineStart
end;
BufferPosition := BufferPosition - 1;
CurrInputCh := LastInputCh;
Result := false;
end;
end;
end; { Comment }
function TFFSQLScanner.CharInIgnoreSet(const Ch : char) : boolean;
begin
Result := (Ch = ' ') OR
((CurrInputCh >= CHR(1)) AND (CurrInputCh <= ' '));
end; {CharInIgnoreSet}
function TFFSQLScanner.Equal(s : string) : boolean;
var
i : integer;
q : longint;
begin
if NextSymbol.Len <> Length(s) then
begin
Result := false;
EXIT
end;
i := 1;
q := bpCurrToken;
while i <= NextSymbol.Len do
begin
if CurrentCh(q) <> s[i] then
begin
Result := false;
EXIT;
end;
inc(i);
inc(q);
end;
Result := true
end; {Equal}
procedure TFFSQLScanner.CheckLiteral(var Sym : integer);
begin
case CurrentCh(bpCurrToken) of
'A': if Equal('ABS') then
begin
sym := ABSSym;
end
else if Equal('ALL') then
begin
sym := ALLSym;
end
else if Equal('AND') then
begin
sym := ANDSym;
end
else if Equal('ANY') then
begin
sym := ANYSym;
end
else if Equal('AS') then
begin
sym := ASSym;
end
else if Equal('ASC') then
begin
sym := ASCSym;
end
else if Equal('AVG') then
begin
sym := AVGSym;
end;
'B': if Equal('BETWEEN') then
begin
sym := BETWEENSym;
end
else if Equal('BOTH') then
begin
sym := BOTHSym;
end
else if Equal('BY') then
begin
sym := BYSym;
end;
'C': if Equal('CASE') then
begin
sym := CASESym;
end
else if Equal('CEILING') then
begin
sym := CEILINGSym;
end
else if Equal('CHARACTER_LENGTH') then
begin
sym := CHARACTER_underscoreLENGTHSym;
end
else if Equal('CHAR_LENGTH') then
begin
sym := CHAR_underscoreLENGTHSym;
end
else if Equal('COALESCE') then
begin
sym := COALESCESym;
end
else if Equal('COUNT') then
begin
sym := COUNTSym;
end
else if Equal('CROSS') then
begin
sym := CROSSSym;
end
else if Equal('CURRENT_DATE') then
begin
sym := CURRENT_underscoreDATESym;
end
else if Equal('CURRENT_TIME') then
begin
sym := CURRENT_underscoreTIMESym;
end
else if Equal('CURRENT_TIMESTAMP') then
begin
sym := CURRENT_underscoreTIMESTAMPSym;
end
else if Equal('CURRENT_USER') then
begin
sym := CURRENT_underscoreUSERSym;
end;
'D': if Equal('DATE') then
begin
sym := DATESym;
end
else if Equal('DAY') then
begin
sym := DAYSym;
end
else if Equal('DEFAULT') then
begin
sym := DEFAULTSym;
end
else if Equal('DELETE') then
begin
sym := DELETESym;
end
else if Equal('DESC') then
begin
sym := DESCSym;
end
else if Equal('DISTINCT') then
begin
sym := DISTINCTSym;
end;
'E': if Equal('ELSE') then
begin
sym := ELSESym;
end
else if Equal('END') then
begin
sym := ENDSym;
end
else if Equal('ESCAPE') then
begin
sym := ESCAPESym;
end
else if Equal('EXISTS') then
begin
sym := EXISTSSym;
end
else if Equal('EXP') then
begin
sym := EXPSym;
end
else if Equal('EXTRACT') then
begin
sym := EXTRACTSym;
end;
'F': if Equal('FALSE') then
begin
sym := FALSESym;
end
else if Equal('FLOOR') then
begin
sym := FLOORSym;
end
else if Equal('FOR') then
begin
sym := FORSym;
end
else if Equal('FROM') then
begin
sym := FROMSym;
end
else if Equal('FULL') then
begin
sym := FULLSym;
end;
'G': if Equal('GROUP') then
begin
sym := GROUPSym;
end;
'H': if Equal('HAVING') then
begin
sym := HAVINGSym;
end
else if Equal('HOUR') then
begin
sym := HOURSym;
end;
'I': if Equal('IGNORE') then
begin
sym := IGNORESym;
end
else if Equal('IN') then
begin
sym := INSym;
end
else if Equal('INNER') then
begin
sym := INNERSym;
end
else if Equal('INSERT') then
begin
sym := INSERTSym;
end
else if Equal('INTERVAL') then
begin
sym := INTERVALSym;
end
else if Equal('INTO') then
begin
sym := INTOSym;
end
else if Equal('IS') then
begin
sym := ISSym;
end;
'J': if Equal('JOIN') then
begin
sym := JOINSym;
end;
'L': if Equal('LEADING') then
begin
sym := LEADINGSym;
end
else if Equal('LEFT') then
begin
sym := LEFTSym;
end
else if Equal('LIKE') then
begin
sym := LIKESym;
end
else if Equal('LOG') then
begin
sym := LOGSym;
end
else if Equal('LOWER') then
begin
sym := LOWERSym;
end;
'M': if Equal('MATCH') then
begin
sym := MATCHSym;
end
else if Equal('MAX') then
begin
sym := MAXSym;
end
else if Equal('MIN') then
begin
sym := MINSym;
end
else if Equal('MINUTE') then
begin
sym := MINUTESym;
end
else if Equal('MONTH') then
begin
sym := MONTHSym;
end;
'N': if Equal('NATURAL') then
begin
sym := NATURALSym;
end
else if Equal('NOINDEX') then
begin
sym := NOINDEXSym;
end
else if Equal('NOREDUCE') then
begin
sym := NOREDUCESym;
end
else if Equal('NOT') then
begin
sym := NOTSym;
end
else if Equal('NULL') then
begin
sym := NULLSym;
end
else if Equal('NULLIF') then
begin
sym := NULLIFSym;
end;
'O': if Equal('ON') then
begin
sym := ONSym;
end
else if Equal('OR') then
begin
sym := ORSym;
end
else if Equal('ORDER') then
begin
sym := ORDERSym;
end
else if Equal('OUTER') then
begin
sym := OUTERSym;
end;
'P': if Equal('PARTIAL') then
begin
sym := PARTIALSym;
end
else if Equal('POSITION') then
begin
sym := POSITIONSym;
end
else if Equal('POWER') then
begin
sym := POWERSym;
end;
'R': if Equal('RAND') then
begin
sym := RANDSym;
end
else if Equal('RIGHT') then
begin
sym := RIGHTSym;
end
else if Equal('ROUND') then
begin
sym := ROUNDSym;
end;
'S': if Equal('SECOND') then
begin
sym := SECONDSym;
end
else if Equal('SELECT') then
begin
sym := SELECTSym;
end
else if Equal('SESSION_USER') then
begin
sym := SESSION_underscoreUSERSym;
end
else if Equal('SET') then
begin
sym := SETSym;
end
else if Equal('SOME') then
begin
sym := SOMESym;
end
else if Equal('SUBSTRING') then
begin
sym := SUBSTRINGSym;
end
else if Equal('SUM') then
begin
sym := SUMSym;
end
else if Equal('SYSTEM_USER') then
begin
sym := SYSTEM_underscoreUSERSym;
end;
'T': if Equal('TABLE') then
begin
sym := TABLESym;
end
else if Equal('THEN') then
begin
sym := THENSym;
end
else if Equal('TIME') then
begin
sym := TIMESym;
end
else if Equal('TIMESTAMP') then
begin
sym := TIMESTAMPSym;
end
else if Equal('TO') then
begin
sym := TOSym;
end
else if Equal('TRAILING') then
begin
sym := TRAILINGSym;
end
else if Equal('TRIM') then
begin
sym := TRIMSym;
end
else if Equal('TRUE') then
begin
sym := TRUESym;
end;
'U': if Equal('UNION') then
begin
sym := UNIONSym;
end
else if Equal('UNIQUE') then
begin
sym := UNIQUESym;
end
else if Equal('UNKNOWN') then
begin
sym := UNKNOWNSym;
end
else if Equal('UPDATE') then
begin
sym := UPDATESym;
end
else if Equal('UPPER') then
begin
sym := UPPERSym;
end
else if Equal('USER') then
begin
sym := USERSym;
end
else if Equal('USING') then
begin
sym := USINGSym;
end;
'V': if Equal('VALUES') then
begin
sym := VALUESSym;
end;
'W': if Equal('WHEN') then
begin
sym := WHENSym;
end
else if Equal('WHERE') then
begin
sym := WHERESym;
end;
'Y': if Equal('YEAR') then
begin
sym := YEARSym;
end;
else
begin
end
end
end; {CheckLiteral}
procedure TFFSQLScanner.Get(var sym : integer);
var
state : integer;
begin {Get}
while CharInIgnoreSet(CurrInputCh) do
NextCh;
if ((CurrInputCh = '/') OR (CurrInputCh = '-') OR (CurrInputCh = '/')) AND Comment then
begin
Get(sym);
exit;
end;
CurrentSymbol.Assign(NextSymbol);
NextSymbol.Pos := BufferPosition;
NextSymbol.Col := BufferPosition - StartOfLine;
NextSymbol.Line := CurrLine;
NextSymbol.Len := 0;
ContextLen := 0;
state := StartState[ORD(CurrInputCh)];
bpCurrToken := BufferPosition;
while true do
begin
NextCh;
NextSymbol.Len := NextSymbol.Len + 1;
if BufferPosition > SrcStream.Size then
begin
sym := EOFSYMB;
CurrInputCh := _EF;
BufferPosition := BufferPosition - 1;
exit
end;
case state of
1: if ((CurrInputCh = '!') OR
(CurrInputCh >= '#') AND (CurrInputCh <= '$') OR
(CurrInputCh >= '0') AND (CurrInputCh <= '9') OR
(CurrInputCh >= '@') AND (CurrInputCh <= 'Z') OR
(CurrInputCh = '\') OR
(CurrInputCh >= '^') AND (CurrInputCh <= '{') OR
(CurrInputCh >= '}')) then
begin
end
else
begin
sym := identSym;
CheckLiteral(sym);
exit;
end;
2: if ((CurrInputCh >= '0') AND (CurrInputCh <= '9')) then
begin
state := 3;
end
else
begin
sym := _pointSym;
exit;
end;
3: if ((CurrInputCh >= '0') AND (CurrInputCh <= '9')) then
begin
end
else
begin
sym := floatSym;
exit;
end;
4: if ((CurrInputCh <= CHR(12)) OR
(CurrInputCh >= CHR(14)) AND (CurrInputCh <= '&') OR
(CurrInputCh >= '(')) then
begin
end
else if (CurrInputCh = CHR(39)) then
begin
state := 8;
end
else
begin
sym := _noSym;
exit;
end;
5: if ((CurrInputCh <= CHR(12)) OR
(CurrInputCh >= CHR(14)) AND (CurrInputCh <= '!') OR
(CurrInputCh >= '#')) then
begin
end
else if (CurrInputCh = '"') then
begin
state := 6;
end
else
begin
sym := _noSym;
exit;
end;
6: begin
sym := SQLNameStringSym;
exit;
end;
7: if ((CurrInputCh >= '0') AND (CurrInputCh <= '9')) then
begin
end
else if (CurrInputCh = '.') then
begin
state := 2;
end
else
begin
sym := integer_Sym;
exit;
end;
8: if (CurrInputCh = CHR(39)) then
begin
state := 4;
end
else
begin
sym := SQLStringSym;
exit;
end;
9: begin
sym := _semicolonSym;
exit;
end;
10: begin
sym := _lparenSym;
exit;
end;
11: begin
sym := _rparenSym;
exit;
end;
12: begin
sym := _commaSym;
exit;
end;
13: begin
sym := _equalSym;
exit;
end;
14: begin
sym := _starSym;
exit;
end;
15: if (CurrInputCh = '=') then
begin
state := 16;
end
else if (CurrInputCh = '>') then
begin
state := 19;
end
else
begin
sym := _lessSym;
exit;
end;
16: begin
sym := _less_equalSym;
exit;
end;
17: if (CurrInputCh = '=') then
begin
state := 18;
end
else
begin
sym := _greaterSym;
exit;
end;
18: begin
sym := _greater_equalSym;
exit;
end;
19: begin
sym := _less_greaterSym;
exit;
end;
20: begin
sym := _plusSym;
exit;
end;
21: begin
sym := _minusSym;
exit;
end;
22: if (CurrInputCh = '|') then
begin
state := 23;
end
else
begin
sym := _noSym;
exit;
end;
23: begin
sym := _bar_barSym;
exit;
end;
24: begin
sym := _slashSym;
exit;
end;
25: begin
sym := _querySym;
exit;
end;
26: begin
sym := EOFSYMB;
CurrInputCh := #0;
BufferPosition := BufferPosition - 1;
exit
end;
else
begin
sym := _noSym;
EXIT; // NextCh already done
end;
end;
end;
end; {Get}
constructor TFFSQLScanner.Create;
begin
inherited;
CurrentCh := CapChAt;
fStartState[ 0] := 26; fStartState[ 1] := 27; fStartState[ 2] := 27; fStartState[ 3] := 27;
fStartState[ 4] := 27; fStartState[ 5] := 27; fStartState[ 6] := 27; fStartState[ 7] := 27;
fStartState[ 8] := 27; fStartState[ 9] := 27; fStartState[ 10] := 27; fStartState[ 11] := 27;
fStartState[ 12] := 27; fStartState[ 13] := 27; fStartState[ 14] := 27; fStartState[ 15] := 27;
fStartState[ 16] := 27; fStartState[ 17] := 27; fStartState[ 18] := 27; fStartState[ 19] := 27;
fStartState[ 20] := 27; fStartState[ 21] := 27; fStartState[ 22] := 27; fStartState[ 23] := 27;
fStartState[ 24] := 27; fStartState[ 25] := 27; fStartState[ 26] := 27; fStartState[ 27] := 27;
fStartState[ 28] := 27; fStartState[ 29] := 27; fStartState[ 30] := 27; fStartState[ 31] := 27;
fStartState[ 32] := 27; fStartState[ 33] := 1; fStartState[ 34] := 5; fStartState[ 35] := 1;
fStartState[ 36] := 1; fStartState[ 37] := 27; fStartState[ 38] := 27; fStartState[ 39] := 4;
fStartState[ 40] := 10; fStartState[ 41] := 11; fStartState[ 42] := 14; fStartState[ 43] := 20;
fStartState[ 44] := 12; fStartState[ 45] := 21; fStartState[ 46] := 2; fStartState[ 47] := 24;
fStartState[ 48] := 7; fStartState[ 49] := 7; fStartState[ 50] := 7; fStartState[ 51] := 7;
fStartState[ 52] := 7; fStartState[ 53] := 7; fStartState[ 54] := 7; fStartState[ 55] := 7;
fStartState[ 56] := 7; fStartState[ 57] := 7; fStartState[ 58] := 27; fStartState[ 59] := 9;
fStartState[ 60] := 15; fStartState[ 61] := 13; fStartState[ 62] := 17; fStartState[ 63] := 25;
fStartState[ 64] := 1; fStartState[ 65] := 1; fStartState[ 66] := 1; fStartState[ 67] := 1;
fStartState[ 68] := 1; fStartState[ 69] := 1; fStartState[ 70] := 1; fStartState[ 71] := 1;
fStartState[ 72] := 1; fStartState[ 73] := 1; fStartState[ 74] := 1; fStartState[ 75] := 1;
fStartState[ 76] := 1; fStartState[ 77] := 1; fStartState[ 78] := 1; fStartState[ 79] := 1;
fStartState[ 80] := 1; fStartState[ 81] := 1; fStartState[ 82] := 1; fStartState[ 83] := 1;
fStartState[ 84] := 1; fStartState[ 85] := 1; fStartState[ 86] := 1; fStartState[ 87] := 1;
fStartState[ 88] := 1; fStartState[ 89] := 1; fStartState[ 90] := 1; fStartState[ 91] := 27;
fStartState[ 92] := 1; fStartState[ 93] := 27; fStartState[ 94] := 1; fStartState[ 95] := 1;
fStartState[ 96] := 1; fStartState[ 97] := 1; fStartState[ 98] := 1; fStartState[ 99] := 1;
fStartState[100] := 1; fStartState[101] := 1; fStartState[102] := 1; fStartState[103] := 1;
fStartState[104] := 1; fStartState[105] := 1; fStartState[106] := 1; fStartState[107] := 1;
fStartState[108] := 1; fStartState[109] := 1; fStartState[110] := 1; fStartState[111] := 1;
fStartState[112] := 1; fStartState[113] := 1; fStartState[114] := 1; fStartState[115] := 1;
fStartState[116] := 1; fStartState[117] := 1; fStartState[118] := 1; fStartState[119] := 1;
fStartState[120] := 1; fStartState[121] := 1; fStartState[122] := 1; fStartState[123] := 1;
fStartState[124] := 22; fStartState[125] := 1; fStartState[126] := 1; fStartState[127] := 1;
fStartState[128] := 1; fStartState[129] := 1; fStartState[130] := 1; fStartState[131] := 1;
fStartState[132] := 1; fStartState[133] := 1; fStartState[134] := 1; fStartState[135] := 1;
fStartState[136] := 1; fStartState[137] := 1; fStartState[138] := 1; fStartState[139] := 1;
fStartState[140] := 1; fStartState[141] := 1; fStartState[142] := 1; fStartState[143] := 1;
fStartState[144] := 1; fStartState[145] := 1; fStartState[146] := 1; fStartState[147] := 1;
fStartState[148] := 1; fStartState[149] := 1; fStartState[150] := 1; fStartState[151] := 1;
fStartState[152] := 1; fStartState[153] := 1; fStartState[154] := 1; fStartState[155] := 1;
fStartState[156] := 1; fStartState[157] := 1; fStartState[158] := 1; fStartState[159] := 1;
fStartState[160] := 1; fStartState[161] := 1; fStartState[162] := 1; fStartState[163] := 1;
fStartState[164] := 1; fStartState[165] := 1; fStartState[166] := 1; fStartState[167] := 1;
fStartState[168] := 1; fStartState[169] := 1; fStartState[170] := 1; fStartState[171] := 1;
fStartState[172] := 1; fStartState[173] := 1; fStartState[174] := 1; fStartState[175] := 1;
fStartState[176] := 1; fStartState[177] := 1; fStartState[178] := 1; fStartState[179] := 1;
fStartState[180] := 1; fStartState[181] := 1; fStartState[182] := 1; fStartState[183] := 1;
fStartState[184] := 1; fStartState[185] := 1; fStartState[186] := 1; fStartState[187] := 1;
fStartState[188] := 1; fStartState[189] := 1; fStartState[190] := 1; fStartState[191] := 1;
fStartState[192] := 1; fStartState[193] := 1; fStartState[194] := 1; fStartState[195] := 1;
fStartState[196] := 1; fStartState[197] := 1; fStartState[198] := 1; fStartState[199] := 1;
fStartState[200] := 1; fStartState[201] := 1; fStartState[202] := 1; fStartState[203] := 1;
fStartState[204] := 1; fStartState[205] := 1; fStartState[206] := 1; fStartState[207] := 1;
fStartState[208] := 1; fStartState[209] := 1; fStartState[210] := 1; fStartState[211] := 1;
fStartState[212] := 1; fStartState[213] := 1; fStartState[214] := 1; fStartState[215] := 1;
fStartState[216] := 1; fStartState[217] := 1; fStartState[218] := 1; fStartState[219] := 1;
fStartState[220] := 1; fStartState[221] := 1; fStartState[222] := 1; fStartState[223] := 1;
fStartState[224] := 1; fStartState[225] := 1; fStartState[226] := 1; fStartState[227] := 1;
fStartState[228] := 1; fStartState[229] := 1; fStartState[230] := 1; fStartState[231] := 1;
fStartState[232] := 1; fStartState[233] := 1; fStartState[234] := 1; fStartState[235] := 1;
fStartState[236] := 1; fStartState[237] := 1; fStartState[238] := 1; fStartState[239] := 1;
fStartState[240] := 1; fStartState[241] := 1; fStartState[242] := 1; fStartState[243] := 1;
fStartState[244] := 1; fStartState[245] := 1; fStartState[246] := 1; fStartState[247] := 1;
fStartState[248] := 1; fStartState[249] := 1; fStartState[250] := 1; fStartState[251] := 1;
fStartState[252] := 1; fStartState[253] := 1; fStartState[254] := 1; fStartState[255] := 1;
end; {Create}
{ --------------------------------------------------------------------------- }
{ ---- implementation for TFFSQL ---- }
constructor TFFSQL.Create(AOwner : TComponent);
begin
inherited;
Scanner := TFFSQLScanner.Create;
GetScanner.Owner := self;
FRootNode := nil;
FReservedWordList := TStringList.Create;
FAllowReservedWordNames := True;
InitSymSet;
end; {Create}
destructor TFFSQL.Destroy;
begin
Scanner.Free;
FReservedWordList.Free;
FReservedWordList := NIL;
inherited;
end; {Destroy}
function TFFSQL.ErrorStr(const ErrorCode : integer; const Data : string) : string;
begin
case ErrorCode of
0 : Result := 'EOF expected';
1 : Result := 'ident expected';
2 : Result := 'integer_ expected';
3 : Result := 'float expected';
4 : Result := 'SQLString expected';
5 : Result := 'SQLNameString expected';
6 : Result := '"NOINDEX" expected';
7 : Result := '"NOREDUCE" expected';
8 : Result := '";" expected';
9 : Result := '"SELECT" expected';
10 : Result := '"ALL" expected';
11 : Result := '"DISTINCT" expected';
12 : Result := '"FROM" expected';
13 : Result := '"WHERE" expected';
14 : Result := '"GROUP" expected';
15 : Result := '"BY" expected';
16 : Result := '"HAVING" expected';
17 : Result := '"ORDER" expected';
18 : Result := '"INSERT" expected';
19 : Result := '"INTO" expected';
20 : Result := '"DEFAULT" expected';
21 : Result := '"VALUES" expected';
22 : Result := '"(" expected';
23 : Result := '")" expected';
24 : Result := '"CROSS" expected';
25 : Result := '"JOIN" expected';
26 : Result := '"NATURAL" expected';
27 : Result := '"INNER" expected';
28 : Result := '"LEFT" expected';
29 : Result := '"OUTER" expected';
30 : Result := '"RIGHT" expected';
31 : Result := '"FULL" expected';
32 : Result := '"UNION" expected';
33 : Result := '"ON" expected';
34 : Result := '"USING" expected';
35 : Result := '"," expected';
36 : Result := '"TABLE" expected';
37 : Result := '"NULL" expected';
38 : Result := '"DELETE" expected';
39 : Result := '"UPDATE" expected';
40 : Result := '"SET" expected';
41 : Result := '"=" expected';
42 : Result := '"ASC" expected';
43 : Result := '"DESC" expected';
44 : Result := '"." expected';
45 : Result := '"*" expected';
46 : Result := '"AS" expected';
47 : Result := '"COUNT" expected';
48 : Result := '"MIN" expected';
49 : Result := '"MAX" expected';
50 : Result := '"SUM" expected';
51 : Result := '"AVG" expected';
52 : Result := '"OR" expected';
53 : Result := '"AND" expected';
54 : Result := '"NOT" expected';
55 : Result := '"<=" expected';
56 : Result := '"<" expected';
57 : Result := '">" expected';
58 : Result := '">=" expected';
59 : Result := '"<>" expected';
60 : Result := '"ANY" expected';
61 : Result := '"SOME" expected';
62 : Result := '"EXISTS" expected';
63 : Result := '"UNIQUE" expected';
64 : Result := '"IS" expected';
65 : Result := '"TRUE" expected';
66 : Result := '"FALSE" expected';
67 : Result := '"UNKNOWN" expected';
68 : Result := '"BETWEEN" expected';
69 : Result := '"LIKE" expected';
70 : Result := '"ESCAPE" expected';
71 : Result := '"IGNORE" expected';
72 : Result := '"CASE" expected';
73 : Result := '"IN" expected';
74 : Result := '"MATCH" expected';
75 : Result := '"PARTIAL" expected';
76 : Result := '"+" expected';
77 : Result := '"-" expected';
78 : Result := '"||" expected';
79 : Result := '"/" expected';
80 : Result := '"CHARACTER_LENGTH" expected';
81 : Result := '"CHAR_LENGTH" expected';
82 : Result := '"COALESCE" expected';
83 : Result := '"CURRENT_DATE" expected';
84 : Result := '"CURRENT_TIME" expected';
85 : Result := '"CURRENT_TIMESTAMP" expected';
86 : Result := '"CURRENT_USER" expected';
87 : Result := '"USER" expected';
88 : Result := '"LOWER" expected';
89 : Result := '"UPPER" expected';
90 : Result := '"POSITION" expected';
91 : Result := '"SESSION_USER" expected';
92 : Result := '"SUBSTRING" expected';
93 : Result := '"FOR" expected';
94 : Result := '"SYSTEM_USER" expected';
95 : Result := '"TRIM" expected';
96 : Result := '"LEADING" expected';
97 : Result := '"TRAILING" expected';
98 : Result := '"BOTH" expected';
99 : Result := '"EXTRACT" expected';
100 : Result := '"YEAR" expected';
101 : Result := '"MONTH" expected';
102 : Result := '"DAY" expected';
103 : Result := '"HOUR" expected';
104 : Result := '"MINUTE" expected';
105 : Result := '"SECOND" expected';
106 : Result := '"NULLIF" expected';
107 : Result := '"ABS" expected';
108 : Result := '"CEILING" expected';
109 : Result := '"FLOOR" expected';
110 : Result := '"EXP" expected';
111 : Result := '"LOG" expected';
112 : Result := '"POWER" expected';
113 : Result := '"RAND" expected';
114 : Result := '"ROUND" expected';
115 : Result := '"ELSE" expected';
116 : Result := '"END" expected';
117 : Result := '"WHEN" expected';
118 : Result := '"THEN" expected';
119 : Result := '"?" expected';
120 : Result := '"DATE" expected';
121 : Result := '"TIME" expected';
122 : Result := '"TIMESTAMP" expected';
123 : Result := '"INTERVAL" expected';
124 : Result := '"TO" expected';
125 : Result := 'not expected';
126 : Result := 'invalid BooleanLiteral';
127 : Result := 'invalid IntervalLiteral';
128 : Result := 'invalid IntervalLiteral';
129 : Result := 'invalid WhenClause';
130 : Result := 'invalid CaseExpression';
131 : Result := 'invalid ScalarFunction';
132 : Result := 'invalid ScalarFunction';
133 : Result := 'invalid ScalarFunction';
134 : Result := 'invalid Literal';
135 : Result := 'invalid Factor';
136 : Result := 'invalid Factor';
137 : Result := 'invalid IsTest';
138 : Result := 'invalid InClause';
139 : Result := 'invalid AllOrAnyClause';
140 : Result := 'invalid CondPrimary';
141 : Result := 'invalid CondPrimary';
142 : Result := 'invalid CondPrimary';
143 : Result := 'invalid CondPrimary';
144 : Result := 'invalid CondPrimary';
145 : Result := 'invalid FieldRef';
146 : Result := 'invalid Aggregate';
147 : Result := 'invalid Aggregate';
148 : Result := 'invalid Selection';
149 : Result := 'invalid OrderItem';
150 : Result := 'invalid UpdateItem';
151 : Result := 'invalid ValueItem';
152 : Result := 'invalid NonJoinTablePrimary';
153 : Result := 'invalid JoinTableExp';
154 : Result := 'invalid SimpleTableRefOrParenTableExp';
155 : Result := 'invalid SQLName';
156 : Result := 'invalid InsertStatement';
157 : Result := 'invalid TableExp';
158 : Result := 'invalid FFSQL';
200 : Result := 'Text after end of valid sql statement';
201 : Result := 'Nested aggregates are not allowed';
202 : Result := 'Aggregates may not appear in a WHERE clause';
203 : Result := 'Reserved word (' + data + ') not allowed';
else
if Assigned(OnCustomError) then
Result := OnCustomError(Self, ErrorCode, Data)
else
begin
Result := 'Error: ' + IntToStr(ErrorCode);
if Trim(Data) > '' then
Result := Result + ' (' + Data + ')';
end;
end; {case nr}
end; {ErrorStr}
procedure TFFSQL.Execute;
begin
ClearErrors;
ListStream.Clear;
Extra := 1;
{ if there is a file name then load the file }
if Trim(SourceFileName) <> '' then
begin
GetScanner.SrcStream.Clear;
GetScanner.SrcStream.LoadFromFile(SourceFileName);
end;
{ install error reporting procedure }
GetScanner.ScannerError := StoreError;
{ instigate the compilation }
DoBeforeParse;
Parse;
DoAfterParse;
{ generate the source listing to the ListStream }
if (GenListWhen = glAlways) OR ((GenListWhen = glOnError) AND (ErrorList.Count > 0)) then
GenerateListing;
if ClearSourceStream then
GetScanner.SrcStream.Clear;
ListStream.Position := 0; // goto the beginning of the stream
if Successful AND Assigned(OnSuccess) then
OnSuccess(Self);
if (NOT Successful) AND Assigned(OnFailure) then
OnFailure(Self, ErrorList.Count);
end; {Execute}
procedure TFFSQL.Get;
begin
repeat
GetScanner.Get(fCurrentInputSymbol);
if fCurrentInputSymbol <= maxT then
errDist := errDist + 1
else
begin
end;
until fCurrentInputSymbol <= maxT;
if Assigned(AfterGet) then
AfterGet(Self, fCurrentInputSymbol);
end; {Get}
function TFFSQL.GetScanner : TFFSQLScanner;
begin
Result := Scanner AS TFFSQLScanner;
end; {GetScanner}
function TFFSQL._In(var s : SymbolSet; x : integer) : boolean;
begin
_In := x mod setsize in s[x div setsize];
end; {_In}
procedure TFFSQL._SimpleAlias (var TableRef: TffSqlTableRef);var aSQLName: string;
begin
if (fCurrentInputSymbol = ASSym) then begin
Get;
end;
_SQLName(aSQLName);
TableRef.Alias := aSQLName;
end;
procedure TFFSQL._BooleanLiteral (Parent: TFFSqlNode; var BooleanLiteral: TFFSqlBooleanLiteral);begin
BooleanLiteral := TFFSqlBooleanLiteral.Create(Parent);
if (fCurrentInputSymbol = TRUESym) then begin
Get;
BooleanLiteral.Value := True;
end else if (fCurrentInputSymbol = FALSESym) then begin
Get;
end else begin SynError(126);
end;
end;
procedure TFFSQL._IntervalLiteral (Parent: TFFSqlNode;
var IntervalLiteral: TFFSqlIntervalLiteral);begin
IntervalLiteral := TFFSqlIntervalLiteral.Create(Parent);
Expect(INTERVALSym);
IntervalLiteral.StartDef := iUnspec;
Expect(SQLStringSym);
IntervalLiteral.Value := LexString;
case fCurrentInputSymbol of
YEARSym : begin
Get;
IntervalLiteral.StartDef := iYear;
end;
MONTHSym : begin
Get;
IntervalLiteral.StartDef := iMonth;
end;
DAYSym : begin
Get;
IntervalLiteral.StartDef := iDay;
end;
HOURSym : begin
Get;
IntervalLiteral.StartDef := iHour;
end;
MINUTESym : begin
Get;
IntervalLiteral.StartDef := iMinute;
end;
SECONDSym : begin
Get;
IntervalLiteral.StartDef := iSecond;
end;
else begin SynError(127);
end;
end;
IntervalLiteral.EndDef := iUnspec;
if (fCurrentInputSymbol = TOSym) then begin
Get;
case fCurrentInputSymbol of
YEARSym : begin
Get;
IntervalLiteral.EndDef := iYear;
end;
MONTHSym : begin
Get;
IntervalLiteral.EndDef := iMonth;
end;
DAYSym : begin
Get;
IntervalLiteral.EndDef := iDay;
end;
HOURSym : begin
Get;
IntervalLiteral.EndDef := iHour;
end;
MINUTESym : begin
Get;
IntervalLiteral.EndDef := iMinute;
end;
SECONDSym : begin
Get;
IntervalLiteral.EndDef := iSecond;
end;
else begin SynError(128);
end;
end;
end;
end;
procedure TFFSQL._TimestampLiteral (Parent: TFFSqlNode;
var TimestampLiteral: TFFSqlTimestampLiteral);begin
TimestampLiteral := TFFSqlTimestampLiteral.Create(Parent);
Expect(TIMESTAMPSym);
Expect(SQLStringSym);
TimestampLiteral.Value := LexString;
end;
procedure TFFSQL._TimeLiteral (Parent: TFFSqlNode;
var TimeLiteral: TFFSqlTimeLiteral);begin
TimeLiteral := TFFSqlTimeLiteral.Create(Parent);
Expect(TIMESym);
Expect(SQLStringSym);
TimeLiteral.Value := LexString;
end;
procedure TFFSQL._DateLiteral (Parent: TFFSqlNode;
var DateLiteral: TFFSqlDateLiteral);begin
DateLiteral := TFFSqlDateLiteral.Create(Parent);
Expect(DATESym);
Expect(SQLStringSym);
DateLiteral.Value := LexString;
end;
procedure TFFSQL._StringLiteral (Parent: TFFSqlNode;
var StringLiteral: TFFSqlStringLiteral);begin
StringLiteral := TFFSqlStringLiteral.Create(Parent);
Expect(SQLStringSym);
StringLiteral.Value := LexString;
end;
procedure TFFSQL._IntegerLiteral (Parent: TFFSqlNode;
var IntegerLiteral: TFFSqlIntegerLiteral);begin
IntegerLiteral := TFFSqlIntegerLiteral.Create(Parent);
Expect(integer_Sym);
IntegerLiteral.Value := LexString;
end;
procedure TFFSQL._FloatLiteral (Parent: TFFSqlNode;
var FloatLiteral: TFFSqlFloatLiteral);begin
FloatLiteral := TFFSqlFloatLiteral.Create(Parent);
Expect(floatSym);
FloatLiteral.Value := LexString;
end;
procedure TFFSQL._WhenClause (Parent : TFFSqlNode;
var WhenClause : TFFSqlWhenClause);var CondExp : TFFSqlCondExp;
Exp : TFFSqlSimpleExpression;
begin
WhenClause := TFFSqlWhenClause.Create(Parent);
Expect(WHENSym);
_CondExp(WhenClause, CondExp);
WhenClause.WhenExp := CondExp;
Expect(THENSym);
if (fCurrentInputSymbol = NULLSym) then begin
Get;
end else if _In(symSet[1], fCurrentInputSymbol) then begin
_SimpleExpression(WhenClause, Exp);
WhenClause.ThenExp := Exp;
end else begin SynError(129);
end;
end;
procedure TFFSQL._WhenClauseList (Parent: TFFSqlNode;
var WhenClauseList : TFFSqlWhenClauseList);var WhenClause : TFFSqlWhenClause;
begin
WhenClauseList := TFFSqlWhenClauseList.Create(Parent);
_WhenClause(WhenClauseList, WhenClause);
WhenClauseList.AddWhenClause(WhenClause);
while (fCurrentInputSymbol = WHENSym) do begin
_WhenClause(WhenClauseList, WhenClause);
WhenClauseList.AddWhenClause(WhenClause);
end;
end;
procedure TFFSQL._CoalesceExpression (Parent: TFFSqlNode;
var CoalesceExp: TFFSqlCoalesceExpression);var Exp : TFFSqlSimpleExpression;
begin
CoalesceExp := TFFSqlCoalesceExpression.Create(Parent);
Expect(_lparenSym);
_SimpleExpression(CoalesceExp, Exp);
CoalesceExp.AddArg(Exp);
while (fCurrentInputSymbol = _commaSym) do begin
Get;
_SimpleExpression(CoalesceExp, Exp);
CoalesceExp.AddArg(Exp);
end;
Expect(_rparenSym);
end;
procedure TFFSQL._CaseExpression (Parent: TFFSqlNode;
var CaseExp: TFFSqlCaseExpression);var WhenClauseList : TFFSqlWhenClauseList;
var Exp : TFFSqlSimpleExpression;
begin
CaseExp := TFFSqlCaseExpression.Create(Parent);
_WhenClauseList(CaseExp, WhenClauseList);
CaseExp.WhenClauseList := WhenClauseList;
if (fCurrentInputSymbol = ELSESym) then begin
Get;
if (fCurrentInputSymbol = NULLSym) then begin
Get;
end else if _In(symSet[1], fCurrentInputSymbol) then begin
_SimpleExpression(CaseExp, Exp);
CaseExp.ElseExp := Exp;
end else begin SynError(130);
end;
end;
Expect(ENDSym);
end;
procedure TFFSQL._ScalarFunction (Parent: TFFSqlNode;
var Func: TFFSqlScalarFunc);var Exp : TFFSqlSimpleExpression;
var CaseExp : TFFSqlCaseExpression;
var CoalesceExp : TFFSqlCoalesceExpression;
begin
Func := TFFSqlScalarFunc.Create(Parent);
case fCurrentInputSymbol of
CASESym : begin
Get;
_CaseExpression(Func, CaseExp);
Func.CaseExp := CaseExp;
Func.SQLFunction := sfCase;
end;
CHARACTER_underscoreLENGTHSym, CHAR_underscoreLENGTHSym : begin
if (fCurrentInputSymbol = CHARACTER_underscoreLENGTHSym) then begin
Get;
end else begin
Get;
end;
Expect(_lparenSym);
_SimpleExpression(Func, Exp);
Expect(_rparenSym);
Func.SQLFunction := sfCharLen;
Func.Arg1 := Exp;
end;
COALESCESym : begin
Get;
_CoalesceExpression(Func, CoalesceExp);
Func.CoalesceExp := CoalesceExp;
Func.SQLFunction := sfCoalesce;
end;
CURRENT_underscoreDATESym : begin
Get;
Func.SQLFunction := sfCurrentDate;
end;
CURRENT_underscoreTIMESym : begin
Get;
Func.SQLFunction := sfCurrentTime;
end;
CURRENT_underscoreTIMESTAMPSym : begin
Get;
Func.SQLFunction := sfCurrentTimestamp;
end;
CURRENT_underscoreUSERSym, USERSym : begin
if (fCurrentInputSymbol = CURRENT_underscoreUSERSym) then begin
Get;
end else begin
Get;
end;
Func.SQLFunction := sfCurrentUser;
end;
LOWERSym : begin
Get;
Expect(_lparenSym);
_SimpleExpression(Func, Exp);
Expect(_rparenSym);
Func.SQLFunction := sfLower;
Func.Arg1 := Exp
end;
UPPERSym : begin
Get;
Expect(_lparenSym);
_SimpleExpression(Func, Exp);
Expect(_rparenSym);
Func.SQLFunction := sfUpper;
Func.Arg1 := Exp;
end;
POSITIONSym : begin
Get;
Expect(_lparenSym);
_SimpleExpression(Func, Exp);
Func.SQLFunction := sfPosition;
Func.Arg1 := Exp;
if (fCurrentInputSymbol = _commaSym) then begin
Get;
end else if (fCurrentInputSymbol = INSym) then begin
Get;
end else begin SynError(131);
end;
_SimpleExpression(Func, Exp);
Func.Arg2 := Exp;
Expect(_rparenSym);
end;
SESSION_underscoreUSERSym : begin
Get;
Func.SQLFunction := sfSessionUser;
end;
SUBSTRINGSym : begin
Get;
Expect(_lparenSym);
_SimpleExpression(Func, Exp);
Func.SQLFunction := sfSubstring;
Func.Arg1 := Exp;
Expect(FROMSym);
_SimpleExpression(Func, Exp);
Func.Arg2 := Exp;
if (fCurrentInputSymbol = FORSym) then begin
Get;
_SimpleExpression(Func, Exp);
Func.Arg3 := Exp;
end;
Expect(_rparenSym);
end;
SYSTEM_underscoreUSERSym : begin
Get;
Func.SQLFunction := sfSystemUser;
end;
TRIMSym : begin
Get;
Expect(_lparenSym);
Func.SQLFunction := sfTrim;
Func.LTB := ltbBoth;
if (fCurrentInputSymbol = LEADINGSym) OR
(fCurrentInputSymbol = TRAILINGSym) OR
(fCurrentInputSymbol = BOTHSym) then begin
if (fCurrentInputSymbol = LEADINGSym) then begin
Get;
Func.LTB := ltbLeading;
end else if (fCurrentInputSymbol = TRAILINGSym) then begin
Get;
Func.LTB := ltbTrailing;
end else begin
Get;
end;
end;
if _In(symSet[1], fCurrentInputSymbol) then begin
_SimpleExpression(Func, Exp);
Func.Arg1 := Exp;
end;
if (fCurrentInputSymbol = FROMSym) then begin
Get;
_SimpleExpression(Func, Exp);
Func.Arg2 := Exp
end;
Expect(_rparenSym);
end;
EXTRACTSym : begin
Get;
Expect(_lparenSym);
Func.SQLFunction := sfExtract;
case fCurrentInputSymbol of
YEARSym : begin
Get;
Func.xDef := iYear;
end;
MONTHSym : begin
Get;
Func.xDef := iMonth;
end;
DAYSym : begin
Get;
Func.xDef := iDay;
end;
HOURSym : begin
Get;
Func.xDef := iHour;
end;
MINUTESym : begin
Get;
Func.xDef := iMinute;
end;
SECONDSym : begin
Get;
Func.xDef := iSecond;
end;
else begin SynError(132);
end;
end;
Expect(FROMSym);
_SimpleExpression(Func, Exp);
Func.Arg1 := Exp;
Expect(_rparenSym);
end;
NULLIFSym : begin
Get;
Expect(_lparenSym);
Func.SQLFunction := sfNullIf;
_SimpleExpression(Func, Exp);
Func.Arg1 := Exp;
Expect(_commaSym);
_SimpleExpression(Func, Exp);
Func.Arg2 := Exp;
Expect(_rparenSym);
end;
ABSSym : begin
Get;
Expect(_lparenSym);
Func.SQLFunction := sfAbs;
_SimpleExpression(Func, Exp);
Func.Arg1 := Exp;
Expect(_rparenSym);
end;
CEILINGSym : begin
Get;
Expect(_lparenSym);
Func.SQLFunction := sfCeil;
_SimpleExpression(Func, Exp);
Func.Arg1 := Exp;
Expect(_rparenSym);
end;
FLOORSym : begin
Get;
Expect(_lparenSym);
Func.SQLFunction := sfFloor;
_SimpleExpression(Func, Exp);
Func.Arg1 := Exp;
Expect(_rparenSym);
end;
EXPSym : begin
Get;
Expect(_lparenSym);
Func.SQLFunction := sfExp;
_SimpleExpression(Func, Exp);
Func.Arg1 := Exp;
Expect(_rparenSym);
end;
LOGSym : begin
Get;
Expect(_lparenSym);
Func.SQLFunction := sfLog;
_SimpleExpression(Func, Exp);
Func.Arg1 := Exp;
Expect(_rparenSym);
end;
POWERSym : begin
Get;
Expect(_lparenSym);
Func.SQLFunction := sfPower;
_SimpleExpression(Func, Exp);
Func.Arg1 := Exp;
Expect(_commaSym);
_SimpleExpression(Func, Exp);
Func.Arg2 := Exp;
Expect(_rparenSym);
end;
RANDSym : begin
Get;
Func.SQLFunction := sfRand;
end;
ROUNDSym : begin
Get;
Expect(_lparenSym);
Func.SQLFunction := sfRound;
_SimpleExpression(Func, Exp);
Func.Arg1 := Exp;
Expect(_rparenSym);
end;
else begin SynError(133);
end;
end;
end;
procedure TFFSQL._Param (Parent: TFFSqlNode;
var Param: TFFSqlParam);begin
Param := TFFSqlParam.Create(Parent);
Expect(_querySym);
end;
procedure TFFSQL._Literal (Parent: TFFSqlNode;
var Literal: TFFSqlLiteral);var FloatLiteral : TFFSqlFloatLiteral;
var IntegerLiteral : TFFSqlIntegerLiteral;
var StringLiteral : TFFSqlStringLiteral;
var DateLiteral : TFFSqlDateLiteral;
var TimeLiteral : TFFSqlTimeLiteral;
var TimestampLiteral : TFFSqlTimestampLiteral;
var IntervalLiteral : TFFSqlIntervalLiteral;
var BooleanLiteral : TFFSqlBooleanLiteral;
begin
Literal := TFFSqlLiteral.Create(Parent);
case fCurrentInputSymbol of
floatSym : begin
_FloatLiteral(Literal, FloatLiteral);
Literal.FloatLiteral := FloatLiteral;
end;
integer_Sym : begin
_IntegerLiteral(Literal, IntegerLiteral);
Literal.IntegerLiteral := IntegerLiteral;
end;
SQLStringSym : begin
_StringLiteral(Literal, StringLiteral);
Literal.StringLiteral := StringLiteral;
end;
DATESym : begin
_DateLiteral(Literal, DateLiteral);
Literal.DateLiteral := DateLiteral;
end;
TIMESym : begin
_TimeLiteral(Literal, TimeLiteral);
Literal.TimeLiteral := TimeLiteral;
end;
TIMESTAMPSym : begin
_TimestampLiteral(Literal, TimestampLiteral);
Literal.TimestampLiteral := TimestampLiteral;
end;
INTERVALSym : begin
_IntervalLiteral(Literal, IntervalLiteral);
Literal.IntervalLiteral := IntervalLiteral;
end;
TRUESym, FALSESym : begin
_BooleanLiteral(Literal, BooleanLiteral);
Literal.BooleanLiteral := BooleanLiteral;
end;
else begin SynError(134);
end;
end;
end;
procedure TFFSQL._Factor (Parent: TFFSqlNode;
var Factor : TFFSqlFactor;
MulOp: TFFSqlMulOp);var FieldRef : TFFSqlFieldRef;
var CondExp : TFFSqlCondExp;
var Literal : TFFSqlLiteral;
var Param : TFFSqlParam;
var Select : TFFSqlSELECT;
var Agg : TFFSqlAggregate;
var Func : TFFSqlScalarFunc;
begin
Factor := TFFSqlFactor.Create(Parent);
Factor.MulOp := MulOp;
if (fCurrentInputSymbol = _minusSym) then begin
Get;
Factor.UnaryMinus := True;
end;
case fCurrentInputSymbol of
_lparenSym : begin
Get;
if _In(symSet[2], fCurrentInputSymbol) then begin
_CondExp(Factor, CondExp);
Factor.CondExp := CondExp;
end else if (fCurrentInputSymbol = SELECTSym) then begin
_SelectStatement(Factor, Select);
Factor.SubQuery := Select;
end else begin SynError(135);
end;
Expect(_rparenSym);
end;
identSym, SQLNameStringSym : begin
_FieldRef(Factor, FieldRef);
Factor.FieldRef := FieldRef;
end;
integer_Sym, floatSym, SQLStringSym, TRUESym, FALSESym, DATESym, TIMESym,
TIMESTAMPSym, INTERVALSym : begin
_Literal(Factor, Literal);
Factor.Literal := Literal;
end;
_querySym : begin
_Param(Factor, Param);
Factor.Param := Param;
end;
COUNTSym, MINSym, MAXSym, SUMSym, AVGSym : begin
_Aggregate(Factor, Agg);
Factor.Aggregate := Agg;
end;
CASESym, CHARACTER_underscoreLENGTHSym, CHAR_underscoreLENGTHSym, COALESCESym, CURRENT_underscoreDATESym, CURRENT_underscoreTIMESym, CURRENT_underscoreTIMESTAMPSym,
CURRENT_underscoreUSERSym, USERSym, LOWERSym, UPPERSym, POSITIONSym, SESSION_underscoreUSERSym, SUBSTRINGSym, SYSTEM_underscoreUSERSym,
TRIMSym, EXTRACTSym, NULLIFSym, ABSSym, CEILINGSym, FLOORSym, EXPSym, LOGSym,
POWERSym, RANDSym, ROUNDSym : begin
_ScalarFunction(Factor, Func);
Factor.ScalarFunc := Func;
end;
else begin SynError(136);
end;
end;
end;
procedure TFFSQL._Term (Parent: TFFSqlNode; var Term : TFFSqlTerm; AddOp : TFFSqlAddOp);var Factor : TFFSqlFactor;
var MO : TFFSqlMulOp;
begin
Term := TFFSqlTerm.Create(Parent);
Term.AddOp := AddOp;
_Factor(Term, Factor, moMul);
Term.AddFactor(Factor);
while (fCurrentInputSymbol = _starSym) OR
(fCurrentInputSymbol = _slashSym) do begin
if (fCurrentInputSymbol = _starSym) then begin
Get;
MO := moMul;
end else begin
Get;
MO := moDiv;
end;
_Factor(Term, Factor, MO);
Term.AddFactor(Factor);
end;
end;
procedure TFFSQL._SimpleExpressionList (Parent: TFFSqlNode;
var SimpleExpressionList: TFFSqlSimpleExpressionList);var SimpleExpression : TFFSqlSimpleExpression;
begin
SimpleExpressionList := TFFSqlSimpleExpressionList.Create(Parent);
_SimpleExpression(SimpleExpressionList, SimpleExpression);
SimpleExpressionList.AddExpression(SimpleExpression);
while (fCurrentInputSymbol = _commaSym) do begin
Get;
_SimpleExpression(SimpleExpressionList, SimpleExpression);
SimpleExpressionList.AddExpression(SimpleExpression);
end;
end;
procedure TFFSQL._IsTest (Parent: TFFSqlNode;
var IsTest: TFFSqlIsTest);begin
Expect(ISSym);
IsTest := TFFSqlIsTest.Create(Parent);
if (fCurrentInputSymbol = NOTSym) then begin
Get;
IsTest.UnaryNot := True;
end;
if (fCurrentInputSymbol = NULLSym) then begin
Get;
IsTest.IsOp := ioNull;
end else if (fCurrentInputSymbol = TRUESym) then begin
Get;
IsTest.IsOp := ioTrue;
end else if (fCurrentInputSymbol = FALSESym) then begin
Get;
IsTest.IsOp := ioFalse;
end else if (fCurrentInputSymbol = UNKNOWNSym) then begin
Get;
IsTest.IsOp := ioUnknown;
end else begin SynError(137);
end;
end;
procedure TFFSQL._MatchClause (Parent: TFFSqlNode;
var MatchClause: TFFSqlMatchClause);var Select : TFFSqlSelect;
begin
MatchClause := TFFSqlMatchClause.Create(Parent);
Expect(MATCHSym);
if (fCurrentInputSymbol = UNIQUESym) then begin
Get;
MatchClause.Unique := True;
end;
MatchClause.Option := moUnspec;
if (fCurrentInputSymbol = FULLSym) OR
(fCurrentInputSymbol = PARTIALSym) then begin
if (fCurrentInputSymbol = PARTIALSym) then begin
Get;
MatchClause.Option := moPartial;
end else begin
Get;
MatchClause.Option := moFull;
end;
end;
Expect(_lparenSym);
_SelectStatement(MatchClause, Select);
MatchClause.SubQuery := Select;
Expect(_rparenSym);
end;
procedure TFFSQL._InClause (Parent: TFFSqlNode;
var InClause: TFFSqlInClause;
Negated: Boolean);var SimpleExpressionList : TFFSqlSimpleExpressionList;
var Select : TFFSqlSelect;
begin
InClause := TFFSqlInClause.Create(Parent);
InClause.Negated := Negated;
Expect(INSym);
Expect(_lparenSym);
if (fCurrentInputSymbol = SELECTSym) then begin
_SelectStatement(InClause, Select);
InClause.SubQuery := Select;
end else if _In(symSet[1], fCurrentInputSymbol) then begin
_SimpleExpressionList(InClause, SimpleExpressionList);
Inclause.SimpleExpList := SimpleExpressionList;
end else begin SynError(138);
end;
Expect(_rparenSym);
end;
procedure TFFSQL._LikeClause (Parent: TFFSqlNode;
var LikeClause: TFFSqlLikeClause;
Negated: Boolean);var SimpleExpression : TFFSqlSimpleExpression;
begin
LikeClause := TFFSqlLikeClause.Create(Parent);
LikeClause.Negated := Negated;
Expect(LIKESym);
_SimpleExpression(LikeClause, SimpleExpression);
LikeClause.SimpleExp := SimpleExpression;
if (fCurrentInputSymbol = ESCAPESym) then begin
Get;
_SimpleExpression(LikeClause, SimpleExpression);
LikeClause.EscapeExp := SimpleExpression;
end;
if (fCurrentInputSymbol = IGNORESym) then begin
Get;
Expect(CASESym);
LikeClause.IgnoreCase := True;
end;
end;
procedure TFFSQL._BetweenClause (Parent: TFFSqlNode;
var BetweenClause: TFFSqlBetweenClause;
Negated: Boolean);var SimpleExpression : TFFSqlSimpleExpression;
begin
BetweenClause := TFFSqlBetweenClause.Create(Parent);
BetweenClause.Negated := Negated;
Expect(BETWEENSym);
_SimpleExpression(BetweenClause, SimpleExpression);
BetweenClause.SimpleLow := SimpleExpression;
Expect(ANDSym);
_SimpleExpression(BetweenClause, SimpleExpression);
BetweenClause.SimpleHigh := SimpleExpression;
end;
procedure TFFSQL._AllOrAnyClause (Parent: TFFSqlNode;
var AllOrAny: TFFSqlAllOrAnyClause);var Select : TFFSqlSelect;
begin
AllOrAny := TFFSqlAllOrAnyClause.Create(Parent);
if (fCurrentInputSymbol = ALLSym) then begin
Get;
AllOrAny.All := True;
end else if (fCurrentInputSymbol = ANYSym) then begin
Get;
end else if (fCurrentInputSymbol = SOMESym) then begin
Get;
end else begin SynError(139);
end;
Expect(_lparenSym);
_SelectStatement(AllOrAny, Select);
AllOrAny.SubQuery := Select;
Expect(_rparenSym);
end;
procedure TFFSQL._UniqueClause (Parent: TFFSqlNode;
var Unique: TFFSqlUniqueClause);var TableExp : TFFSqlTableExp;
begin
Unique := TFFSqlUniqueClause.Create(Parent);
Expect(UNIQUESym);
Expect(_lparenSym);
_TableExp(Unique, TableExp);
Unique.SubQuery := TableExp;
Expect(_rparenSym);
end;
procedure TFFSQL._ExistsClause (Parent: TFFSqlNode;
var Exists: TFFSqlExistsClause);var Select : TFFSqlSelect;
begin
Exists := TFFSqlExistsClause.Create(Parent);
Expect(EXISTSSym);
Expect(_lparenSym);
_SelectStatement(Exists, Select);
Exists.SubQuery := Select;
Expect(_rparenSym);
end;
procedure TFFSQL._CondPrimary (Parent: TFFSqlNode;
var CondPrimary : TFFSqlCondPrimary);var SimpleExpression : TFFSqlSimpleExpression;
var RelOp : TFFSqlRelop;
var BetweenClause : TFFSqlBetweenClause;
var LikeClause : TFFSqlLikeClause;
var InClause : TFFSqlInClause;
var IsTest: TFFSqlIsTest;
var AllOrAny : TFFSqlAllOrAnyClause;
var ExistsClause : TFFSqlExistsClause;
var UniqueClause : TFFSqlUniqueClause;
var MatchClause : TFFSqlMatchClause;
begin
CondPrimary := TFFSqlCondPrimary.Create(Parent);
RelOp := roNone;
if (fCurrentInputSymbol = EXISTSSym) then begin
_ExistsClause(CondPrimary, ExistsClause);
CondPrimary.ExistsClause := ExistsClause;
end else if (fCurrentInputSymbol = UNIQUESym) then begin
_UniqueClause(CondPrimary, UniqueClause);
CondPrimary.UniqueClause := UniqueClause;
end else if _In(symSet[1], fCurrentInputSymbol) then begin
_SimpleExpression(CondPrimary, SimpleExpression);
CondPrimary.SimpleExp1 := SimpleExpression;
if _In(symSet[3], fCurrentInputSymbol) then begin
if _In(symSet[4], fCurrentInputSymbol) then begin
case fCurrentInputSymbol of
_equalSym, _less_equalSym, _lessSym, _greaterSym, _greater_equalSym, _less_greaterSym : begin
case fCurrentInputSymbol of
_equalSym : begin
Get;
RelOp := roEQ;
end;
_less_equalSym : begin
Get;
RelOp := roLE;
end;
_lessSym : begin
Get;
RelOp := roL;
end;
_greaterSym : begin
Get;
RelOp := roG;
end;
_greater_equalSym : begin
Get;
RelOp := roGE;
end;
_less_greaterSym : begin
Get;
RelOp := roNE;
end;
else begin SynError(140);
end;
end;
CondPrimary.RelOp := RelOp;
if (fCurrentInputSymbol = ALLSym) OR
(fCurrentInputSymbol = ANYSym) OR
(fCurrentInputSymbol = SOMESym) then begin
_AllOrAnyClause(CondPrimary, AllOrAny);
CondPrimary.AllOrAnyClause := AllOrAny;
end else if _In(symSet[1], fCurrentInputSymbol) then begin
_SimpleExpression(CondPrimary, SimpleExpression);
CondPrimary.SimpleExp2 := SimpleExpression;
end else begin SynError(141);
end;
end;
BETWEENSym : begin
_BetweenClause(CondPrimary, BetweenClause, False);
CondPrimary.BetweenClause := BetweenClause;
end;
LIKESym : begin
_LikeClause(CondPrimary, LikeClause, False);
CondPrimary.LikeClause := LikeClause;
end;
INSym : begin
_InClause(CondPrimary, InClause, False);
CondPrimary.InClause := InClause;
end;
MATCHSym : begin
_MatchClause(CondPrimary, MatchClause);
CondPrimary.MatchClause := MatchClause;
end;
NOTSym : begin
Get;
if (fCurrentInputSymbol = BETWEENSym) then begin
_BetweenClause(CondPrimary, BetweenClause, True);
CondPrimary.BetweenClause := BetweenClause;
end else if (fCurrentInputSymbol = LIKESym) then begin
_LikeClause(CondPrimary, LikeClause, True);
CondPrimary.LikeClause := LikeClause;
end else if (fCurrentInputSymbol = INSym) then begin
_InClause(CondPrimary, InClause, True);
CondPrimary.InClause := InClause;
end else begin SynError(142);
end;
end;
else begin SynError(143);
end;
end;
end else begin
_IsTest(CondPrimary, IsTest);
CondPrimary.IsTest := IsTest;
CondPrimary.RelOp := RoNone;
end;
end;
end else begin SynError(144);
end;
end;
procedure TFFSQL._CondFactor (Parent: TFFSqlNode;
var CondFactor: TFFSqlCondFactor);var CondPrimary : TFFSqlCondPrimary;
begin
CondFactor := TFFSqlCondFactor.Create(Parent);
if (fCurrentInputSymbol = NOTSym) then begin
Get;
CondFactor.UnaryNot := True;
end;
_CondPrimary(CondFactor, CondPrimary);
CondFactor.CondPrimary := CondPrimary;
end;
procedure TFFSQL._CondTerm (Parent: TFFSqlNode;
var CondTerm : TFFSqlCondTerm);var CondFactor : TFFSqlCondFactor;
begin
CondTerm := TFFSqlCondTerm.Create(Parent);
_CondFactor(CondTerm, CondFactor);
CondTerm.AddCondFactor(CondFactor);
while (fCurrentInputSymbol = ANDSym) do begin
Get;
_CondFactor(CondTerm, CondFactor);
CondTerm.AddCondFactor(CondFactor);
end;
end;
procedure TFFSQL._GroupColumn (Parent: TFFSqlNode;
var Col : TFFSqlGroupColumn);var
aSQLName : string;
begin
Col := TFFSqlGroupColumn.Create(Parent);
aSQLName := '';
_SQLName(aSQLName);
if (fCurrentInputSymbol = _pointSym) then begin
Get;
Col.TableName := aSQLName;
_SQLName(aSQLName);
end;
Col.FieldName := aSQLName;
end;
procedure TFFSQL._FieldRef (Parent: TFFSqlNode; var FieldRef: TFFSqlFieldRef);var
aSQLName : string;
begin
FieldRef := TFFSqlFieldRef.Create(Parent);
aSQLName := '';
_SQLName(aSQLName);
if (fCurrentInputSymbol = _pointSym) then begin
Get;
FieldRef.TableName := aSQLName;
if (fCurrentInputSymbol = identSym) OR
(fCurrentInputSymbol = SQLNameStringSym) then begin
_SQLName(aSQLName);
end else if (fCurrentInputSymbol = _starSym) then begin
Get;
aSQLName := '';
end else begin SynError(145);
end;
end;
FieldRef.FieldName := aSQLName;
end;
procedure TFFSQL._Aggregate (Parent: TFFSqlNode; var Aggregate : TFFSqlAggregate);var SimpleExpression : TFFSqlSimpleExpression;
begin
if Parent.OwnerSelect.InWhere then
SynError(202);
Aggregate := TFFSqlAggregate.Create(Parent);
if (fCurrentInputSymbol = COUNTSym) then begin
Get;
Aggregate.AgFunction := agCount;
Expect(_lparenSym);
if (fCurrentInputSymbol = _starSym) then begin
Get;
end else if _In(symSet[5], fCurrentInputSymbol) then begin
if (fCurrentInputSymbol = ALLSym) OR
(fCurrentInputSymbol = DISTINCTSym) then begin
if (fCurrentInputSymbol = ALLSym) then begin
Get;
end else begin
Get;
Aggregate.Distinct := True;
end;
end;
_SimpleExpression(Aggregate, SimpleExpression);
Aggregate.SimpleExpression := SimpleExpression;
end else begin SynError(146);
end;
Expect(_rparenSym);
end else if (fCurrentInputSymbol = MINSym) OR
(fCurrentInputSymbol = MAXSym) OR
(fCurrentInputSymbol = SUMSym) OR
(fCurrentInputSymbol = AVGSym) then begin
if (fCurrentInputSymbol = MINSym) then begin
Get;
Aggregate.AgFunction := agMin;
end else if (fCurrentInputSymbol = MAXSym) then begin
Get;
Aggregate.AgFunction := agMax;
end else if (fCurrentInputSymbol = SUMSym) then begin
Get;
Aggregate.AgFunction := agSum;
end else begin
Get;
Aggregate.AgFunction := agAvg;
end;
Expect(_lparenSym);
if (fCurrentInputSymbol = ALLSym) OR
(fCurrentInputSymbol = DISTINCTSym) then begin
if (fCurrentInputSymbol = ALLSym) then begin
Get;
end else begin
Get;
Aggregate.Distinct := True;
end;
end;
_SimpleExpression(Aggregate, SimpleExpression);
Aggregate.SimpleExpression := SimpleExpression;
if Aggregate.SimpleExpression.IsAggregateExpression then
SynError(201);
Expect(_rparenSym);
end else begin SynError(147);
end;
end;
procedure TFFSQL._Column (Parent: TFFSqlNode;
var Col : TFFSqlColumn);var ColumnName : string;
begin
Col := TFFSqlColumn.Create(Parent);
_SQLName(ColumnName);
Col.ColumnName := ColumnName;
end;
procedure TFFSQL._ColumnAlias (var Selection : TFFSqlSelection);var Col : TFFSqlColumn;
begin
if (fCurrentInputSymbol = ASSym) then begin
Get;
end;
_Column(Selection, Col);
Selection.Column := Col;
end;
procedure TFFSQL._Selection (SelectionList: TFFSqlSelectionList);var Selection : TFFSqlSelection;
var Exp : TFFSqlSimpleExpression;
var Term: TFFSqlTerm;
var Factor: TFFSqlFactor;
var FieldRef: TFFSqlFieldRef;
begin
Selection := TFFSqlSelection.Create(SelectionList);
if (fCurrentInputSymbol = _starSym) then begin
Get;
Exp := TFFSqlSimpleExpression.Create(Selection);
Term := TFFSqlTerm.Create(Exp);
Factor := TFFSqlFactor.Create(Term);
FieldRef := TFFSqlFieldRef.Create(Factor);
Factor.FieldRef := FieldRef;
Term.AddFactor(Factor);
Exp.AddTerm(Term);
Selection.SimpleExpression := Exp;
end else if _In(symSet[1], fCurrentInputSymbol) then begin
_SimpleExpression(Selection, Exp);
Selection.SimpleExpression := Exp;
if (fCurrentInputSymbol = identSym) OR
(fCurrentInputSymbol = SQLNameStringSym) OR
(fCurrentInputSymbol = ASSym) then begin
_ColumnAlias(Selection);
end;
end else begin SynError(148);
end;
SelectionList.AddSelection(Selection);
end;
procedure TFFSQL._OrderColumn (Parent: TFFSqlNode; var Col : TFFSqlOrderColumn);var
aSQLName : string;
begin
Col := TFFSqlOrderColumn.Create(Parent);
aSQLName := '';
_SQLName(aSQLName);
if (fCurrentInputSymbol = _pointSym) then begin
Get;
Col.TableName := aSQLName;
aSQLName := '';
_SQLName(aSQLName);
end;
Col.FieldName := aSQLName;
end;
procedure TFFSQL._OrderItem (Parent: TFFSqlNode;
var OrderItem : TFFSqlOrderItem);var OrderColumn : TFFSqlOrderColumn;
begin
OrderItem := TFFSqlOrderItem.Create(Parent);
if (fCurrentInputSymbol = identSym) OR
(fCurrentInputSymbol = SQLNameStringSym) then begin
_OrderColumn(OrderItem, OrderColumn);
OrderItem.Column := OrderColumn;
end else if (fCurrentInputSymbol = integer_Sym) then begin
Get;
OrderItem.Index := LexString;
end else begin SynError(149);
end;
if (fCurrentInputSymbol = ASCSym) OR
(fCurrentInputSymbol = DESCSym) then begin
if (fCurrentInputSymbol = ASCSym) then begin
Get;
end else begin
Get;
OrderItem.Descending := True;
end;
end;
end;
procedure TFFSQL._UpdateItem (Parent: TFFSqlNode;
var UpdateItem : TFFSqlUpdateItem);var Simplex : TFFSqlSimpleExpression;
var aSQLName : string;
begin
UpdateItem := TFFSqlUpdateItem.Create(Parent);
_SQLName(aSQLName);
UpdateItem.ColumnName := aSQLName;
Expect(_equalSym);
if (fCurrentInputSymbol = DEFAULTSym) then begin
Get;
UpdateItem.Default := True;
end else if (fCurrentInputSymbol = NULLSym) then begin
Get;
end else if _In(symSet[1], fCurrentInputSymbol) then begin
_SimpleExpression(UpdateItem, Simplex);
UpdateItem.Simplex := Simplex;
end else begin SynError(150);
end;
end;
procedure TFFSQL._UpdateList (Parent: TFFSqlNode;
var UpdateList : TFFSqlUpdateList);var UpdateItem : TFFSqlUpdateItem;
begin
UpdateList := TFFSqlUpdateList.Create(Parent);
_UpdateItem(UpdateList, UpdateItem);
UpdateList.AddItem(UpdateItem);
while (fCurrentInputSymbol = _commaSym) do begin
Get;
_UpdateItem(UpdateList, UpdateItem);
UpdateList.AddItem(UpdateItem);
end;
end;
procedure TFFSQL._SimpleTableRef (Parent: TFFSqlNode; var TableRef: TffSqlTableRef);var aSQLName : string;
begin
TableRef := TFFSqlTableRef.Create(Parent);
_SQLName(aSQLName);
TableRef.TableName := aSQLName;
if (fCurrentInputSymbol = _pointSym) then begin
Get;
_SQLName(aSQLName);
TableRef.DatabaseName := TableRef.TableName; TableRef.TableName := aSQLName;
end;
if (fCurrentInputSymbol = identSym) OR
(fCurrentInputSymbol = SQLNameStringSym) OR
(fCurrentInputSymbol = ASSym) then begin
_SimpleAlias(TableRef);
end;
end;
procedure TFFSQL._SimpleExpression (Parent: TFFSqlNode;
var SimpleExpression : TFFSqlSimpleExpression);var Term : TFFSqlTerm;
var AO : TFFSqlAddOp;
begin
SimpleExpression := TFFSqlSimpleExpression.Create(Parent);
_Term(SimpleExpression, Term, aoPlus);
SimpleExpression.AddTerm(Term);
while (fCurrentInputSymbol = _plusSym) OR
(fCurrentInputSymbol = _minusSym) OR
(fCurrentInputSymbol = _bar_barSym) do begin
if (fCurrentInputSymbol = _plusSym) then begin
Get;
AO := aoPlus;
end else if (fCurrentInputSymbol = _minusSym) then begin
Get;
AO := aoMinus;
end else begin
Get;
AO := aoConcat;
end;
_Term(SimpleExpression, Term, AO);
SimpleExpression.AddTerm(Term);
end;
end;
procedure TFFSQL._ValueItem (Parent: TFFSqlNode;
var ValueItem : TFFSqlValueItem);
var Simplex : TFFSqlSimpleExpression;
begin
ValueItem := TFFSqlValueItem.Create(Parent);
if (fCurrentInputSymbol = DEFAULTSym) then begin
Get;
ValueItem.Default := True;
end else if (fCurrentInputSymbol = NULLSym) then begin
Get;
end else if _In(symSet[1], fCurrentInputSymbol) then begin
_SimpleExpression(ValueItem, Simplex);
ValueItem.Simplex := Simplex;
end else begin SynError(151);
end;
end;
procedure TFFSQL._InsertItem (Parent: TFFSqlNode;
var InsertItem : TFFSqlInsertItem);var aSQLName: string;
begin
InsertItem := TFFSqlInsertItem.Create(Parent);
_SQLName(aSQLName);
InsertItem.ColumnName := aSQLName;
end;
procedure TFFSQL._ValueList (Parent: TFFSqlNode;
var ValueList : TFFSqlValueList);var ValueItem : TFFSqlValueItem;
begin
ValueList := TFFSqlValueList.Create(Parent);
_ValueItem(ValueList, ValueItem);
ValueList.AddItem(ValueItem);
while (fCurrentInputSymbol = _commaSym) do begin
Get;
_ValueItem(ValueList, ValueItem);
ValueList.AddItem(ValueItem);
end;
end;
procedure TFFSQL._TableConstructor (Parent: TFFSqlNode; var ValueList: TffSqlValueList);begin
Expect(VALUESSym);
Expect(_lparenSym);
_ValueList(Parent, ValueList);
Expect(_rparenSym);
end;
procedure TFFSQL._NonJoinTablePrimary (Parent: TffSqlNode; var NonJoinTablePrimary: TffSqlNonJoinTablePrimary);var ValueList: TffSqlValueList;
var NonJoinTableExp: TffSqlNonJoinTableExp;
var TableRef: TffSqlTableRef;
var SelectSt: TFFSqlSELECT;
begin
NonJoinTablePrimary := TffSqlNonJoinTablePrimary.Create(Parent);
if IsParenNonJoinTableExp then begin
Expect(_lparenSym);
_NonJoinTableExp(NonJoinTablePrimary, NonJoinTableExp);
NonJoinTablePrimary.NonJoinTableExp := NonJoinTableExp;
Expect(_rparenSym);
end else if (fCurrentInputSymbol = SELECTSym) then begin
_SelectStatement(NonJoinTablePrimary, SelectSt);
NonJoinTablePrimary.SelectSt := SelectSt;
end else if (fCurrentInputSymbol = TABLESym) then begin
Get;
_TableRef(NonJoinTablePrimary, TableRef);
NonJoinTablePrimary.TableRef := TableRef;
end else if (fCurrentInputSymbol = VALUESSym) then begin
_TableConstructor(NonJoinTablePrimary, ValueList);
NonJoinTablePrimary.ValueList := ValueList;
end else begin SynError(152);
end;
end;
procedure TFFSQL._NonJoinTableTerm (Parent:TffSqlNode; var NonJoinTableTerm: TffSqlNonJoinTableTerm);var NonJoinTablePrimary: TffSqlNonJoinTablePrimary;
begin
NonJoinTableTerm := TffSqlNonJoinTableTerm.Create(Parent);
_NonJoinTablePrimary(NonJoinTableTerm, NonJoinTablePrimary);
NonJoinTableTerm.NonJoinTablePrimary := NonJoinTablePrimary;
end;
procedure TFFSQL._UsingItem (Parent: TFFSqlNode;
var UsingItem : TFFSqlUsingItem);var aSQLName: string;
begin
UsingItem := TFFSqlUsingItem.Create(Parent);
_SQLName(aSQLName);
UsingItem.ColumnName := aSQLName;
end;
procedure TFFSQL._UsingList (Parent: TFFSqlNode;
var UsingList : TFFSqlUsingList);var UsingItem : TFFSqlUsingItem;
begin
UsingList := TFFSqlUsingList.Create(Parent);
_UsingItem(UsingList, UsingItem);
UsingList.AddItem(UsingItem);
while (fCurrentInputSymbol = _commaSym) do begin
Get;
_UsingItem(UsingList, UsingItem);
UsingList.AddItem(UsingItem);
end;
end;
procedure TFFSQL._TableRef (Parent: TFFSqlNode; var TableRef: TffSqlTableRef);var aSQLName : string;
var TableExp: TffSqlTableExp;
var ColumnList : TFFSqlInsertColumnList;
begin
TableRef := TFFSqlTableRef.Create(Parent);
if IsTableExp then begin
_TableExp(TableRef, TableExp);
TableRef.TableExp := TableExp;
if (fCurrentInputSymbol = identSym) OR
(fCurrentInputSymbol = SQLNameStringSym) OR
(fCurrentInputSymbol = ASSym) then begin
_SimpleAlias(TableRef);
end;
if (fCurrentInputSymbol = _lparenSym) then begin
Get;
_InsertColumnList(TableRef, ColumnList);
Expect(_rparenSym);
TableRef.ColumnList := ColumnList;
end;
end
else begin
_SQLName(aSQLName);
TableRef.TableName := aSQLName;
if (fCurrentInputSymbol = _pointSym) then begin
Get;
_SQLName(aSQLName);
TableRef.DatabaseName := TableRef.TableName; TableRef.TableName := aSQLName;
end;
if (fCurrentInputSymbol = identSym) OR
(fCurrentInputSymbol = SQLNameStringSym) OR
(fCurrentInputSymbol = ASSym) then begin
_SimpleAlias(TableRef);
end;
end;
end;
procedure TFFSQL._NonJoinTableExp (Parent:TffSqlNode; var NonJoinTableExp: TffSqlNonJoinTableExp);var NonJoinTableTerm: TffSqlNonJoinTableTerm;
begin
NonJoinTableExp := TffSqlNonJoinTableExp.Create(Parent);
_NonJoinTableTerm(NonJoinTableExp, NonJoinTableTerm);
NonJoinTableExp.NonJoinTableTerm := NonJoinTableTerm;
end;
procedure TFFSQL._JoinTableExp (Parent:TffSqlNode; const JoinTableExp: TffSqlJoinTableExp);
var TableRef: TffSqlTableRef;
var CondExp: TFFSqlCondExp;
var UsingList : TFFSqlUsingList;
begin
if (fCurrentInputSymbol = CROSSSym) then begin
Get;
Expect(JOINSym);
_TableRef(JoinTableExp, TableRef);
JoinTableExp.JoinType := jtCross;
JoinTableExp.TableRef2 := TableRef;
end else if _In(symSet[6], fCurrentInputSymbol) then begin
if (fCurrentInputSymbol = NATURALSym) then begin
Get;
JoinTableExp.Natural := True;
end;
JoinTableExp.JoinType := jtInner;
if (fCurrentInputSymbol = INNERSym) OR
(fCurrentInputSymbol = LEFTSym) OR
(fCurrentInputSymbol = RIGHTSym) OR
(fCurrentInputSymbol = FULLSym) OR
(fCurrentInputSymbol = UNIONSym) then begin
if (fCurrentInputSymbol = INNERSym) then begin
Get;
end else if (fCurrentInputSymbol = LEFTSym) then begin
Get;
if (fCurrentInputSymbol = OUTERSym) then begin
Get;
end;
JoinTableExp.JoinType := jtLeftOuter;
end else if (fCurrentInputSymbol = RIGHTSym) then begin
Get;
if (fCurrentInputSymbol = OUTERSym) then begin
Get;
end;
JoinTableExp.JoinType := jtRightOuter;
end else if (fCurrentInputSymbol = FULLSym) then begin
Get;
if (fCurrentInputSymbol = OUTERSym) then begin
Get;
end;
JoinTableExp.JoinType := jtFullOuter;
end else begin
Get;
JoinTableExp.JoinType := jtUnion;
end;
end;
Expect(JOINSym);
_SimpleTableRefOrParenTableExp(JoinTableExp, TableRef);
JoinTableExp.TableRef2 := TableRef;
if (fCurrentInputSymbol = ONSym) OR
(fCurrentInputSymbol = USINGSym) then begin
if (fCurrentInputSymbol = ONSym) then begin
Get;
_CondExp(JoinTableExp, CondExp);
JoinTableExp.CondExp := CondExp;
end else begin
Get;
Expect(_lparenSym);
_UsingList(JoinTableExp, UsingList);
Expect(_rparenSym);
JoinTableExp.UsingList := UsingList;
end;
end;
end else begin SynError(153);
end;
end;
procedure TFFSQL._SimpleTableRefOrParenTableExp (Parent: TFFSqlNode; var TableRef: TffSqlTableRef);var TableExp: TffSqlTableExp;
var aSQLName : string;
begin
TableRef := TFFSqlTableRef.Create(Parent);
if (fCurrentInputSymbol = identSym) OR
(fCurrentInputSymbol = SQLNameStringSym) then begin
_SQLName(aSQLName);
TableRef.TableName := aSQLName;
if (fCurrentInputSymbol = _pointSym) then begin
Get;
_SQLName(aSQLName);
TableRef.DatabaseName := TableRef.TableName; TableRef.TableName := aSQLName;
end;
if (fCurrentInputSymbol = identSym) OR
(fCurrentInputSymbol = SQLNameStringSym) OR
(fCurrentInputSymbol = ASSym) then begin
_SimpleAlias(TableRef);
end;
end else if (fCurrentInputSymbol = _lparenSym) then begin
Get;
_TableExp(TableRef, TableExp);
TableRef.TableExp := TableExp;
Expect(_rparenSym);
if (fCurrentInputSymbol = identSym) OR
(fCurrentInputSymbol = SQLNameStringSym) OR
(fCurrentInputSymbol = ASSym) then begin
_SimpleAlias(TableRef);
end;
end else begin SynError(154);
end;
end;
procedure TFFSQL._InsertColumnList (Parent: TFFSqlNode;
var InsertColumnList : TFFSqlInsertColumnList);var InsertItem : TFFSqlInsertItem;
begin
InsertColumnList := TFFSqlInsertColumnList.Create(Parent);
_InsertItem(InsertColumnList, InsertItem);
InsertColumnList.AddItem(InsertItem);
while (fCurrentInputSymbol = _commaSym) do begin
Get;
_InsertItem(InsertColumnList, InsertItem);
InsertColumnList.AddItem(InsertItem);
end;
end;
procedure TFFSQL._SQLName (var aName : string);begin
if (fCurrentInputSymbol = identSym) then begin
Get;
aName := LexString;
end else if (fCurrentInputSymbol = SQLNameStringSym) then begin
Get;
aName := CheckSQLName(LexString);
end else begin SynError(155);
end;
end;
procedure TFFSQL._OrderList (Parent: TFFSqlNode;
var OrderList : TFFSqlOrderList);var OrderItem : TFFSqlOrderItem;
begin
OrderList := TFFSqlOrderList.Create(Parent);
_OrderItem(OrderList, OrderItem);
OrderList.AddOrderItem(OrderItem);
while (fCurrentInputSymbol = _commaSym) do begin
Get;
_OrderItem(OrderList, OrderItem);
OrderList.AddOrderItem(OrderItem);
end;
end;
procedure TFFSQL._GroupColumnList (Parent: TFFSqlNode;
var ColumnList : TFFSqlGroupColumnList);var Col : TFFSqlGroupColumn;
begin
ColumnList := TFFSqlGroupColumnList.Create(Parent);
_GroupColumn(Parent, Col);
ColumnList.AddColumn(Col);
while (fCurrentInputSymbol = _commaSym) do begin
Get;
_GroupColumn(Parent, Col);
ColumnList.AddColumn(Col);
end;
end;
procedure TFFSQL._CondExp (Parent: TFFSqlNode;
var CondExp: TFFSqlCondExp);var CondTerm : TFFSqlCondTerm;
begin
CondExp := TFFSqlCondExp.Create(Parent);
_CondTerm(CondExp, CondTerm);
CondExp.AddCondTerm(CondTerm);
while (fCurrentInputSymbol = ORSym) do begin
Get;
_CondTerm(CondExp, CondTerm);
CondExp.AddCondTerm(CondTerm);
end;
end;
procedure TFFSQL._TableRefList (Parent: TFFSqlNode;
var TableRefList: TFFSqlTableRefList);var TableRef: TffSqlTableRef;
begin
TableRefList := TFFSqlTableRefList.Create(Parent);
_TableRef(TableRefList, TableRef);
TableRefList.AddTableRef(TableRef);
while (fCurrentInputSymbol = _commaSym) do begin
Get;
_TableRef(TableRefList, TableRef);
TableRefList.AddTableRef(TableRef);
end;
end;
procedure TFFSQL._SelectionList (Parent: TFFSqlSELECT; var SelectionList: TFFSqlSelectionList);begin
SelectionList := TFFSqlSelectionList.Create(Parent);
_Selection(SelectionList);
while (fCurrentInputSymbol = _commaSym) do begin
Get;
_Selection(SelectionList);
end;
end;
procedure TFFSQL._SelectStatement (Parent: TFFSqlNode;
var Select : TFFSqlSELECT);var SelectionList : TFFSqlSelectionList;
var CondExp : TFFSqlCondExp;
var GroupColumnList : TFFSqlGroupColumnList;
var TableRefList : TFFSqlTableRefList;
var OrderList : TFFSqlOrderList;
begin
Expect(SELECTSym);
Select := TFFSqlSELECT.Create(Parent);
if (fCurrentInputSymbol = ALLSym) OR
(fCurrentInputSymbol = DISTINCTSym) then begin
if (fCurrentInputSymbol = ALLSym) then begin
Get;
end else begin
Get;
Select.Distinct := True;
end;
end;
_SelectionList(Select, SelectionList);
Select.SelectionList := SelectionList;
Expect(FROMSym);
_TableRefList(Select, TableRefList);
Select.TableRefList := TableRefList;
if (fCurrentInputSymbol = WHERESym) then begin
Get;
Select.InWhere := True;
_CondExp(Select, CondExp);
Select.CondExpWhere := CondExp;
Select.InWhere := False;
end;
if (fCurrentInputSymbol = GROUPSym) then begin
Get;
Expect(BYSym);
_GroupColumnList(Select, GroupColumnList);
Select.GroupColumnList := GroupColumnList;
end;
if (fCurrentInputSymbol = HAVINGSym) then begin
Get;
_CondExp(Select, CondExp);
Select.CondExpHaving := CondExp;
end;
if (fCurrentInputSymbol = ORDERSym) then begin
Get;
Expect(BYSym);
_OrderList(Select, OrderList);
Select.OrderList := OrderList;
end;
end;
procedure TFFSQL._DeleteStatement (Parent: TFFSqlNode;
var DeleteSt : TFFSqlDELETE);var TableRef: TffSqlTableRef;
var CondExp: TFFSqlCondExp;
begin
Expect(DELETESym);
Expect(FROMSym);
DeleteSt := TFFSqlDELETE.Create(Parent);
_SimpleTableRef(DeleteSt, TableRef);
DeleteSt.TableRef := TableRef;
if (fCurrentInputSymbol = WHERESym) then begin
Get;
_CondExp(DeleteSt, CondExp);
DeleteSt.CondExpWhere := CondExp;
end;
end;
procedure TFFSQL._UpdateStatement (Parent: TFFSqlNode;
var UpdateSt : TFFSqlUPDATE);var TableRef: TffSqlTableRef;
var CondExp: TFFSqlCondExp;
var UpdateList: TFFSqlUpdateList;
begin
Expect(UPDATESym);
UpdateSt := TFFSqlUPDATE.Create(Parent);
_SimpleTableRef(UpdateSt, TableRef);
UpdateSt.TableRef := TableRef;
Expect(SETSym);
_UpdateList(UpdateSt, UpdateList);
UpdateSt.UpdateList := UpdateList;
if (fCurrentInputSymbol = WHERESym) then begin
Get;
_CondExp(UpdateSt, CondExp);
UpdateSt.CondExpWhere := CondExp;
end;
end;
procedure TFFSQL._InsertStatement (Parent: TFFSqlNode;
var InsertSt : TFFSqlINSERT);var aSQLName: string;
var InsertColumnList: TffSqlInsertColumnList;
var TableExp: TffSqlTableExp;
begin
Expect(INSERTSym);
Expect(INTOSym);
InsertSt := TFFSqlINSERT.Create(Parent);
_SQLName(aSQLName);
InsertSt.TableName := aSQLName;
if (fCurrentInputSymbol = DEFAULTSym) then begin
Get;
Expect(VALUESSym);
InsertSt.DefaultValues := True;
end else if IsColumnList then begin
Expect(_lparenSym);
_InsertColumnList(InsertSt, InsertColumnList);
InsertSt.InsertColumnList := InsertColumnList;
Expect(_rparenSym);
_TableExp(InsertSt, TableExp);
InsertSt.TableExp := TableExp;
end else if (fCurrentInputSymbol = SELECTSym) OR
(fCurrentInputSymbol = VALUESSym) OR
(fCurrentInputSymbol = _lparenSym) OR
(fCurrentInputSymbol = TABLESym) then begin
_TableExp(InsertSt, TableExp);
InsertSt.TableExp := TableExp;
end else begin SynError(156);
end;
end;
procedure TFFSQL._TableExp (Parent:TffSqlNode; var TableExp: TffSqlTableExp);var NestedTableExp: TffSqlTableExp;
var JoinTableExp: TffSqlJoinTableExp;
var TmpJoinTableExp: TffSqlJoinTableExp;
var TmpTableExp: TffSqlTableExp;
var TableRef, TmpTableRef: TffSqlTableRef;
var NonJoinTableExp: TffSqlNonJoinTableExp;
begin
TableExp := TffSqlTableExp.Create(Parent);
if IsJoinTableExp then begin
JoinTableExp := TffSqlJoinTableExp.Create(TableExp);
TableExp.JoinTableExp := JoinTableExp;
_SimpleTableRefOrParenTableExp(JoinTableExp, TableRef);
JoinTableExp.TableRef1 := TableRef;
_JoinTableExp(TableExp, JoinTableExp);
while _In(symSet[7], fCurrentInputSymbol) do begin
TmpJoinTableExp := JoinTableExp;
JoinTableExp := TffSqlJoinTableExp.Create(TableExp);
TableExp.JoinTableExp := JoinTableExp;
TmpTableRef := TffSqlTableRef.Create(JoinTableExp);
TmpTableExp := TffSqlTableExp.Create(TmpTableRef);
TmpJoinTableExp.Parent := TmpTableExp;
TmpTableExp.JoinTableExp := TmpJoinTableExp;
TmpTableRef.TableExp := TmpTableExp;
JoinTableExp.TableRef1 := TmpTableRef;
_JoinTableExp(TableExp, JoinTableExp);
end;
end else if (fCurrentInputSymbol = SELECTSym) OR
(fCurrentInputSymbol = VALUESSym) OR
(fCurrentInputSymbol = TABLESym) then begin
_NonJoinTableExp(TableExp, NonJoinTableExp);
TableExp.NonJoinTableExp := NonJoinTableExp;
end else if (fCurrentInputSymbol = _lparenSym) then begin
Get;
_TableExp(TableExp, NestedTableExp);
TableExp.NestedTableExp := NestedTableExp;
Expect(_rparenSym);
end else begin SynError(157);
end;
end;
procedure TFFSQL._FFSQL;
var TableExp: TffSqlTableExp;
var InsertSt: TffSqlINSERT;
var UpdateSt: TffSqlUPDATE;
var DeleteSt: TffSqlDELETE;
begin
Init;
if (fCurrentInputSymbol = NOINDEXSym) then begin
Get;
fRootNode.UseIndex := False
end;
if (fCurrentInputSymbol = NOREDUCESym) then begin
Get;
fRootNode.Reduce := False
end;
if IsTableExp then begin
_TableExp(fRootNode, TableExp);
fRootNode.TableExp := TableExp;
end else if (fCurrentInputSymbol = INSERTSym) then begin
_InsertStatement(fRootNode, InsertSt);
fRootNode.Insert := InsertSt;
end else if (fCurrentInputSymbol = UPDATESym) then begin
_UpdateStatement(fRootNode, UpdateSt);
fRootNode.Update := UpdateSt;
end else if (fCurrentInputSymbol = DELETESym) then begin
_DeleteStatement(fRootNode, DeleteSt);
fRootNode.Delete := DeleteSt;
end else begin SynError(158);
end;
if (fCurrentInputSymbol = _semicolonSym) then begin
Get;
end;
if fCurrentInputSymbol <> EOFSYMB then
SynError(200);
Final;
end;
function TFFSQL.GetBuildDate : TDateTime;
const
BDate = 37579;
Hour = 14;
Min = 45;
begin
Result := BDate + EncodeTime(Hour, Min, 0 ,0);
end;
function TFFSQL.GetVersion : string;
begin
Result := '0.0.0.102';
end;
function TFFSQL.GetVersionStr : string;
begin
Result := '0.0.0.102';
end;
function TFFSQL.GetVersionInfo : string;
begin
Result := 'Comment: ' + #13#10 +
'Author: ' + #13#10 +
'Copyright: ';
end;
procedure TFFSQL.SetVersion(const Value : string);
begin
// This is a read only property. However, we want the value
// to appear in the Object Inspector during design time.
end;
procedure TFFSQL.Parse;
begin
errDist := minErrDist;
GetScanner._Reset;
Get;
_FFSQL;
end; {Parse}
procedure TFFSQL.InitSymSet;
begin
symSet[ 0, 0] := [EOFSYMB];
symSet[ 0, 1] := [];
symSet[ 0, 2] := [];
symSet[ 0, 3] := [];
symSet[ 0, 4] := [];
symSet[ 0, 5] := [];
symSet[ 0, 6] := [];
symSet[ 0, 7] := [];
symSet[ 1, 0] := [identSym, integer_Sym, floatSym, SQLStringSym,
SQLNameStringSym];
symSet[ 1, 1] := [_lparenSym-16];
symSet[ 1, 2] := [COUNTSym-32];
symSet[ 1, 3] := [MINSym-48, MAXSym-48, SUMSym-48, AVGSym-48];
symSet[ 1, 4] := [TRUESym-64, FALSESym-64, CASESym-64, _minusSym-64];
symSet[ 1, 5] := [CHARACTER_underscoreLENGTHSym-80,
CHAR_underscoreLENGTHSym-80, COALESCESym-80,
CURRENT_underscoreDATESym-80, CURRENT_underscoreTIMESym-80,
CURRENT_underscoreTIMESTAMPSym-80,
CURRENT_underscoreUSERSym-80, USERSym-80, LOWERSym-80,
UPPERSym-80, POSITIONSym-80, SESSION_underscoreUSERSym-80,
SUBSTRINGSym-80, SYSTEM_underscoreUSERSym-80, TRIMSym-80];
symSet[ 1, 6] := [EXTRACTSym-96, NULLIFSym-96, ABSSym-96, CEILINGSym-96,
FLOORSym-96, EXPSym-96, LOGSym-96];
symSet[ 1, 7] := [POWERSym-112, RANDSym-112, ROUNDSym-112, _querySym-112,
DATESym-112, TIMESym-112, TIMESTAMPSym-112, INTERVALSym-112];
symSet[ 2, 0] := [identSym, integer_Sym, floatSym, SQLStringSym,
SQLNameStringSym];
symSet[ 2, 1] := [_lparenSym-16];
symSet[ 2, 2] := [COUNTSym-32];
symSet[ 2, 3] := [MINSym-48, MAXSym-48, SUMSym-48, AVGSym-48, NOTSym-48,
EXISTSSym-48, UNIQUESym-48];
symSet[ 2, 4] := [TRUESym-64, FALSESym-64, CASESym-64, _minusSym-64];
symSet[ 2, 5] := [CHARACTER_underscoreLENGTHSym-80,
CHAR_underscoreLENGTHSym-80, COALESCESym-80,
CURRENT_underscoreDATESym-80, CURRENT_underscoreTIMESym-80,
CURRENT_underscoreTIMESTAMPSym-80,
CURRENT_underscoreUSERSym-80, USERSym-80, LOWERSym-80,
UPPERSym-80, POSITIONSym-80, SESSION_underscoreUSERSym-80,
SUBSTRINGSym-80, SYSTEM_underscoreUSERSym-80, TRIMSym-80];
symSet[ 2, 6] := [EXTRACTSym-96, NULLIFSym-96, ABSSym-96, CEILINGSym-96,
FLOORSym-96, EXPSym-96, LOGSym-96];
symSet[ 2, 7] := [POWERSym-112, RANDSym-112, ROUNDSym-112, _querySym-112,
DATESym-112, TIMESym-112, TIMESTAMPSym-112, INTERVALSym-112];
symSet[ 3, 0] := [];
symSet[ 3, 1] := [];
symSet[ 3, 2] := [_equalSym-32];
symSet[ 3, 3] := [NOTSym-48, _less_equalSym-48, _lessSym-48, _greaterSym-48,
_greater_equalSym-48, _less_greaterSym-48];
symSet[ 3, 4] := [ISSym-64, BETWEENSym-64, LIKESym-64, INSym-64, MATCHSym-64];
symSet[ 3, 5] := [];
symSet[ 3, 6] := [];
symSet[ 3, 7] := [];
symSet[ 4, 0] := [];
symSet[ 4, 1] := [];
symSet[ 4, 2] := [_equalSym-32];
symSet[ 4, 3] := [NOTSym-48, _less_equalSym-48, _lessSym-48, _greaterSym-48,
_greater_equalSym-48, _less_greaterSym-48];
symSet[ 4, 4] := [BETWEENSym-64, LIKESym-64, INSym-64, MATCHSym-64];
symSet[ 4, 5] := [];
symSet[ 4, 6] := [];
symSet[ 4, 7] := [];
symSet[ 5, 0] := [identSym, integer_Sym, floatSym, SQLStringSym,
SQLNameStringSym, ALLSym, DISTINCTSym];
symSet[ 5, 1] := [_lparenSym-16];
symSet[ 5, 2] := [COUNTSym-32];
symSet[ 5, 3] := [MINSym-48, MAXSym-48, SUMSym-48, AVGSym-48];
symSet[ 5, 4] := [TRUESym-64, FALSESym-64, CASESym-64, _minusSym-64];
symSet[ 5, 5] := [CHARACTER_underscoreLENGTHSym-80,
CHAR_underscoreLENGTHSym-80, COALESCESym-80,
CURRENT_underscoreDATESym-80, CURRENT_underscoreTIMESym-80,
CURRENT_underscoreTIMESTAMPSym-80,
CURRENT_underscoreUSERSym-80, USERSym-80, LOWERSym-80,
UPPERSym-80, POSITIONSym-80, SESSION_underscoreUSERSym-80,
SUBSTRINGSym-80, SYSTEM_underscoreUSERSym-80, TRIMSym-80];
symSet[ 5, 6] := [EXTRACTSym-96, NULLIFSym-96, ABSSym-96, CEILINGSym-96,
FLOORSym-96, EXPSym-96, LOGSym-96];
symSet[ 5, 7] := [POWERSym-112, RANDSym-112, ROUNDSym-112, _querySym-112,
DATESym-112, TIMESym-112, TIMESTAMPSym-112, INTERVALSym-112];
symSet[ 6, 0] := [];
symSet[ 6, 1] := [JOINSym-16, NATURALSym-16, INNERSym-16, LEFTSym-16,
RIGHTSym-16, FULLSym-16];
symSet[ 6, 2] := [UNIONSym-32];
symSet[ 6, 3] := [];
symSet[ 6, 4] := [];
symSet[ 6, 5] := [];
symSet[ 6, 6] := [];
symSet[ 6, 7] := [];
symSet[ 7, 0] := [];
symSet[ 7, 1] := [CROSSSym-16, JOINSym-16, NATURALSym-16, INNERSym-16,
LEFTSym-16, RIGHTSym-16, FULLSym-16];
symSet[ 7, 2] := [UNIONSym-32];
symSet[ 7, 3] := [];
symSet[ 7, 4] := [];
symSet[ 7, 5] := [];
symSet[ 7, 6] := [];
symSet[ 7, 7] := [];
end; {InitSymSet}
end { FFSQL }.
Reference in New Issue View Git Blame Copy Permalink