{*********************************************************}
{* FlashFiler: SQL Class Definitions *}
{*********************************************************}
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
{2.11 - extensive changes throughout}
{$I ffdefine.inc}
{Enable the following to have index optimization analysis and usage
information logged to a file (used for debugging)}
{.$DEFINE LogIndexAnalysis}
{Enable the following to have transformation information
logged to a file (used for debugging)}
{$DEFINE LogTransformations}
{Enable the following to have writes counted}
{.$DEFINE CountWrites}
{Enable the following to have the root node made available through the global
LastStatement variable below (used for debugging only)}
{.$DEFINE ExposeLastStatement}
unit ffsqldef;
interface
uses
Windows,
SysUtils,
Classes,
DB,
{$IFDEF DCC6OrLater}
Variants,
{$ENDIF}
ffllbase,
ffsqldb,
ffhash;
const
fftInterval = fftReserved20;
{$IFDEF LogIndexAnalysis}
IALogFile = 'c:\ffialog.txt';
{$ENDIF}
{$IFDEF LogTransformations}
TRLogFile = 'c:\fftrlog.txt';
{$ENDIF}
{$IFDEF LogIndexAnalysis}
var
IALog : System.Text;
{$ENDIF}
{$IFDEF LogTransformations}
var
TRLog : System.Text;
{$ENDIF}
type
TffSqlAggQueryMode = (aqmIdle, aqmGrouping, aqmHaving);
TffSqlNode = class;
TffSqlStatement = class;
TffSqlEnumMethod = procedure(Node: TffSqlNode) of object;
TffSqlAggregate = class;
TffSqlSELECT = class;
TffSqlColumnListOwner = class;
TffSqlRelOp = (roNone, roEQ, roLE, roL, roG, roGE, roNE);
TffSqlNode = class(TFFObject)
protected
FParent : TffSqlNode;
FOwner : TffSqlStatement;
FOwnerStmt: TffSqlColumnListOwner; {!!.11}
procedure WriteStr(Stream: TStream; const S: string);
procedure WriteEOF(Stream: TStream);
procedure AddTableReference(Select: TffSqlSELECT); virtual;
procedure AddColumnDef(Target: TffSqlColumnListOwner); virtual;
procedure AddAggregate(Target: TList); virtual;
procedure ClearBinding; virtual;
function IsAncestor(const Node : TffSqlNode) : Boolean;
{ Returns True if Node is an ancestor of this node. }
procedure ResetConstant; virtual;
procedure FlagAggregate(Select: TffSqlSELECT); virtual;
function GetType: TffFieldType; virtual;
function GetSize: Integer; virtual;
function GetDecimals: Integer; virtual;
function GetOwner: TffSqlStatement;
function GetOwnerSelect : TffSqlSelect;
function GetOwnerStmt: TFFSqlColumnListOwner; {!!.11}
procedure SQLError(const ErrorMsg: string);
procedure AssignError(Source: TffSqlNode);
procedure TypeMismatch;
function BindField(const TableName,
FieldName: string): TFFSqlFieldProxy; virtual;
function IsAggregate: Boolean; virtual;
public
constructor Create(AParent: TffSqlNode);
property Parent : TffSqlNode read FParent write FParent;
property Owner : TffSqlStatement read GetOwner;
property OwnerSelect : TffSqlSelect read GetOwnerSelect;
property OwnerStmt: TFFSqlColumnListOwner read GetOwnerStmt; {!!.11}
procedure EmitSQL(Stream : TStream); virtual;
function SQLText: string;
function Equals(Other: TffSqlNode): Boolean; virtual; abstract;
procedure Assign(const Source: TffSqlNode); virtual; abstract;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
virtual; abstract;
end;
TffSqlFieldRef = class(TffSqlNode)
protected
FFieldName: string;
FTableName: string;
TypeKnown : Boolean;
FType : TffFieldType;
FField : TFFSqlFieldProxy;
FGroupField : TffSqlFieldProxy;
WasWildcard: Boolean;
procedure ClearBinding; override;
function GetDecimals: Integer; override;
function GetSize: Integer; override;
function GetTitle(const Qualified : boolean): string; {!!.11}
function GetType: TffFieldType; override;
procedure CheckType;
procedure MatchType(ExpectedType: TffFieldType);
function GetField: TFFSqlFieldProxy;
function GetGroupField : TffSqlFieldProxy;
public
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
procedure Assign(const Source: TffSqlNode); override;
property TableName : string read FTableName write FTableName;
property FieldName : string read FFieldName write FFieldName;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function GetValue : Variant;
property Field: TFFSqlFieldProxy read GetField;
property GroupField : TffSqlFieldProxy read GetGroupField;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
function QualName : string;
function IsNull: Boolean;
end;
TffSqlSimpleExpression = class;
TAggCounter = class(TffObject)
protected
FMin, FMax : variant;
FSum, FCount : double;
function GetMax: Variant;
function GetMin: Variant;
function GetSum: Variant;
function GetAvg: Variant;
public
procedure Reset;
procedure Add(const Value: Variant);
property Min: Variant read GetMin;
property Max: Variant read GetMax;
property Count: double read FCount;
property Sum: Variant read GetSum;
property Avg: Variant read GetAvg;
end;
TffSQLAggFunction = (agCount, agMin, agMax, agSum, agAvg);
TffSqlAggregate = class(TffSqlNode)
protected
FAgFunction: TffSQLAggFunction;
FSimpleExpression : TffSqlSimpleExpression;
FDistinct : Boolean;
FCounter : TAggCounter;
FSourceField: TFFSqlFieldProxy;
function GetTitle(const Qualified : boolean): string; {!!.11}
procedure MatchType(ExpectedType: TffFieldType);
function GetSize: Integer; override;
function GetDecimals: Integer; override;
function GetType: TffFieldType; override;
procedure FlagAggregate(Select: TffSqlSELECT); override;
procedure AddAggregate(Target: TList); override;
function Reduce: Boolean;
public
procedure Assign(const Source: TffSqlNode); override;
destructor Destroy; override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
property AgFunction : TffSQLAggFunction read FAgFunction write FAgFunction;
property SimpleExpression : TffSqlSimpleExpression
read FSimpleExpression write FSimpleExpression;
property Distinct: Boolean read FDistinct write FDistinct;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function GetAggregateValue: Variant;
procedure CreateCounter(SourceField: TFFSqlFieldProxy);
procedure DeleteCounter;
procedure ResetCounters;
procedure Update;
function ValidType(aType : TffFieldType) : Boolean;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
end;
TffSqlColumn = class(TffSqlNode)
protected
FColumnName: string;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
property ColumnName: string read FColumnName write FColumnName;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
end;
TffSqlBaseColumn = class(TffSqlNode)
protected
FFieldName: string;
FTableName: string;
public
property TableName: string read FTableName write FTableName;
property FieldName: string read FFieldName write FFieldName;
end;
TffSqlGroupColumn = class(TffSqlBaseColumn)
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function QualColumnName: string; virtual;
end;
TffSqlOrderColumn = class(TffSqlBaseColumn)
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function QualColumnName: string;
end;
TffSqlSelection = class;
TffSqlGroupColumnList = class(TffSqlNode)
protected
ColumnList : TList;
procedure Clear;
function GetColumn(Index: Integer): TffSqlGroupColumn;
procedure SetColumn(Index: Integer; const Value: TffSqlGroupColumn);
function GetColumnCount: Integer;
function Reduce: Boolean;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
constructor Create(AParent: TffSqlNode);
destructor Destroy; override;
function AddColumn(Column: TffSqlGroupColumn): TffSqlGroupColumn;
property ColumnCount : Integer read GetColumnCount;
property Column[Index: Integer] : TffSqlGroupColumn read GetColumn write SetColumn;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function Contains(const aColName : string;
Se: TffSqlSelection): Boolean;
end;
TffSqlIsOp = (ioNull, ioTrue, ioFalse, ioUnknown);
TffSqlIsTest = class(TffSqlNode)
protected
FUnaryNot : Boolean;
FIsOp : TffSqlIsOp;
procedure MatchType(ExpectedType: TffFieldType);
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
property UnaryNot: Boolean read FUnaryNot write FUnaryNot;
property IsOp : TffSqlIsOp read FIsOp write FIsOp;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function AsBoolean(const TestValue: Variant): Boolean;
function Evaluate(Expression: TffSqlSimpleExpression): Boolean;
end;
TffSqlBetweenClause = class(TffSqlNode)
protected
FSimpleHigh: TffSqlSimpleExpression;
FSimpleLow: TffSqlSimpleExpression;
FNegated : Boolean;
FIsConstant: Boolean;
FIsConstantChecked: Boolean;
procedure CheckIsConstant;
function IsConstant: Boolean;
procedure MatchType(ExpectedType: TffFieldType);
function Reduce: Boolean;
procedure ResetConstant; override;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
destructor Destroy; override;
property Negated : Boolean read FNegated write FNegated;
property SimpleLow : TffSqlSimpleExpression read FSimpleLow write FSimpleLow;
property SimpleHigh : TffSqlSimpleExpression read FSimpleHigh write FSimpleHigh;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function AsBoolean(const TestValue: Variant): Boolean;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
end;
TffSqlLikePattern = class(TffObject)
protected
LeadPattern,
TrailPattern : string;
LeadMask,
TrailMask: string;
FloatPatterns,
FloatMasks: TStringList;
public
constructor Create(SearchPattern: string; const Escape: string);
{S is the search pattern; Escape is an optional one-character escape
character}
{S contains the string to be searched for, and optionally one or more
occurrences of
'%' (match zero or more characters of any kind), and/or
'_' (match exactly one character of any kind)
If the Escape character is specified, it defines a character to prefix '%'
or '_' with
to indicate a literal '%' or '_', respectively, in the search phrase S.}
{the search must be case sensitive ('a' <> 'A') }
destructor Destroy; override;
function Find(const TextToSearch: Variant; IgnoreCase: Boolean): Boolean; {!!.13}
{examples:
S = '%Berkeley%' - Find returns true if the string 'Berkeley' exists
anywhere in TextToSearch
S = 'S__' - Find returns true if TextToSearch is exactly thee characters
long and starts with an upper-case 'S'
S = '%c___' - Find returns True if length(TextToSearch) >= 4 and the
last but three is 'c'
S = '=_%' and Escape = '=' - Find returns True if TextToSearch begins
with an underscore.
}
end;
TffSqlLikeClause = class(TffSqlNode)
protected
FSimpleExp: TffSqlSimpleExpression;
FEscapeExp: TffSqlSimpleExpression;
FNegated : Boolean;
FIsConstant: Boolean;
FIsConstantChecked: Boolean;
Limited: Boolean;
LikePattern: TffSqlLikePattern;
FBMCompat : Boolean; {!!.11}
BMCompatChecked : Boolean; {!!.11}
FBMTable: PBTable; {!!.11}
FBMPhrase: string; {!!.11}
FIgnoreCase: Boolean; {!!.13}
procedure CheckBMCompat; {!!.11}
function IsBMCompatible: Boolean; {!!.11}
function GetBmTable: PBTable; {!!.11}
function CanLimit: Boolean;
function CanReplaceWithCompare: Boolean;
procedure CheckIsConstant;
function GetLowLimit: string;
function GetHighLimit: string;
function IsConstant: Boolean;
procedure MatchType(ExpectedType: TffFieldType);
function Reduce: Boolean;
procedure ResetConstant; override;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
destructor Destroy; override;
property SimpleExp : TffSqlSimpleExpression read FSimpleExp write FSimpleExp;
property EscapeExp: TffSqlSimpleExpression read FEscapeExp write FEscapeExp;
property Negated : Boolean read FNegated write FNegated;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function AsBoolean(const TestValue: Variant): Boolean;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
property BmTable: PBTable read GetBmTable; {!!.11}
property BmPhrase: string read FBmPhrase; {!!.11}
property IgnoreCase: Boolean read FIgnoreCase write FIgnoreCase; {!!.13}
end;
TffSqlSimpleExpressionList = class;
TffSqlInClause = class(TffSqlNode)
protected
FSimpleExp: TffSqlSimpleExpressionList;
FNegated : Boolean;
FSubQuery : TffSqlSELECT;
FIsConstant: Boolean;
FIsConstantChecked: Boolean;
procedure CheckIsConstant;
function IsConstant: Boolean;
procedure MatchType(ExpectedType: TffFieldType);
function Reduce: Boolean;
procedure ResetConstant; override;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
destructor Destroy; override;
property SimpleExpList : TffSqlSimpleExpressionList
read FSimpleExp write FSimpleExp;
property SubQuery : TffSqlSELECT read FSubQuery write FSubQuery;
property Negated : Boolean read FNegated write FNegated;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function AsBoolean(const TestValue: Variant): Boolean;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
end;
TffSqlTableExp = class;
TffSqlMatchOption = (moUnspec, moPartial, moFull);
TffSqlMatchClause = class(TffSqlNode)
protected
FSubQuery : TffSqlSELECT;
FOption: TffSqlMatchOption;
FUnique : Boolean;
procedure MatchType(ExpectedType: TffFieldType);
function Reduce: Boolean;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
destructor Destroy; override;
property Unique: Boolean read FUnique write FUnique;
property Option: TffSqlMatchOption read FOption write FOption;
property SubQuery : TffSqlSELECT read FSubQuery write FSubQuery;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function AsBoolean(const TestValue: Variant): Boolean;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
end;
TffSqlAllOrAnyClause = class(TffSqlNode)
protected
FSubQuery : TffSqlSELECT;
FAll : Boolean;
procedure MatchType(ExpectedType: TffFieldType);
function Compare(RelOp: TffSqlRelOp; const Val: Variant): Boolean;
function Reduce: Boolean;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
destructor Destroy; override;
property All: Boolean read FAll write FAll;
property SubQuery : TffSqlSELECT read FSubQuery write FSubQuery;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
end;
TffSqlExistsClause = class(TffSqlNode)
protected
FSubQuery : TffSqlSELECT;
function Reduce: Boolean;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
destructor Destroy; override;
property SubQuery : TffSqlSELECT read FSubQuery write FSubQuery;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function AsBoolean: Boolean;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
end;
TffSqlUniqueClause = class(TffSqlNode)
protected
FSubQuery: TffSqlTableExp;
function Reduce: Boolean;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
destructor Destroy; override;
property SubQuery : TffSqlTableExp read FSubQuery write FSubQuery;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function AsBoolean: Boolean;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
end;
TffSqlCondPrimary = class(TffSqlNode)
protected
FSimpleExp1: TffSqlSimpleExpression;
FRelOp: TffSqlRelOp;
FSimpleExp2: TffSqlSimpleExpression;
FBetweenClause : TffSqlBetweenClause;
FLikeClause : TffSqlLikeClause;
FInClause : TffSqlInClause;
FIsTest : TffSqlIsTest;
FAllOrAnyClause : TffSqlAllOrAnyClause;
FExistsClause : TFfSqlExistsClause;
FUniqueClause : TFfSqlUniqueClause;
FMatchClause : TffSqlMatchClause;
TypeChecked : Boolean;
FIsConstant: Boolean;
FIsConstantChecked: Boolean;
ConstantValue: Variant;
procedure Clear;
procedure CheckIsConstant;
function IsConstant: Boolean;
procedure CheckType;
function GetType: TffFieldType; override;
function GetDecimals: Integer; override;
function GetSize: Integer; override;
function GetTitle(const Qualified : boolean): string; {!!.11}
function JustSimpleExpression: Boolean;
procedure MatchType(ExpectedType: TffFieldType); {!!.11}
function Reduce: Boolean;
procedure ResetConstant; override;
public
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
destructor Destroy; override;
procedure Assign(const Source: TffSqlNode); override;
property SimpleExp1 : TffSqlSimpleExpression
read FSimpleExp1 write FSimpleExp1;
property RelOp : TffSqlRelOp read FRelOp write FRelOp;
property SimpleExp2 : TffSqlSimpleExpression
read FSimpleExp2 write FSimpleExp2;
property BetweenClause : TffSqlBetweenClause
read FBetweenClause write FBetweenClause;
property LikeClause : TffSqlLikeClause read FLikeClause write FLikeClause;
property InClause : TffSqlInClause read FInClause write FInClause;
property IsTest : TffSqlIsTest read FIsTest write FIsTest;
property AllOrAnyClause : TffSqlAllOrAnyClause
read FAllOrAnyClause write FAllOrAnyClause;
property ExistsClause : TffSqlExistsClause
read FExistsClause write FExistsClause;
property UniqueClause : TffSqlUniqueClause
read FUniqueClause write FUniqueClause;
property MatchClause : TffSqlMatchClause read FMatchClause write FMatchClause;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function AsBoolean: Boolean;
function GetValue: Variant;
procedure BindHaving;
function IsRelationTo(Table : TFFSqlTableProxy;
var FieldReferenced: TFFSqlFieldProxy;
var Operator: TffSqlRelOp;
var ArgExpression: TffSqlSimpleExpression;
var SameCase: Boolean): Boolean;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
end;
TffSqlCondFactor = class(TffSqlNode)
protected
FUnaryNot: Boolean;
FCondPrimary: TffSqlCondPrimary;
FIsConstant: Boolean;
FIsConstantChecked: Boolean;
ConstantValue: Variant;
TmpKnown: Boolean;
TmpValue: Boolean;
EvalLevel: Integer;
procedure CheckIsConstant;
procedure Clear;
function IsConstant: Boolean;
function GetType: TffFieldType; override;
function GetDecimals: Integer; override;
function GetSize: Integer; override;
function GetTitle(const Qualified : boolean): string; {!!.11}
procedure MatchType(ExpectedType: TffFieldType); {!!.11}
function Reduce: Boolean;
procedure ResetConstant; override;
public
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
procedure Assign(const Source: TffSqlNode); override;
destructor Destroy; override;
property UnaryNot : Boolean read FUnaryNot write FUnaryNot;
property CondPrimary : TffSqlCondPrimary read FCondPrimary write FCondPrimary;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function AsBoolean: Boolean;
function GetValue: Variant;
procedure BindHaving;
function IsRelationTo(Table : TFFSqlTableProxy;
var FieldReferenced: TFFSqlFieldProxy;
var Operator: TffSqlRelOp;
var ArgExpression: TffSqlSimpleExpression;
var SameCase: Boolean): Boolean;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
procedure MarkTrue;
procedure MarkUnknown;
end;
TffSqlCondExp = class;
TFFObjectProc = procedure of object;
TFFSqlKeyRelation = record
CondF : TFFSqlCondFactor;
RelationB: array[0..pred(ffcl_MaxIndexFlds)] of TffSqlCondFactor; {!!.11}
NativeKeyIndex: Integer;
RelationFieldCount,
RelationKeyFieldCount: Integer;
RelationOperators : array[0..pred(ffcl_MaxIndexFlds)] of TffSqlRelOp;
RelationOperatorB : array[0..pred(ffcl_MaxIndexFlds)] of TffSqlRelOp; {!!.11}
RelationKeyIsUnique: Boolean;
RelationKeyIsCaseInsensitive: Boolean;
RelationKeyIndexAsc : Boolean;
ArgExpressionB : array[0..pred(ffcl_MaxIndexFlds)] of TffSqlSimpleExpression; {!!.11}
ArgExpressions : array[0..pred(ffcl_MaxIndexFlds)] of TffSqlSimpleExpression;
{$IFDEF LogIndexAnalysis}
RelationFields : array[0..pred(ffcl_MaxIndexFlds)] of TFFSqlFieldProxy;
{$ENDIF}
SameCases : array[0..pred(ffcl_MaxIndexFlds)] of Boolean;
SameCaseB: array[0..pred(ffcl_MaxIndexFlds)] of Boolean; {!!.11}
DepIndex: Integer;
end;
TFFSqlTableProxySubset = class(TffObject)
protected
FTable : TFFSqlTableProxy;
FOpposite: TFFSqlTableProxy;
FOuter: Boolean;
public
Relations: Integer;
KeyRelation: TffSqlKeyRelation;
constructor Create(Table: TFFSqlTableProxy);
function EqualKeyDepth: Integer;
procedure Iterate(Iterator: TFFSqlTableIterator; Cookie: TffWord32);
property Table : TFFSqlTableProxy read FTable;
procedure Assign(const Source: TFFSqlTableProxySubset);
function UniqueValue: Boolean;
function ClosedSegment: Boolean;
function KeyDepth: Integer;
property Outer: Boolean read FOuter write FOuter;
property Opposite: TFFSqlTableProxy read FOpposite write FOpposite;
end;
TFFSqlTableProxySubsetList = class;
TffSqlCondTerm = class(TffSqlNode)
protected
CondFactorList : TList;
FIsConstant: Boolean;
FIsConstantChecked: Boolean;
ConstantValue: Variant;
OrderedSources : TFFSqlTableProxySubsetList;
procedure Clear;
procedure CheckIsConstant;
function IsConstant: Boolean;
function GetCondFactor(Index: Integer): TffSqlCondFactor;
procedure SetCondFactor(Index: Integer; const Value: TffSqlCondFactor);
function GetCondFactorCount: Integer;
function GetSize: Integer; override;
function GetTitle(const Qualified : boolean): string; {!!.11}
function GetType: TffFieldType; override;
function GetDecimals: Integer; override;
function Reduce: Boolean;
procedure ResetConstant; override;
function AsBooleanLevel(Level: Integer): Boolean;
procedure MatchType(ExpectedType: TffFieldType); {!!.11}
public
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
procedure Assign(const Source: TffSqlNode); override;
constructor Create(AParent: TffSqlNode);
destructor Destroy; override;
function AddCondFactor(Factor : TffSqlCondFactor): TffSqlCondFactor;
function InsertCondFactor(Index: Integer; Factor : TffSqlCondFactor):
TffSqlCondFactor;
property CondFactorCount : Integer read GetCondFactorCount;
property CondFactor[Index: Integer] : TffSqlCondFactor
read GetCondFactor write SetCondFactor;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function AsBoolean: Boolean;
function GetValue: Variant;
procedure BindHaving;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
procedure SetLevelDep(List: TFFSqlTableProxySubsetList);
end;
TFFSqlTableProxySubsetList = class(TffObject)
protected
FList : TList;
Level : Integer;
FCondTerm : TffSqlCondTerm;
FCreateResultRecord : TFFObjectProc;
FRecordsRead : Longint;
FOwner: TffSqlStatement;
WroteRow: Boolean;
FOuterJoin: Boolean;
FSkipInner: Boolean;
V : array[0..pred(ffcl_MaxIndexFlds)] of Variant;
VB : array[0..pred(ffcl_MaxIndexFlds)] of Variant; {!!.11}
procedure ReadSources;
function GetItem(Index: Integer): TFFSqlTableProxySubset;
function GetCount: Integer;
function ProcessLevel(Cookie1: TffWord32): Boolean;
procedure Clear;
function Insert(
TableProxySubset: TFFSqlTableProxySubset): TFFSqlTableProxySubset;
public
constructor Create(AOwner: TffSqlStatement);
destructor Destroy; override;
function Add(TableProxySubset: TFFSqlTableProxySubset): TFFSqlTableProxySubset;
procedure Delete(Index: Integer);
property Item[Index: Integer]: TFFSqlTableProxySubset read GetItem;
property Count: Integer read GetCount;
procedure Assign(const Source: TFFSqlTableProxySubsetList);
function RelationUsed(Relation: TffSqlCondFactor): Boolean;
function DependencyExists(Table : TFFSqlTableProxy): Boolean;
procedure Join(
CondTerm: TffSqlCondTerm;
CreateResultRecord: TFFObjectProc);
property RecordsRead : Longint read FRecordsRead;
property Owner: TffSqlStatement read FOwner;
property OuterJoin: Boolean read FOuterJoin write FOuterJoin;
property SkipInner: Boolean read FSkipInner write FSkipInner;
end;
TffSqlCondExp = class(TffSqlNode)
protected
CondTermList : TList;
FIsConstant: Boolean;
FIsConstantChecked: Boolean;
ConstantValue: Variant;
procedure Clear;
procedure CheckIsConstant;
function IsConstant: Boolean;
function GetCondTerm(Index: Integer): TffSqlCondTerm;
procedure SetCondTerm(Index: Integer; const Value: TffSqlCondTerm);
function GetCondTermCount: Integer;
procedure MatchType(ExpectedType: TffFieldType);
function GetType: TffFieldType; override;
function GetDecimals: Integer; override;
function GetSize: Integer; override;
procedure ResetConstant; override;
function Reduce: Boolean;
function AsBooleanLevel(Level: Integer): Boolean;
procedure SetLevelDep(List: TFFSqlTableProxySubsetList);
function GetTitle(const Qualified : boolean): string; {!!.11}
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
constructor Create(AParent: TffSqlNode);
destructor Destroy; override;
function AddCondTerm(Term : TffSqlCondTerm): TffSqlCondTerm;
property CondTermCount : Integer read GetCondTermCount;
property CondTerm[Index: Integer] : TffSqlCondTerm
read GetCondTerm write SetCondTerm;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function AsBoolean: Boolean;
function GetValue: Variant;
procedure BindHaving;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
end;
TffComp = array[0..7] of Byte;
TffSqlFloatLiteral = class(TffSqlNode)
protected
FValue : string;
SingleValue : single;
DoubleValue : double;
ExtendedValue : extended;
CompValue : TffComp;
CurrencyValue : currency;
Converted: Boolean;
procedure ConvertToNative;
procedure MatchType(ExpectedType: TffFieldType);
function GetType: TffFieldType; override;
function GetDecimals: Integer; override;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
property Value : string read FValue write FValue;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function GetValue: Variant;
end;
TffSqlIntegerLiteral = class(TffSqlNode)
protected
FValue : string;
Int32Value: Integer;
Converted: Boolean;
procedure ConvertToNative;
procedure MatchType(ExpectedType: TffFieldType);
function GetType: TffFieldType; override;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
property Value : string read FValue write FValue;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function GetValue: Variant;
end;
TffSqlStringLiteral = class(TffSqlNode)
protected
FValue : string;
FType : TffFieldType;
Converted : Boolean;
CharValue : Char;
WideCharValue : WideChar;
ShortStringValue : ShortString;
ShortAnsiStringValue : ShortString;
NullStringValue : string;
NullAnsiStrValue : string;
WideStringValue : WideString;
procedure ConvertToNative;
procedure MatchType(ExpectedType: TffFieldType);
function GetSize: Integer; override;
function GetType: TffFieldType; override;
public
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
procedure Assign(const Source: TffSqlNode); override;
constructor Create(AParent: TffSqlNode);
property Value : string read FValue write FValue;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function GetValue: Variant;
end;
TffSqlIntervalDef = (iUnspec, iYear, iMonth, iDay, iHour, iMinute, iSecond);
TffSqlIntervalLiteral = class(TffSqlNode)
protected
FValue : string;
FStartDef : TffSqlIntervalDef;
FEndDef : TffSqlIntervalDef;
Y1, M1, D1, H1, S1 : Integer;
Converted: Boolean;
procedure ConvertToNative;
procedure MatchType(ExpectedType: TffFieldType);
function GetType: TffFieldType; override;
function AddIntervalTo(Target: TDateTime): TDateTime;
function SubtractIntervalFrom(Target: TDateTime): TDateTime;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
property Value : string read FValue write FValue;
property StartDef : TffSqlIntervalDef read FStartDef write FStartDef;
property EndDef : TffSqlIntervalDef read FEndDef write FEndDef;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function GetValue: Variant;
end;
TffSqlTimestampLiteral = class(TffSqlNode)
protected
FValue : string;
DateTimeValue: TDateTime;
Converted: Boolean;
procedure ConvertToNative;
procedure MatchType(ExpectedType: TffFieldType);
function GetType: TffFieldType; override;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
property Value : string read FValue write FValue;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function GetValue: Variant;
end;
TffSqlTimeLiteral = class(TffSqlNode)
protected
FValue : string;
TimeValue : TDateTime;
Converted : Boolean;
procedure ConvertToNative;
procedure MatchType(ExpectedType: TffFieldType);
function GetType: TffFieldType; override;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
property Value : string read FValue write FValue;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function GetValue: Variant;
end;
TffSqlDateLiteral = class(TffSqlNode)
protected
FValue : string;
DateValue : TDateTime;
Converted : Boolean;
procedure ConvertToNative;
procedure MatchType(ExpectedType: TffFieldType);
function GetType: TffFieldType; override;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
property Value : string read FValue write FValue;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function GetValue: Variant;
end;
TffSqlBooleanLiteral = class(TffSqlNode)
protected
FValue : Boolean;
procedure MatchType(ExpectedType: TffFieldType);
function GetType: TffFieldType; override;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
property Value : Boolean read FValue write FValue;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function GetValue: Boolean;
end;
TffSqlLiteral = class(TffSqlNode)
protected
FFloatLiteral: TffSqlFloatLiteral;
FIntegerLiteral: TffSqlIntegerLiteral;
FStringLiteral: TffSqlStringLiteral;
FDateLiteral : TffSqlDateLiteral;
FTimeLiteral : TffSqlTimeLiteral;
FTimeStampLiteral : TffSqlTimestampLiteral;
FIntervalLiteral : TffSqlIntervalLiteral;
FBooleanLiteral: TffSqlBooleanLiteral;
procedure Clear;
procedure MatchType(ExpectedType: TffFieldType);
function GetSize: Integer; override;
function GetType: TffFieldType; override;
function GetDecimals: Integer; override;
function AddIntervalTo(Target: TDateTime): TDateTime;
function SubtractIntervalFrom(Target: TDateTime): TDateTime;
public
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
procedure Assign(const Source: TffSqlNode); override;
destructor Destroy; override;
property BooleanLiteral : TffSqlBooleanLiteral
read FBooleanLiteral write FBooleanLiteral;
property FloatLiteral : TffSqlFloatLiteral
read FFloatLiteral write FFloatLiteral;
property IntegerLiteral : TffSqlIntegerLiteral
read FIntegerLiteral write FIntegerLiteral;
property StringLiteral : TffSqlStringLiteral
read FStringLiteral write FStringLiteral;
property DateLiteral : TffSqlDateLiteral
read FDateLiteral write FDateLiteral;
property TimeLiteral : TffSqlTimeLiteral
read FTimeLiteral write FTimeLiteral;
property TimeStampLiteral : TffSqlTimestampLiteral
read FTimestampLiteral write FTimestampLiteral;
property IntervalLiteral : TffSqlIntervalLiteral
read FIntervalLiteral write FIntervalLiteral;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function GetValue : Variant;
end;
TffSqlParam = class(TffSqlNode)
protected
FParmIndex: Integer;
function GetSize: Integer; override;
function GetTitle(const Qualified : boolean): string; {!!.11}
function GetType: TffFieldType; override;
procedure MatchType(ExpectedType: TffFieldType);
function GetDecimals: Integer; override;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
constructor Create(AParent: TffSqlNode);
property ParmIndex: Integer read FParmIndex;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function GetValue: Variant;
end;
TffSqlCoalesceExpression = class(TffSqlNode)
protected
ArgList : TList;
procedure Clear;
function GetArg(Index: Integer): TffSqlSimpleExpression;
function GetArgCount: Integer;
function GetSize: Integer; override;
function GetType: TffFieldType; override;
function Reduce: Boolean;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
constructor Create(AParent: TffSqlNode);
destructor Destroy; override;
property ArgCount : Integer read GetArgCount;
property Arg[Index: Integer]: TffSqlSimpleExpression read GetArg;
function AddArg(Value: TffSqlSimpleExpression): TffSqlSimpleExpression;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function GetValue: Variant;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
end;
TffSqlWhenClause = class(TffSqlNode)
protected
FWhenExp : TffSqlCondExp;
FThenExp : TffSqlSimpleExpression;
FIsConstant: Boolean;
FIsConstantChecked: Boolean;
procedure CheckIsConstant;
function IsConstant: Boolean;
procedure ResetConstant; override;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
destructor Destroy; override;
property WhenExp : TffSqlCondExp read FWhenExp write FWhenExp;
property ThenExp : TffSqlSimpleExpression read FThenExp write FThenExp;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
end;
TffSqlWhenClauseList = class(TffSqlNode)
protected
WhenClauseList : TList;
FIsConstant: Boolean;
FIsConstantChecked: Boolean;
procedure Clear;
procedure CheckIsConstant;
function IsConstant: Boolean;
function GetWhenClause(Index: Integer): TffSqlWhenClause;
function GetWhenClauseCount: Integer;
procedure ResetConstant; override;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
constructor Create(AParent: TffSqlNode);
destructor Destroy; override;
property WhenClauseCount : Integer read GetWhenClauseCount;
property WhenClause[Index: Integer]: TffSqlWhenClause read GetWhenClause;
function AddWhenClause(Value: TffSqlWhenClause): TffSqlWhenClause;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
end;
TffSqlCaseExpression = class(TffSqlNode)
protected
FWhenClauseList : TffSqlWhenClauseList;
FElseExp : TffSqlSimpleExpression;
FIsConstant: Boolean;
FIsConstantChecked: Boolean;
ConstantValue: Variant;
procedure CheckIsConstant;
function GetSize: Integer; override;
function GetType: TffFieldType; override;
function IsConstant: Boolean;
function Reduce: Boolean;
procedure ResetConstant; override;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
destructor Destroy; override;
property WhenClauseList : TffSqlWhenClauseList
read FWhenClauseList write FWhenClauseList;
property ElseExp : TffSqlSimpleExpression read FElseExp write FElseExp;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function GetValue: Variant;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
end;
TffSqlScalarFunction = (sfCase, sfCharlen, sfCoalesce, sfCurrentDate, sfCurrentTime,
sfCurrentTimestamp, sfCurrentUser, sfLower, sfUpper, sfPosition,
sfSessionUser, sfSubstring, sfSystemUser, sfTrim, sfExtract, sfNullIf,
sfAbs, sfCeil, sfFloor, sfExp, sfLog, sfPower, sfRand, sfRound); {!!.11}
TffSqlLTB = (ltbBoth, ltbLeading, ltbTrailing);
TffSqlScalarFunc = class(TffSqlNode)
protected
FSQLFunction : TffSqlScalarFunction;
FArg1 : TffSqlSimpleExpression;
FArg2 : TffSqlSimpleExpression;
FArg3 : TffSqlSimpleExpression;
FLTB : TffSqlLTB;
FXDef : TffSqlIntervalDef;
FCaseExp : TffSqlCaseExpression;
FCoalesceExp : TffSqlCoalesceExpression;
FIsConstant: Boolean;
FIsConstantChecked: Boolean;
FType : TffFieldType;
TypeKnown : Boolean;
ConstantValue: Variant;
procedure Clear;
procedure CheckIsConstant;
function IsConstant: Boolean;
function IsFieldFrom(Table: TFFSqlTableProxy;
var FieldReferenced: TFFSqlFieldProxy): Boolean;
function GetTitle(const Qualified : boolean): string; {!!.11}
procedure MatchType(ExpectedType: TffFieldType);
function GetDecimals: Integer; override;
function GetSize: Integer; override;
function GetType: TffFieldType; override;
procedure CheckType;
function Reduce: Boolean;
procedure ResetConstant; override;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
destructor Destroy; override;
property SQLFunction : TffSqlScalarFunction
read FSQLFunction write FSQLFunction;
property Arg1 : TffSqlSimpleExpression read FArg1 write FArg1;
property Arg2 : TffSqlSimpleExpression read FArg2 write FArg2;
property Arg3 : TffSqlSimpleExpression read FArg3 write FArg3;
property LTB : TffSqlLTB read FLTB write FLTB;
property XDef : TffSqlIntervalDef read FXDef write FXDef;
property CaseExp : TffSqlCaseExpression read FCaseExp write FCaseExp;
property CoalesceExp : TFFSqlCoalesceExpression
read FCoalesceExp write FCoalesceExp;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function GetValue: Variant;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
end;
TffSqlMulOp = (moMul, moDiv);
TffSqlFactor = class(TffSqlNode)
protected
TypeKnown : Boolean;
FType : TffFieldType;
FMulOp: TffSqlMulOp;
FUnaryMinus : Boolean;
FCondExp: TffSqlCondExp;
FFieldRef: TffSqlFieldRef;
FLiteral: TffSqlLiteral;
FParam: TffSqlParam;
FAggregate : TffSqlAggregate;
FSubQuery : TffSqlSELECT;
FScalarFunc : TffSqlScalarFunc;
FIsConstant: Boolean;
FIsConstantChecked: Boolean;
ConstantValue: Variant;
procedure Clear;
procedure CheckIsConstant;
function IsConstant: Boolean;
function GetDecimals: Integer; override;
function GetSize: Integer; override;
function GetType: TffFieldType; override;
procedure CheckType;
function GetTitle(const Qualified : boolean): string; {!!.11}
procedure MatchType(ExpectedType: TffFieldType);
function IsAggregate: Boolean; override;
function AddIntervalTo(Target: TDateTime): TDateTime;
function Reduce: Boolean;
function SubtractIntervalFrom(Target: TDateTime): TDateTime;
procedure ResetConstant; override;
public
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
procedure Assign(const Source: TffSqlNode); override;
destructor Destroy; override;
property MulOp :TffSqlMulOp read FMulOp write FMulOp;
property UnaryMinus : Boolean read FUnaryMinus write FUnaryMinus;
property CondExp : TffSqlCondExp read FCondExp write FCondExp;
property FieldRef : TffSqlFieldRef read FFieldRef write FFieldRef;
property Literal : TffSqlLiteral read FLiteral write FLiteral;
property Param : TffSqlParam read FParam write FParam;
property Aggregate : TffSqlAggregate read FAggregate write FAggregate;
property SubQuery : TffSqlSELECT read FSubQuery write FSubQuery;
property ScalarFunc : TffSqlScalarFunc read FScalarFunc write FScalarFunc;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function GetValue: Variant;
function HasFieldRef: Boolean;
function IsField(var FieldReferenced: TFFSqlFieldProxy): Boolean;
function IsFieldFrom(Table: TFFSqlTableProxy;
var FieldReferenced: TFFSqlFieldProxy; var SameCase: Boolean): Boolean;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
function IsNull: Boolean;
function WasWildcard : Boolean; {!!.11}
end;
TffSqlAddOp = (aoPlus, aoMinus, aoConcat);
TffSqlTerm = class(TffSqlNode)
protected
TypeKnown : Boolean;
FType : TffFieldType;
FAddOp: TffSqlAddOp;
FactorList : TList;
FIsConstantChecked: Boolean;
FIsConstant: Boolean;
ConstantValue: Variant;
procedure Clear;
procedure CheckIsConstant;
function IsConstant: Boolean;
function GetFactor(Index: Integer): TffSqlFactor;
procedure SetFactor(Index: Integer; const Value: TffSqlFactor);
function GetFactorCount: Integer;
function GetDecimals: Integer; override;
function GetSize: Integer; override;
function GetType: TffFieldType; override;
procedure CheckType;
function GetTitle(const Qualified : boolean): string; {!!.11}
procedure MatchType(ExpectedType: TffFieldType);
function IsAggregate: Boolean; override;
//function GetAgg: TffSqlAggregate; override;
function AddIntervalTo(Target: TDateTime): TDateTime;
function SubtractIntervalFrom(Target: TDateTime): TDateTime;
function Reduce: Boolean;
procedure ResetConstant; override;
public
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
procedure Assign(const Source: TffSqlNode); override;
constructor Create(AParent: TffSqlNode);
destructor Destroy; override;
function AddFactor(Factor: TffSqlFactor): TffSqlFactor;
property FactorCount : Integer read GetFactorCount;
property Factor[Index: Integer] : TffSqlFactor read GetFactor write SetFactor;
property AddOp :TffSqlAddOp read FAddOp write FAddOp;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function GetValue: Variant;
function HasFieldRef: Boolean;
function IsField(var FieldReferenced: TFFSqlFieldProxy): Boolean;
function IsFieldFrom(Table: TFFSqlTableProxy;
var FieldReferenced: TFFSqlFieldProxy; var SameCase: Boolean): Boolean;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
function IsAggregateExpression: Boolean;
function IsNull: Boolean;
function WasWildcard : Boolean; {!!.11}
end;
TffSqlSimpleExpression = class(TffSqlNode)
protected
TypeKnown : Boolean;
FType : TffFieldType;
BoundHaving : Boolean;
BoundHavingField : TFFSqlFieldProxy;
FIsConstant : Boolean;
FIsConstantChecked: Boolean;
ConstantValue: Variant;
BindingHaving: Boolean;
procedure BindHaving;
procedure Clear;
function ConcatBLOBValues(const Value1, Value2 : Variant) : Variant; {!!.13}
function GetTerm(Index: Integer): TffSqlTerm;
procedure SetTerm(Index: Integer; const Value: TffSqlTerm);
function GetTermCount: Integer;
function GetSize: Integer; override;
function GetDecimals: Integer; override;
function GetType: TffFieldType; override;
procedure CheckType;
function GetTitle(const Qualified : boolean): string; {!!.11}
procedure MatchType(ExpectedType: TffFieldType);
function IsAggregate: Boolean; override;
function IsConstant: Boolean;
function IsParameter: Boolean;
procedure CheckIsConstant;
function Reduce: Boolean;
procedure ResetConstant; override;
protected
TermList : TList;
public
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
procedure Assign(const Source: TffSqlNode); override;
constructor Create(AParent: TffSqlNode);
destructor Destroy; override;
function AddTerm(Term : TffSqlTerm): TffSqlTerm;
property TermCount : Integer read GetTermCount;
property Term[Index: Integer] : TffSqlTerm read GetTerm write SetTerm;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function GetValue: Variant;
function HasFieldRef: Boolean;
function IsField(var FieldReferenced: TFFSqlFieldProxy): Boolean;
function IsFieldFrom(Table: TFFSqlTableProxy;
var FieldReferenced: TFFSqlFieldProxy; var SameCase: Boolean): Boolean;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
function IsAggregateExpression: Boolean;
function IsNull: Boolean;
function WasWildcard : Boolean; {!!.11}
end;
TffSqlSimpleExpressionList = class(TffSqlNode)
protected
FExpressionList : TList;
FIsConstant: Boolean;
FIsConstantChecked: Boolean;
procedure CheckIsConstant;
procedure Clear;
function IsConstant: Boolean;
function GetExpression(Index: Integer): TffSqlSimpleExpression;
function GetExpressionCount: Integer;
procedure SetExpression(Index: Integer;
const Value: TffSqlSimpleExpression);
procedure MatchType(ExpectedType: TffFieldType);
function Contains(const TestValue: Variant): Boolean;
function Reduce: Boolean;
procedure ResetConstant; override;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
constructor Create(AParent: TffSqlNode);
destructor Destroy; override;
function AddExpression(Expression: TffSqlSimpleExpression):
TffSqlSimpleExpression;
property ExpressionCount : Integer read GetExpressionCount;
property Expression[Index: Integer] : TffSqlSimpleExpression
read GetExpression write SetExpression;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
end;
TffSqlSelection = class(TffSqlNode)
protected
FColumn: TffSqlColumn;
FSimpleExpression: TffSqlSimpleExpression;
AddedByWildcard: Boolean;
procedure AddColumnDef(Target: TffSqlColumnListOwner); override;
function GetIndex: Integer;
function Reduce: Boolean;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
destructor Destroy; override;
property SimpleExpression : TffSqlSimpleExpression
read FSimpleExpression write FSimpleExpression;
property Column : TffSqlColumn read FColumn write FColumn;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
property Index: Integer read GetIndex;
function IsAggregateExpression: Boolean;
end;
TffSqlSelectionList = class(TffSqlNode)
protected
FSelections : TList;
procedure Clear;
function GetSelection(Index: Integer): TffSqlSelection;
procedure SetSelection(Index: Integer;
const Value: TffSqlSelection);
function GetSelectionCount: Integer;
function Reduce: Boolean;
// procedure ResetConstant; override;
function GetNonWildSelection(Index: Integer): TffSqlSelection;
property NonWildSelection[Index: Integer]: TffSqlSelection
read GetNonWildSelection;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
constructor Create(AParent: TffSqlNode);
destructor Destroy; override;
function AddSelection(NewSelection: TffSqlSelection): TffSqlSelection;
procedure InsertSelection(Index: Integer; NewSelection: TffSqlSelection);
property SelectionCount : Integer read GetSelectionCount;
property Selection[Index: Integer]: TffSqlSelection
read GetSelection write SetSelection;
function FindSelection(GroupCol : TffSqlGroupColumn): TffSqlSelection;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function NonWildSelectionCount: Integer;
end;
TffSqlInsertColumnList = class;
TffSqlTableRef = class(TffSqlNode)
protected
FAlias : string;
FTableName : string;
FTableExp: TffSqlTableExp;
FColumnList: TFFSqlInsertColumnList;
FDatabaseName: string;
FTable: TffSqlTableProxy;
procedure AddTableReference(Select: TffSqlSELECT); override;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
procedure Execute(
var aLiveResult: Boolean; var aCursorID: TffCursorID;
var RecordsRead: Integer);
function GetResultTable: TFFSqlTableProxy;
function GetSQLName: string;
function BindFieldDown(const TableName,
FieldName: string): TFFSqlFieldProxy;
function BindTable(AOwner: TObject; const TableName: string): TFFSqlTableProxy;
function Reduce: Boolean; {!!.11}
function TargetFieldFromSourceField(const F: TffSqlFieldProxy): TffSqlFieldProxy;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
property TableName : string read FTableName write FTableName;
property DatabaseName: string read FDatabaseName write FDatabaseName;
property Alias : string read FAlias write FAlias;
property TableExp: TffSqlTableExp read FTableExp write FTableExp;
property ColumnList : TFFSqlInsertColumnList
read FColumnList write FColumnList;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
procedure Clear;
destructor Destroy; override;
property SQLName: string read GetSQLName;
function GetTable(AOwner: TObject; const ExclContLock : Boolean): TffSqlTableProxy;
property ResultTable: TFFSqlTableProxy read GetResultTable;
end;
TffSqlTableRefList = class(TffSqlNode)
protected
FTableRefList : TList;
function BindTable(AOwner: TObject;
const TableName: string): TFFSqlTableProxy;
procedure Clear;
function GetTableRef(Index: Integer): TffSqlTableRef;
procedure SetTableRef(Index: Integer;
const Value: TffSqlTableRef);
function GetTableRefCount: Integer;
function Reduce: Boolean;
function BindFieldDown(const TableName,
FieldName: string): TFFSqlFieldProxy;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
constructor Create(AParent: TffSqlNode);
destructor Destroy; override;
function AddTableRef(NewTableRef: TffSqlTableRef): TffSqlTableRef;
function GetNameForAlias(const Alias : string) : string;
property TableRefCount : Integer read GetTableRefCount;
property TableRef[Index: Integer]: TffSqlTableRef
read GetTableRef write SetTableRef;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function GetFieldsFromTable(const TableName: string; List: TList): TffSqlTableProxy;
end;
TffSqlOrderItem = class(TffSqlNode)
protected
FColumn: TFFSqlOrderColumn;
FIndex: string;
FDescending: Boolean;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
constructor Create(AParent: TffSqlNode);
destructor Destroy; override;
property Column: TFFSqlOrderColumn read FColumn write FColumn;
property Index: string read FIndex write FIndex;
property Descending: Boolean read FDescending write FDescending;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
end;
TffSqlOrderList = class(TffSqlNode)
protected
FOrderItemList : TList;
procedure Clear;
function GetOrderItem(Index: Integer): TffSqlOrderItem;
procedure SetOrderItem(Index: Integer;
const Value: TffSqlOrderItem);
function GetOrderCount: Integer;
function Reduce: Boolean;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
constructor Create(AParent: TffSqlNode);
destructor Destroy; override;
function AddOrderItem(NewOrder: TffSqlOrderItem): TffSqlOrderItem;
property OrderCount : Integer read GetOrderCount;
property OrderItem[Index: Integer]: TffSqlOrderItem
read GetOrderItem write SetOrderItem;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
end;
TffSqlOuterJoinMode = (jmNone, jmLeft, jmRight, jmFull);
TffSqlJoiner = class(TffObject)
protected
FSources : TFFSqlTableProxySubsetList;
FTargetTable : TFFSqlTableProxy;
Level : integer;
FRecordsRead : Longint;
{$IFDEF CountWrites}
FRecordsWritten : Longint;
{$ENDIF}
FieldCopier : TffFieldCopier;
FSX, FT : TList;
FCondExpWhere: TffSqlCondExp;
RecListL, RecListR,
DupList : TffNRecordHash;
FirstCondTerm, LastCondTerm : Boolean;
OptimizeCalled: Boolean;
WasOptimized: Boolean;
P: procedure of object;
FOwner: TffSqlStatement;
procedure CreateResultRecord;
function ProcessLevel(Cookie1: TffWord32): Boolean;
procedure ReadSources;
function FindRelation(Term: TffSqlCondTerm; CurFactor,
CurFactor2: TffSqlCondFactor; Table : TFFSqlTableProxy;
TargetField : TFFSqlFieldProxy;
var Operator: TffSqlRelOp;
var ArgExpression: TffSqlSimpleExpression;
var SameCase: Boolean): TffSqlCondFactor;
procedure Optimize(UseIndex: Boolean);
function WriteNull(Cookie: TffWord32): Boolean;
public
constructor Create(AOwner: TffSqlStatement; CondExp: TffSqlCondExp);
destructor Destroy; override;
procedure Execute(UseIndex: Boolean; LoopProc: TFFObjectProc;
OuterJoinMode: TffSqlOuterJoinMode);
property Sources : TFFSqlTableProxySubsetList read FSources;
procedure AddColumn(
SourceExpression: TffSqlSimpleExpression;
SourceField : TffSqlFieldProxy;
Target: TFFSqlFieldProxy);
procedure ClearColumnList;
property RecordsRead : Longint read FRecordsRead;
{$IFDEF CountWrites}
property RecordsWritten: Longint read FRecordsWritten;
{$ENDIF}
property CondExpWhere : TffSqlCondExp read FCondExpWhere write FCondExpWhere;
property Target : TFFSqlTableProxy read FTargetTable write FTargetTable;
property Owner: TffSqlStatement read FOwner;
end;
TffSqlColumnListOwner = class(TffSqlNode)
protected
T : TffSqlTableProxy; {!!.11}
Columns : TStringList;
public
constructor Create(AParent: TffSqlNode);
destructor Destroy; override;
end;
TffSqlJoinTableExp = class;
TffSqlNonJoinTableExp = class;
TffSqlTableExp = class(TffSqlNode)
protected
FJoinTableExp: TffSqlJoinTableExp;
FNonJoinTableExp: TffSqlNonJoinTableExp;
FNestedTableExp: TffSqlTableExp;
procedure EnsureResultTable(NeedData: Boolean);
function CheckNoDups: Boolean;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
function BindTable(AOwner: TObject;
const TableName: string): TFFSqlTableProxy;
function BindFieldDown(const TableName,
FieldName: string): TFFSqlFieldProxy;
function TargetFieldFromSourceField(
const F: TffSqlFieldProxy): TffSqlFieldProxy;
public
function GetResultTable: TFFSqlTableProxy;
property JoinTableExp: TffSqlJoinTableExp
read FJoinTableExp write FJoinTableExp;
property NonJoinTableExp: TffSqlNonJoinTableExp
read FNonJoinTableExp write FNonJoinTableExp;
property NestedTableExp: TffSqlTableExp
read FNestedTableExp write FNestedTableExp;
function Equals(Other: TffSqlNode): Boolean; override;
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
procedure Clear;
destructor Destroy; override;
procedure Execute(
var aLiveResult: Boolean; var aCursorID: TffCursorID;
var RecordsRead: Integer);
function Reduce: Boolean;
procedure EmitSQL(Stream : TStream); override;
property ResultTable: TFFSqlTableProxy read GetResultTable;
function GetFieldsFromTable(const TableName: string; List: TList):
TffSqlTableProxy; {!!.11}
end;
TFFSqlUsingItem = class(TffSqlNode)
protected
FColumnName: string;
public
property ColumnName: string read FColumnName write FColumnName;
function Equals(Other: TffSqlNode): Boolean; override;
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
procedure EmitSQL(Stream : TStream); override;
end;
TffSqlUsingList = class(TffSqlNode)
protected
FUsingItemList : TList;
procedure Clear;
function GetUsingItem(Index: Integer): TffSqlUsingItem;
procedure SetUsingItem(Index: Integer;
const Value: TffSqlUsingItem);
function GetUsingCount: Integer;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
constructor Create(AParent: TffSqlNode);
destructor Destroy; override;
function AddItem(NewUsing: TffSqlUsingItem): TffSqlUsingItem;
property UsingCount : Integer read GetUsingCount;
property UsingItem[Index: Integer]: TffSqlUsingItem
read GetUsingItem write SetUsingItem;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
end;
TffSqlJoinType = (jtCross, jtInner, jtLeftOuter, jtRightOuter,
jtFullOuter, jtUnion);
TffSqlJoinTableExp = class(TffSqlNode)
protected
FTableRef1: TffSqlTableRef;
FTableRef2: TffSqlTableRef;
FCondExp: TFFSqlCondExp;
FJoinType: TffSqlJoinType;
FNatural: Boolean;
Bound: Boolean;
TL, TR : TffSqlTableProxy;
Columns: TStringList;
Joiner : TffSqlJoiner;
FUsingList: TFFSqlUsingList;
UsingCondExp: TFFSqlCondExp;
FResultTable : TFFSqlTableProxy;
HaveData: Boolean;
function BindTable(AOwner: TObject;
const TableName: string): TFFSqlTableProxy;
function GetResultTable: TffSqlTableProxy;
function Execute2(NeedData: Boolean): TffSqlTableProxy;
procedure Bind;
procedure ClearBindings(Node: TffSqlNode);
procedure ClearColumns;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
function DoJoin(NeedData: Boolean): TffSqlTableProxy;
function BuildSimpleFieldExpr(AOwner: TffSqlNode; const ATableName,
AFieldName: string;
AField: TffSqlFieldProxy): TffSqlSimpleExpression;
procedure EnsureResultTable(NeedData: Boolean);
function BindFieldDown(const TableName,
FieldName: string): TFFSqlFieldProxy;
function TargetFieldFromSourceField(
const F: TffSqlFieldProxy): TffSqlFieldProxy;
public
function BindField(const TableName,
FieldName: string): TFFSqlFieldProxy; override;
property JoinType: TffSqlJoinType read FJoinType write FJoinType;
property Natural: Boolean read FNatural write FNatural;
property TableRef1: TffSqlTableRef read FTableRef1 write FTableRef1;
property TableRef2: TffSqlTableRef read FTableRef2 write FTableRef2;
property CondExp: TFFSqlCondExp read FCondExp write FCondExp;
property UsingList : TFFSqlUsingList read FUsingList write FUsingList;
function Equals(Other: TffSqlNode): Boolean; override;
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
procedure Clear;
destructor Destroy; override;
procedure Execute(var aLiveResult: Boolean;
var aCursorID: TffCursorID; var RecordsRead: Integer);
function Reduce: Boolean;
procedure EmitSQL(Stream : TStream); override;
constructor Create(AParent: TffSqlNode);
property ResultTable: TffSqlTableProxy read GetResultTable;
function GetFieldsFromTable(const TableName: string; List: TList):
TffSqlTableProxy; {!!.11}
end;
TffSqlValueList = class;
TffSqlNonJoinTablePrimary = class(TffSqlNode)
protected
FSelectSt: TFFSqlSELECT;
FValueList: TffSqlValueList;
FNonJoinTableExp: TffSqlNonJoinTableExp;
FTableRef: TffSqlTableRef;
function BindTable(AOwner: TObject;
const TableName: string): TFFSqlTableProxy;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
procedure EnsureResultTable(NeedData: Boolean);
function GetResultTable: TffSqlTableProxy;
function BindFieldDown(const TableName,
FieldName: string): TFFSqlFieldProxy;
function TargetFieldFromSourceField(
const F: TffSqlFieldProxy): TffSqlFieldProxy;
public
destructor Destroy; override;
property SelectSt: TFFSqlSELECT read FSelectSt write FSelectSt;
property ValueList: TffSqlValueList read FValueList write FValueList;
property NonJoinTableExp: TffSqlNonJoinTableExp
read FNonJoinTableExp write FNonJoinTableExp;
property TableRef: TffSqlTableRef read FTableRef write FTableRef;
procedure Clear;
function Equals(Other: TffSqlNode): Boolean; override;
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
procedure Execute(
var aLiveResult: Boolean; var aCursorID: TffCursorID;
var RecordsRead: Integer);
function Reduce: Boolean;
procedure EmitSQL(Stream : TStream); override;
property ResultTable: TffSqlTableProxy read GetResultTable;
end;
TffSqlNonJoinTableTerm = class(TffSqlNode)
protected
FNonJoinTablePrimary: TffSqlNonJoinTablePrimary;
function BindTable(AOwner: TObject;
const TableName: string): TFFSqlTableProxy;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
procedure EnsureResultTable(NeedData: Boolean);
function GetResultTable: TffSqlTableProxy;
function BindFieldDown(const TableName,
FieldName: string): TFFSqlFieldProxy;
function TargetFieldFromSourceField(
const F: TffSqlFieldProxy): TffSqlFieldProxy;
public
property NonJoinTablePrimary: TffSqlNonJoinTablePrimary
read FNonJoinTablePrimary write FNonJoinTablePrimary;
function Equals(Other: TffSqlNode): Boolean; override;
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
procedure Clear;
destructor Destroy; override;
procedure Execute(
var aLiveResult: Boolean; var aCursorID: TffCursorID;
var RecordsRead: Integer);
function Reduce: Boolean;
procedure EmitSQL(Stream : TStream); override;
property ResultTable: TffSqlTableProxy read GetResultTable;
end;
TffSqlNonJoinTableExp = class(TffSqlNode)
protected
FNonJoinTableTerm: TffSqlNonJoinTableTerm;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
function GetResultTable: TffSqlTableProxy;
procedure EnsureResultTable(NeedData: Boolean);
function BindTable(AOwner: TObject;
const TableName: string): TFFSqlTableProxy;
function BindFieldDown(const TableName,
FieldName: string): TFFSqlFieldProxy;
function TargetFieldFromSourceField(
const F: TffSqlFieldProxy): TffSqlFieldProxy;
public
property NonJoinTableTerm: TffSqlNonJoinTableTerm
read FNonJoinTableTerm write FNonJoinTableTerm;
function Equals(Other: TffSqlNode): Boolean; override;
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
procedure Clear;
destructor Destroy; override;
procedure Execute(var aLiveResult: Boolean;
var aCursorID: TffCursorID; var RecordsRead: Integer);
function Reduce: Boolean;
procedure EmitSQL(Stream : TStream); override;
property ResultTable: TffSqlTableProxy read GetResultTable;
function GetFieldsFromTable(const TableName: string; List: TList):
TffSqlTableProxy; {!!.11}
end;
TffSqlValueItem = class(TffSqlNode)
protected
FDefault : Boolean;
FSimplex: TffSqlSimpleExpression;
function GetType: TffFieldType; override;
function GetSize: Integer; override;
function GetDecimals: Integer; override;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
destructor Destroy; override;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
property Default : Boolean read FDefault write FDefault;
property Simplex: TffSqlSimpleExpression read FSimplex write FSimplex;
end;
TffSqlValueList = class(TffSqlNode)
protected
FValueItemList : TList;
FResultTable: TFFSqlTableProxy;
procedure Clear;
function GetValueItem(Index: Integer): TffSqlValueItem;
procedure SetValueItem(Index: Integer;
const Value: TffSqlValueItem);
function GetValueCount: Integer;
function GetResultTable: TFFSqlTableProxy;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
constructor Create(AParent: TffSqlNode);
destructor Destroy; override;
function AddItem(NewValue: TffSqlValueItem): TffSqlValueItem;
property ValueCount : Integer read GetValueCount;
property ValueItem[Index: Integer]: TffSqlValueItem
read GetValueItem write SetValueItem;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
procedure Execute(
var aLiveResult: Boolean; var aCursorID: TffCursorID;
var RecordsRead: Integer);
function Reduce: Boolean;
property ResultTable: TFFSqlTableProxy read GetResultTable;
end;
TffSqlSELECT = class(TffSqlColumnListOwner)
protected
FDistinct : Boolean;
FSelectionList : TffSqlSelectionList;
FTableRefList : TffSqlTableRefList;
FGroupColumnList : TffSqlGroupColumnList;
FCondExpWhere: TffSqlCondExp;
FCondExpHaving: TffSqlCondExp;
FOrderList : TffSqlOrderList;
FGrpTable : TffSqlTableProxy;
AggList : TList;
FResultTable : TFFSqlTableProxy;
TablesReferencedByOrder : TStringList;
TableAliases : TStringList;
HaveAggregates : Boolean;
AggQueryMode : TffSqlAggQueryMode;
HavingTable: TffSqlTableProxy;
IsDependent: Boolean;
Bound: Boolean;
Joiner : TffSqlJoiner;
FInWhere: Boolean;
WasStar: Boolean;
HaveData: Boolean;
RequestLive: Boolean;
TypeKnown: Boolean;
FType: TffFieldType;
FDecimals: Integer;
FSize: Integer; {!!.13}
BindingDown: Boolean; {!!.11}
procedure AddTableFields(Table : TffSqlTableProxy;
const StartPoint : Integer;
FieldRef : TffSqlFieldRef);
procedure AddTableFieldsFromList(Table : TffSqlTableProxy;
const StartPoint : Integer;
FieldRef : TffSqlFieldRef;
List: TList); {!!.11}
procedure Bind;
function BindTable(AOwner: TObject;
const TableName: string): TFFSqlTableProxy;
procedure AddTableRefs(Node: TffSqlNode);
procedure AddColumns(Node: TffSqlNode);
procedure BuildSortList(Table: TffSqlTableProxy;
var SortList: TffSqlSortArray); {!!.11}
procedure DoGroupCopy(GroupColumnsIn: Integer; AggExpList,
GroupColumnTargetField: TList);
procedure DoAggOrderBy;
procedure DoHaving;
procedure DoSortOnAll;
procedure DoRemoveDups(NeedData: Boolean);
procedure DoBuildGroupingTable(GroupColumnsIn : Integer; FSF, FSX,
GroupColumnTargetField: TList);
procedure DoOrderBy(NeedData: Boolean; Table: TffSqlTableProxy);
procedure DoCheckAggregates;
function CheckAnyValue(RelOp: TffSqlRelOp;
const Val: Variant): Boolean;
function CheckAllValues(RelOp: TffSqlRelOp;
const Val: Variant): Boolean;
{procedure CheckTableList;} {!!.12 debug code}
procedure Clear;
procedure ClearBindings(Node: TffSqlNode);
procedure ResetIsConstant(Node: TffSqlNode);
procedure FlagAggregates(Node: TffSqlNode);
procedure EnumAggregates(Node: TffSqlNode);
function BindField(const TableName,
FieldName: string): TFFSqlFieldProxy; override;
function FindField(const FieldName: string): TFFSqlFieldProxy;
procedure ExpandWildcards;
procedure MatchType(ExpectedType: TffFieldType; AllowMultiple: Boolean);
function NormalQueryResult(NeedData: Boolean): TffSqlTableProxy;
function CheckForValue(Value: Variant):Boolean;
function Match(Value: Variant; Unique: Boolean;
MatchOption: TffSqlMatchOption): Boolean;
function AggregateQueryResult(NeedData: Boolean): TffSqlTableProxy;
function CheckHaving: Boolean;
function Execute2(NeedData: Boolean): TffSqlTableProxy;
procedure EnsureResultTable(NeedData: Boolean);
procedure ClearTableList;
function Reduce: Boolean;
function GetValue: Variant;
function CheckNonEmpty: Boolean;
function IsSubQuery: Boolean;
function GetType: TffFieldType; override;
function GetDecimals: Integer; override;
function GetSize: Integer; override; {!!.13}
function GetResultTable: TFFSqlTableProxy;
function TargetFieldFromSourceField(
const F: TffSqlFieldProxy): TffSqlFieldProxy;
function TableWithCount(const ColumnName: string): TffSqlTableProxy; {!!.12}
public
property InWhere: Boolean read FInWhere write FInWhere; //used only during parsing
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
constructor Create(AParent: TffSqlNode);
destructor Destroy; override;
property Distinct: Boolean read FDistinct write FDistinct;
property SelectionList : TffSqlSelectionList
read FSelectionList write FSelectionList;
property TableRefList : TffSqlTableRefList
read FTableRefList write FTableRefList;
property CondExpWhere : TffSqlCondExp read FCondExpWhere write FCondExpWhere;
property GroupColumnList : TffSqlGroupColumnList
read FGroupColumnList write FGroupColumnList;
property CondExpHaving : TffSqlCondExp
read FCondExpHaving write FCondExpHaving;
property OrderList : TffSqlOrderList read FOrderList write FOrderList;
procedure EmitSQL(Stream : TStream); override;
procedure Execute(
var aLiveResult: Boolean; var aCursorID: TffCursorID;
var RecordsRead: Integer);
function Equals(Other: TffSqlNode): Boolean; override;
function DependsOn(Table: TFFSqlTableProxy): Boolean;
property ResultTable : TFFSqlTableProxy read GetResultTable;
end;
TffSqlInsertItem = class(TffSqlNode)
protected
FColumnName: string;
procedure AddColumnDef(Target: TffSqlColumnListOwner); override;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
property ColumnName: string read FColumnName write FColumnName;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
end;
TffSqlInsertColumnList = class(TffSqlNode)
protected
FInsertColumnItemList : TList;
procedure Clear;
function GetInsertColumnItem(Index: Integer): TffSqlInsertItem;
procedure SetInsertColumnItem(Index: Integer;
const Value: TffSqlInsertItem);
function GetInsertColumnCount: Integer;
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
constructor Create(AParent: TffSqlNode);
destructor Destroy; override;
function AddItem(NewInsertColumn: TffSqlInsertItem): TffSqlInsertItem;
property InsertColumnCount : Integer read GetInsertColumnCount;
property InsertColumnItem[Index: Integer]: TffSqlInsertItem
read GetInsertColumnItem write SetInsertColumnItem;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
end;
TffSqlINSERT = class(TffSqlColumnListOwner)
protected
FTableName: string;
FInsertColumnList: TFFSqlInsertColumnList;
FDefaultValues: Boolean;
Bound: Boolean;
// T : TffSqlTableProxy; {!!.11}
FTableExp: TffSqlTableExp;
procedure AddColumns(Node: TffSqlNode);
procedure Bind;
procedure ClearBindings(Node: TffSqlNode);
function Reduce: Boolean; {!!.11}
public
destructor Destroy; override;
property TableName : string read FTableName write FTableName;
property InsertColumnList: TFFSqlInsertColumnList
read FInsertColumnList write FInsertColumnList;
property TableExp: TffSqlTableExp read FTableExp write FTableExp;
property DefaultValues: Boolean read FDefaultValues write FDefaultValues;
procedure Assign(const Source: TffSqlNode); override;
procedure Clear;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function Execute(var RowsAffected: Integer) : TffResult; {!!.11}
end;
TffSqlDELETE = class(TffSqlColumnListOwner) {!!.11}
protected
FTableRef: TffSqlTableRef;
FCondExpWhere: TffSqlCondExp;
Bound: Boolean;
// T : TffSqlTableProxy; {!!.11}
Joiner : TffSqlJoiner;
DeleteList: TList;
procedure Bind;
function BindField(const TableName,
FieldName: string): TFFSqlFieldProxy; override;
procedure DeleteRecord;
function Reduce: Boolean; {!!.11}
public
destructor Destroy; override;
property TableRef: TffSqlTableRef read FTableRef write FTableRef;
property CondExpWhere : TffSqlCondExp
read FCondExpWhere write FCondExpWhere;
procedure Assign(const Source: TffSqlNode); override;
procedure Clear;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function Execute(var RowsAffected: Integer) : TffResult; {!!.11}
end;
TffSqlUpdateItem = class(TffSqlNode)
protected
FSimplex: TffSqlSimpleExpression;
FColumnName: string;
FDefault: Boolean;
F: TffSqlFieldProxy;
procedure AddColumnDef(Target: TffSqlColumnListOwner); override;
function Reduce: Boolean; {!!.11}
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
destructor Destroy; override;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
property ColumnName: string read FColumnName write FColumnName;
property Default: Boolean read FDefault write FDefault;
property Simplex: TffSqlSimpleExpression read FSimplex write FSimplex;
procedure Update;
end;
TffSqlUpdateList = class(TffSqlNode)
protected
FUpdateItemList : TList;
procedure Clear;
function GetUpdateItem(Index: Integer): TffSqlUpdateItem;
function GetUpdateCount: Integer;
function Reduce: Boolean; {!!.11}
public
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
constructor Create(AParent: TffSqlNode);
destructor Destroy; override;
function AddItem(NewValue: TffSqlUpdateItem): TffSqlUpdateItem;
property UpdateCount : Integer read GetUpdateCount;
property UpdateItem[Index: Integer]: TffSqlUpdateItem
read GetUpdateItem;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function Update : TffResult; {!!.11}
end;
TffSqlUPDATE = class(TffSqlColumnListOwner)
protected
FTableRef: TffSqlTableRef;
FCondExpWhere: TffSqlCondExp;
FUpdateList: TFFSqlUpdateList;
Bound: Boolean;
// T : TffSqlTableProxy; {!!.11}
Joiner : TffSqlJoiner;
FRowsAffected: Integer;
UpdateRecList: TList;
procedure AddColumns(Node: TffSqlNode);
procedure Bind;
function BindField(const TableName,
FieldName: string): TFFSqlFieldProxy; override;
procedure ClearBindings(Node: TffSqlNode);
function Reduce: Boolean; {!!.11}
procedure UpdateRecord;
public
destructor Destroy; override;
property TableRef: TffSqlTableRef read FTableRef write FTableRef;
property CondExpWhere : TffSqlCondExp read FCondExpWhere write FCondExpWhere;
property UpdateList: TFFSqlUpdateList read FUpdateList write FUpdateList;
procedure Assign(const Source: TffSqlNode); override;
procedure Clear;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
procedure EmitSQL(Stream : TStream); override;
function Equals(Other: TffSqlNode): Boolean; override;
function Execute(var RowsAffected: Integer) : TffResult; {!!.11}
end;
TffSqlStatement = class(TffSqlNode)
protected
FClientID: TffClientID;
FSessionID: TffSessionID;
FInsert: TffSqlINSERT;
StartDate,
StartDateTime,
StartTime : TDateTime;
ParmCount : Integer;
ParmList : TFFVariantList;
FUseIndex: Boolean;
FUpdate: TffSqlUPDATE;
FDelete: TffSqlDELETE;
FReduce: Boolean;
FDatabase : TffSqlDatabaseProxy;
RecordsRead: Integer;
FTableExp: TffSqlTableExp;
public
property UseIndex: Boolean read FUseIndex write FUseIndex;
property Reduce: Boolean read FReduce write FReduce;
procedure Assign(const Source: TffSqlNode); override;
procedure EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean); override;
property Insert: TffSqlINSERT read FInsert write FInsert;
property Update: TffSqlUPDATE read FUpdate write FUpdate;
property Delete: TffSqlDELETE read FDelete write FDelete;
property TableExp: TffSqlTableExp read FTableExp write FTableExp;
constructor Create;
destructor Destroy; override;
{Begin !!.11}
procedure Bind(const ClientID: TffClientID;
const SessionID: TffSessionID;
Database : TffSqlDatabaseProxy);
{End !!.11}
procedure EmitSQL(Stream : TStream); override;
{- write the SQL statement represented by this hierarchy}
{Begin !!.11}
function Execute(var aLiveResult: Boolean;
var aCursorID: TffCursorID;
var RowsAffected,
aRecordsRead: integer) : TffResult;
{End !!.11}
function Equals(Other: TffSqlNode): Boolean; override;
procedure SetParameter(Index: Integer; Value: Variant);
procedure ReduceStrength;
property Owner: TffSqlStatement read FOwner;
procedure Clear;
end;
TffGroupColumnTargetInfo = class(TffObject)
{ This class helps correlate a selection field to a slot in the
LastValues list that is created when grouping fields. There
is not a one-to-one correspondence between the two lists
because the Group By clause may reference fields not in the
selection list. }
public
SelFldIndex,
LastValueIndex : Longint;
end;
{$IFDEF ExposeLastStatement}
var
LastStatement : TffSqlStatement; {debug hook}
{$ENDIF}
implementation
uses
ffllExcp,
ffsrbase,
ffsrbde,
ffsrlock,
Math; {!!.11}
{$I ffconst.inc}
var
TimeDelta : double;
const
RelOpStr : array[TffSqlRelOp] of string =
('', '=', '<=', '<', '>', '>=', '<>');
DefStr : array[TffSqlIntervalDef] of string = (
'Unspec', 'YEAR', 'MONTH', 'DAY', 'HOUR', 'MINUTE', 'SECOND');
CanOptimizeOnOperator: array[TffSqlRelOp] of Boolean = (
{roNone, roEQ, roLE, roL, roG, roGE, roNE}
FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE);
AgString : array[TffSqlAggFunction] of string =
('COUNT','MIN','MAX','SUM','AVG');
ffSqlInConvThreshold = 8; {maximum length of expression list in
an IN clause to convert to simple expressions}
function PosCh(const SearchCh: Char; const SearchString: string): Integer;
{-same as POS but searches for a single Char}
var
Len: Integer;
begin
Len := length(SearchString);
if Len <> 0 then begin
Result := 1;
repeat
if SearchString[Result] = SearchCh then
exit;
inc(Result);
until Result > Len;
end;
Result := 0;
end;
function PosChI(const SearchCh: Char; const SearchString: string): Integer;
{-same as PosCh above, but ignores case}
var
Len: Integer;
SearchChU: Char;
begin
Len := length(SearchString);
if Len <> 0 then begin
SearchChU := UpCase(SearchCh);
Result := 1;
repeat
if SearchString[Result] = SearchCh then
exit;
if UpCase(SearchString[Result]) = SearchChU then
exit;
inc(Result);
until Result > Len;
end;
Result := 0;
end;
function PosI(const SearchFor, SearchIn: string): Integer;
{-same as POS but ignores case on both strings}
var
LenFor, LenIn, j: Integer;
FirstCh: Char;
begin
LenFor := length(SearchFor);
if LenFor = 0 then begin
Result := 0;
exit;
end;
Result := PosChI(SearchFor[1], SearchIn);
if (Result = 0) or (LenFor = 1) then
exit;
LenIn := length(SearchIn);
if LenIn <> 0 then begin
dec(LenIn, LenFor);
FirstCh := UpCase(SearchFor[1]);
repeat
if UpCase(SearchIn[Result]) = FirstCh then begin
J := 1;
repeat
inc(J);
until (J > LenFor) or (UpCase(SearchIn[Result + J - 1]) <> UpCase(SearchFor[J]));
if J > LenFor then
exit;
end;
inc(Result);
until Result > LenIn;
end;
Result := 0;
end;
{$IFNDEF DCC5OrLater}
function CompareText(const S1, S2: string): Integer; assembler;
asm
PUSH ESI
PUSH EDI
PUSH EBX
MOV ESI,EAX
MOV EDI,EDX
OR EAX,EAX
JE @@0
MOV EAX,[EAX-4]
@@0: OR EDX,EDX
JE @@1
MOV EDX,[EDX-4]
@@1: MOV ECX,EAX
CMP ECX,EDX
JBE @@2
MOV ECX,EDX
@@2: CMP ECX,ECX
@@3: REPE CMPSB
JE @@6
MOV BL,BYTE PTR [ESI-1]
CMP BL,'a'
JB @@4
CMP BL,'z'
JA @@4
SUB BL,20H
@@4: MOV BH,BYTE PTR [EDI-1]
CMP BH,'a'
JB @@5
CMP BH,'z'
JA @@5
SUB BH,20H
@@5: CMP BL,BH
JE @@3
MOVZX EAX,BL
MOVZX EDX,BH
@@6: SUB EAX,EDX
POP EBX
POP EDI
POP ESI
end;
function SameText(const S1, S2: string): Boolean; assembler;
asm
CMP EAX,EDX
JZ @1
OR EAX,EAX
JZ @2
OR EDX,EDX
JZ @3
MOV ECX,[EAX-4]
CMP ECX,[EDX-4]
JNE @3
CALL CompareText
TEST EAX,EAX
JNZ @3
@1: MOV AL,1
@2: RET
@3: XOR EAX,EAX
end;
{$ENDIF}
type
TReadSourceEvent = procedure(Sender: TObject;
var OkToCopy: boolean) of object;
TEvaluateFieldEvent = procedure(Sender: TObject;
ColumnIndex : Integer; var Res : variant) of object;
function CreateLiteralStringExp(Parent: TffSqlNode; const S: string): TffSqlSimpleExpression;
var
T : TffSqlTerm;
F : TffSqlFactor;
L : TffSqlLiteral;
SL : TffSqlStringLiteral;
begin
Result := TffSqlSimpleExpression.Create(Parent);
T := TffSqlTerm.Create(Result);
F := TffSqlFactor.Create(T);
L := TffSqlLiteral.Create(F);
SL := TffSqlStringLiteral.Create(L);
SL.Value := '''' + S + '''';
L.StringLiteral := SL;
F.Literal := L;
T.AddFactor(F);
Result.AddTerm(T);
end;
constructor TffSqlJoiner.Create(AOwner: TffSqlStatement;
CondExp: TffSqlCondExp);
begin
Assert(AOwner <> nil);
inherited Create;
FOwner := AOwner;
FCondExpWhere := CondExp;
FSources := TFFSqlTableProxySubsetList.Create(AOwner);
FieldCopier := TffFieldCopier.Create;
FSX := TList.Create;
FT := TList.Create;
end;
destructor TffSqlJoiner.Destroy;
begin
FieldCopier.Free;
FSX.Free;
FT.Free;
FSources.Free;
inherited Destroy;
end;
procedure TffSqlJoiner.AddColumn(
SourceExpression: TffSqlSimpleExpression;
SourceField : TffSqlFieldProxy;
Target: TFFSqlFieldProxy);
begin
Assert((SourceExpression = nil) or (SourceField = nil));
if (SourceExpression = nil) and (SourceField = nil) then {!!.13}
FSX.Add(Pointer(1)) // flag - see CreateResultRecord {!!.13}
else {!!.13}
FSX.Add(SourceExpression);
Target.IsTarget := True;
if SourceField <> nil then begin
FieldCopier.Add(SourceField, Target);
Target.SrcField := SourceField;
end
else
Target.SrcIndex := Pred(FSX.Count);
FT.Add(Target);
end;
procedure TffSqlJoiner.ClearColumnList;
begin
FSX.Clear;
FT.Clear;
FieldCopier.Free;
FieldCopier := TffFieldCopier.Create;
end;
function TffSqlJoiner.ProcessLevel(Cookie1: TffWord32): Boolean;
begin
inc(FRecordsRead);
inc(Owner.RecordsRead);
{ Time to check for timeout? }
if FRecordsRead mod 1000 = 0 then
FFCheckRemainingTime;
if Level > 0 then begin
if (CondExpWhere = nil) or CondExpWhere.AsBooleanLevel(Level) then begin
dec(Level);
ReadSources;
inc(Level);
end;
end else
if (CondExpWhere = nil) or CondExpWhere.AsBoolean then
P;
Result := True; {continue}
end;
procedure TffSqlJoiner.CreateResultRecord;
var
i : Integer;
V : Variant;
begin
if (DupList <> nil)
and not FirstCondTerm
and DupList.Exists then exit;
FTargetTable.Insert;
for i := 0 to pred(FTargetTable.FieldCount) do
if FSX[i] <> nil then begin
if Integer(FSX[i]) = 1 then {!!.13}
TFFSqlFieldProxy(Ft[i]).SetValue(1) {!!.13}
else begin {!!.13}
V := TFFSqlSimpleExpression(FSX[i]).GetValue;
TFFSqlFieldProxy(Ft[i]).SetValue(V);
end; {!!.13}
end;
FieldCopier.Execute;
FTargetTable.Post;
if (DupList <> nil)
and not LastCondTerm then
DupList.Add;
{$IFDEF CountWrites}
inc(FRecordsWritten);
{$ENDIF}
if assigned(RecListL) then
if not RecListL.Exists then
RecListL.Add;
if assigned(RecListR) then
if not RecListR.Exists then
RecListR.Add;
end;
function TffSqlJoiner.WriteNull(Cookie: TffWord32): Boolean;
begin
if not TffNRecordHash(Cookie).Exists then
CreateResultRecord;
Result := True; {continue}
end;
procedure TffSqlJoiner.ReadSources;
begin
with Sources.Item[Level] do
Iterate(ProcessLevel, 0);
end;
function TffSqlJoiner.FindRelation(
Term: TffSqlCondTerm;
CurFactor, CurFactor2: TffSqlCondFactor;
Table : TFFSqlTableProxy;
TargetField : TFFSqlFieldProxy;
var Operator: TffSqlRelOp;
var ArgExpression: TffSqlSimpleExpression;
var SameCase: Boolean): TffSqlCondFactor;
var
k, l : Integer;
F : TFFSqlFieldProxy;
DepFound : Boolean;
begin
with Term do begin
for k := 0 to pred(CondFactorCount) do
if (CondFactor[k] <> CurFactor)
and (CondFactor[k] <> CurFactor2)
and not OrderedSources.RelationUsed(CondFactor[k]) then
with CondFactor[k] do
if IsRelationTo(Table,
F, Operator, ArgExpression, SameCase)
and CanOptimizeOnOperator[Operator] then begin
if F = TargetField then begin
{check that it doesn't depend on something we haven't seen
at this point}
DepFound := False;
for l := 0 to pred(OrderedSources.Count) do
if ArgExpression.DependsOn(OrderedSources.Item[l].Table) then begin
DepFound := True;
break;
end;
if not DepFound then begin
Result := CondFactor[k];
exit;
end;
end;
end;
end;
Result := nil;
end;
procedure TffSqlJoiner.Execute(UseIndex: Boolean; LoopProc: TFFObjectProc;
OuterJoinMode: TffSqlOuterJoinMode);
var
i : Integer;
begin
FRecordsRead := 0;
{$IFDEF CountWrites}
FRecordsWritten := 0;
{$ENDIF}
if assigned(LoopProc) then
P := LoopProc
else
P := CreateResultRecord;
case OuterJoinMode of
jmLeft, jmFull :
begin
Sources.Item[0].Outer := True;
Sources.Item[0].Opposite := Sources.Item[1].Table;
Sources.OuterJoin := True;
end;
jmRight :
begin
Sources.Item[1].Outer := True;
Sources.Item[1].Opposite := Sources.Item[0].Table;
Sources.OuterJoin := True;
end;
end;
Optimize(UseIndex);
if WasOptimized then begin
if CondExpWhere.GetCondTermCount > 1 then begin
DupList := TffNRecordHash.Create;
for i := 0 to pred(Sources.Count) do
Duplist.AddTable(Sources.Item[i].Table);
end else
DupList := nil;
{process each term separately}
FirstCondTerm := True;
for i := 0 to pred(CondExpWhere.GetCondTermCount) do begin
LastCondTerm := i = pred(CondExpWhere.GetCondTermCount);
with CondExpWhere.CondTerm[i] do begin
OrderedSources.OuterJoin := OuterJoinMode <> jmNone;
OrderedSources.Join(CondExpWhere.CondTerm[i], P);
end;
FirstCondTerm := False;
end;
DupList.Free;
DupList := nil;
if OuterJoinMode = jmFull then begin
Sources.Item[0].Outer := False;
Sources.Item[1].Outer := True;
Sources.Item[1].Opposite := Sources.Item[0].Table;
OptimizeCalled := False;
Optimize(UseIndex);
if WasOptimized then begin
if CondExpWhere.GetCondTermCount > 1 then begin
DupList := TffNRecordHash.Create;
for i := 0 to pred(Sources.Count) do
Duplist.AddTable(Sources.Item[i].Table);
end else
DupList := nil;
{process each term separately}
FirstCondTerm := True;
for i := 0 to pred(CondExpWhere.GetCondTermCount) do begin
LastCondTerm := i = pred(CondExpWhere.GetCondTermCount);
with CondExpWhere.CondTerm[i] do begin
OrderedSources.OuterJoin := True;
OrderedSources.SkipInner := True;
OrderedSources.Join(CondExpWhere.CondTerm[i], P);
end;
FirstCondTerm := False;
end;
DupList.Free;
DupList := nil;
end else begin
if CondExpWhere <> nil then
CondExpWhere.SetLevelDep(Sources);
Level := Sources.Count - 1;
ReadSources;
end;
OptimizeCalled := False;
end;
end else begin
case OuterJoinMode of
jmLeft :
begin
RecListL := TffNRecordHash.Create;
ReclistL.AddTable(Sources.Item[0].Table);
end;
jmRight :
begin
RecListR := TffNRecordHash.Create;
ReclistR.AddTable(Sources.Item[1].Table);
end;
jmFull :
begin
RecListL := TffNRecordHash.Create;
ReclistL.AddTable(Sources.Item[0].Table);
RecListR := TffNRecordHash.Create;
ReclistR.AddTable(Sources.Item[1].Table);
end;
end;
if CondExpWhere <> nil then
CondExpWhere.SetLevelDep(Sources);
Level := Sources.Count - 1;
ReadSources;
case OuterJoinMode of
jmLeft :
begin
Sources.Item[1].Table.NullRecord;
Sources.Item[0].Table.Iterate(WriteNull, TffWord32(RecListL));
RecListL.Free;
RecListL := nil;
end;
jmRight :
begin
Sources.Item[0].Table.NullRecord;
Sources.Item[1].Table.Iterate(WriteNull, TffWord32(RecListR));
RecListR.Free;
RecListR := nil;
end;
jmFull :
begin
Sources.Item[1].Table.NullRecord;
Sources.Item[0].Table.Iterate(WriteNull, TffWord32(RecListL));
Sources.Item[0].Table.NullRecord;
Sources.Item[1].Table.Iterate(WriteNull, TffWord32(RecListR));
RecListL.Free;
RecListL := nil;
RecListR.Free;
RecListR := nil;
end;
end;
end;
end;
function CompareRelations(const R1, R2: TFFSqlTableProxySubset): Boolean;
{ Returns True if R1 is 'better' than R2, e.g. it is likely to better
limit the number of rows we have to read to produce a result}
var
U1, U2: Boolean;
I1, I2: Integer;
begin
if R2 = nil then begin
Result := True;
exit;
end;
{$IFDEF LogIndexAnalysis}
writeln(IALog, ' Comparing relations');
writeln(IALog, ' Rel1:');
writeln(IALog, ' Table name:',R1.Table.Name, ' (', R1.Table.Alias,')');
writeln(IALog, ' Unique:',R1.UniqueValue);
writeln(IALog, ' Closed segment:',R1.ClosedSegment);
writeln(IALog, ' Equal key depth:',R1.EqualKeyDepth);
writeln(IALog, ' Key depth:',R1.KeyDepth);
writeln(IALog, ' Relation key is unique:',R1.KeyRelation.RelationKeyIsUnique);
writeln(IALog, ' Relation key is case insensitive:',R1.KeyRelation.RelationKeyIsCaseInsensitive);
writeln(IALog, ' Record count:',R1.Table.GetRecordCount);
writeln(IALog, ' Expression:',R1.KeyRelation.CondF.SqlText);
writeln(IALog, ' Rel2:');
writeln(IALog, ' Table name:',R2.Table.Name, ' (', R2.Table.Alias,')');
writeln(IALog, ' Unique:',R2.UniqueValue);
writeln(IALog, ' Closed segment:',R2.ClosedSegment);
writeln(IALog, ' Equal key depth:',R2.EqualKeyDepth);
writeln(IALog, ' Key depth:',R2.KeyDepth);
writeln(IALog, ' Relation key is unique:',R2.KeyRelation.RelationKeyIsUnique);
writeln(IALog, ' Relation key is case insensitive:',R2.KeyRelation.RelationKeyIsCaseInsensitive);
writeln(IALog, ' Record count:',R2.Table.GetRecordCount);
writeln(IALog, ' Expression:',R2.KeyRelation.CondF.SqlText);
{$ENDIF}
U1 := R1.UniqueValue;
U2 := R2.UniqueValue;
if U1 then
if not U2 then begin
{$IFDEF LogIndexAnalysis}
writeln(IALog, ' 1 is unique but 2 is not');
{$ENDIF}
Result := True;
exit;
end else
else
if U2 then begin
{$IFDEF LogIndexAnalysis}
writeln(IALog, ' 2 is unique but 1 is not');
{$ENDIF}
Result := False;
exit;
end;
U1 := R1.ClosedSegment;
U2 := R2.ClosedSegment;
if U1 then
if U2 then
if R1.EqualKeyDepth > R2.EqualKeyDepth then begin
{$IFDEF LogIndexAnalysis}
writeln(IALog, ' EqualKeyDepth(1) > EqualKeyDepth(2)');
{$ENDIF}
Result := True;
exit;
end else
if R1.EqualKeyDepth < R2.EqualKeyDepth then begin
{$IFDEF LogIndexAnalysis}
writeln(IALog, ' EqualKeyDepth(1) < EqualKeyDepth(2)');
{$ENDIF}
Result := False;
exit;
end else
if R1.KeyDepth > R2.KeyDepth then begin
{$IFDEF LogIndexAnalysis}
writeln(IALog, ' KeyDepth(1) > KeyDepth(2)');
{$ENDIF}
Result := True;
exit;
end else
if R1.KeyDepth < R2.KeyDepth then begin
{$IFDEF LogIndexAnalysis}
writeln(IALog, ' KeyDepth(1) < KeyDepth(2)');
{$ENDIF}
Result := False;
exit;
end else
else begin
{$IFDEF LogIndexAnalysis}
writeln(IALog, ' Closed(1) and not Closed(2)');
{$ENDIF}
Result := True;
exit;
end
else
if U2 then begin
{$IFDEF LogIndexAnalysis}
writeln(IALog, ' not Closed(1) and Closed(2)');
{$ENDIF}
Result := False;
exit;
end;
U1 := R1.KeyRelation.RelationKeyIsUnique;
U2 := R2.KeyRelation.RelationKeyIsUnique;
if U1 then
if not U2 then begin
{$IFDEF LogIndexAnalysis}
writeln(IALog, ' RelationKeyIsUnique(1) and not RelationKeyIsUnique(2)');
{$ENDIF}
Result := True;
exit;
end else
else
if U2 then begin
{$IFDEF LogIndexAnalysis}
writeln(IALog, ' not RelationKeyIsUnique(1) and RelationKeyIsUnique(2)');
{$ENDIF}
Result := False;
exit;
end;
U1 := R1.KeyRelation.RelationKeyIsCaseInsensitive;
U2 := R2.KeyRelation.RelationKeyIsCaseInsensitive;
if U1 then
if not U2 then begin
{$IFDEF LogIndexAnalysis}
writeln(IALog, ' RelationKeyIsCaseInsensitive(1) and not RelationKeyIsCaseInsensitive(2)');
{$ENDIF}
Result := True;
exit;
end else
else
if U2 then begin
{$IFDEF LogIndexAnalysis}
writeln(IALog, ' not RelationKeyIsCaseInsensitive(1) and RelationKeyIsCaseInsensitive(2)');
{$ENDIF}
Result := False;
exit;
end;
I1 := R1.Table.GetRecordCount;
I2 := R2.Table.GetRecordCount;
{$IFDEF LogIndexAnalysis}
if I1 > I2 then
writeln(IALog, ' RecordCount(1) > RecordCount(2)')
else
writeln(IALog, ' RecordCount(1) < RecordCount(2)');
{$ENDIF}
if I1 > I2 then
Result := True
else
Result := False;
end;
function CompareKeyRelations(const K1, K2: TFFSqlKeyRelation): Boolean;
{ Returns True if K1 is 'better' than K2, e.g. it is likely to better
limit the number of rows we have to read to produce a result}
var
U1, U2: Boolean;
function UniqueValue(const K: TFFSqlKeyRelation): Boolean;
begin
Result :=
(K.RelationFieldCount = K.RelationKeyFieldCount)
and (K.RelationOperators[K.RelationKeyFieldCount - 1] = roEQ);
end;
function ClosedSegment(const K: TFFSqlKeyRelation): Boolean;
begin
Result :=
(K.RelationOperators[K.RelationFieldCount - 1] = roEQ) or
(K.RelationOperatorB[K.RelationFieldCount - 1] <> roNone); {!!.11}
end;
function KeyDepth(const K: TFFSqlKeyRelation): Integer;
begin
Result := K.RelationFieldCount;
end;
function EqualKeyDepth(const K: TFFSqlKeyRelation): Integer;
begin
Result := 0;
while (Result < K.RelationFieldCount)
and (K.RelationOperators[Result] = roEQ) do
inc(Result);
end;
begin
U1 := UniqueValue(K1);
U2 := UniqueValue(K2);
if U1 then
if not U2 then begin
Result := True;
exit;
end
else
if U2 then begin
Result := False;
exit;
end;
U1 := ClosedSegment(K1);
U2 := ClosedSegment(K2);
if U1 then
if U2 then
if EqualKeyDepth(K1) > EqualKeyDepth(K2) then begin
Result := True;
exit;
end else
if EqualKeyDepth(K1) < EqualKeyDepth(K2) then begin
Result := False;
exit;
end else
if KeyDepth(K1) > KeyDepth(K2) then begin
Result := True;
exit;
end else
if KeyDepth(K1) < KeyDepth(K2) then begin
Result := False;
exit;
end else
else begin
Result := True;
exit;
end
else
if U2 then begin
Result := False;
exit;
end;
U1 := K1.RelationKeyIsUnique;
U2 := K2.RelationKeyIsUnique;
if U1 then
if not U2 then begin
Result := True;
exit;
end
else
if U2 then begin
Result := False;
exit;
end;
U1 := K1.RelationKeyIsCaseInsensitive;
U2 := K2.RelationKeyIsCaseInsensitive;
if U1 then
if not U2 then begin
Result := True;
exit;
end
else
if U2 then begin
Result := False;
exit;
end;
Result := False;
end;
{$IFDEF LogIndexAnalysis}
procedure ShowComparison(const K1, K2: TFFSqlKeyRelation);
var
U1, U2: Boolean;
function UniqueValue(const K: TFFSqlKeyRelation): Boolean;
begin
Result :=
(K.RelationFieldCount = K.RelationKeyFieldCount)
and (K.RelationOperators[K.RelationKeyFieldCount - 1] = roEQ);
end;
function ClosedSegment(const K: TFFSqlKeyRelation): Boolean;
begin
Result := (K.RelationOperators[K.RelationFieldCount - 1] = roEQ)
or (K.RelationOperatorB[K.RelationFieldCount - 1] <> roNone); {!!.11}
end;
function KeyDepth(const K: TFFSqlKeyRelation): Integer;
begin
Result := K.RelationFieldCount;
end;
function EqualKeyDepth(const K: TFFSqlKeyRelation): Integer;
begin
Result := 0;
while (Result < K.RelationFieldCount)
and (K.RelationOperators[Result] = roEQ) do
inc(Result);
end;
begin
U1 := UniqueValue(K1);
U2 := UniqueValue(K2);
if U1 then
if not U2 then begin
writeln(IALog,' New is unique value');
exit;
end
else
if U2 then begin
raise Exception.Create('Internal error');
end;
U1 := ClosedSegment(K1);
U2 := ClosedSegment(K2);
if U1 then
if U2 then
if EqualKeyDepth(K1) > EqualKeyDepth(K2) then begin
writeln(IALog,'New has deeper equal key');
exit;
end else
if KeyDepth(K1) > KeyDepth(K2) then begin
writeln(IALog,'New is deeper');
exit;
end else
if KeyDepth(K1) < KeyDepth(K2) then begin
raise Exception.Create('Internal error');
end else
else begin
writeln(IALog, 'New is closed interval');
exit;
end
else
if U2 then begin
raise Exception.Create('Internal error');
end;
U1 := K1.RelationKeyIsUnique;
U2 := K2.RelationKeyIsUnique;
if U1 then
if not U2 then begin
writeln(IALog, 'New has unique key');
exit;
end
else
if U2 then begin
raise Exception.Create('Internal error');
end;
U1 := K1.RelationKeyIsCaseInsensitive;
U2 := K2.RelationKeyIsCaseInsensitive;
if U1 then
if not U2 then begin
writeln(IALog, 'New has case insensitive key');
exit;
end
else
if U2 then begin
raise Exception.Create('Internal error');
end;
raise Exception.Create('Internal error');
end;
{$ENDIF}
procedure TffSqlJoiner.Optimize;
var
IndexAsc : Boolean;
RestSources : TFFSqlTableProxySubsetList;
{$IFDEF LogIndexAnalysis}
procedure DumpOrderedList(OrderedSources : TFFSqlTableProxySubsetList; const Title: string);
var
j, y: integer;
begin
writeln(IALog, Title);
for j := 0 to pred(OrderedSources.Count) do begin
write(IALog, OrderedSources.Item[j].Table.Name, ' (', OrderedSources.Item[j].Table.Alias, ')');
if OrderedSources.Item[j].KeyRelation.CondF <> nil then begin
write(IALog, ' relation fields: ',OrderedSources.Item[j].KeyRelation.RelationFieldCount);
write(IALog, '(');
for y := 0 to pred(OrderedSources.Item[j].KeyRelation.RelationFieldCount) do begin
write(IALog, ' field:', OrderedSources.Item[j].KeyRelation.RelationFields[y].Name);
write(IALog, ' argexp:',OrderedSources.Item[j].KeyRelation.ArgExpressions[y].SQLText);
write(IALog, ' Operator:',RelOpStr[OrderedSources.Item[j].KeyRelation.RelationOperators[y]]);
{!!.11 begin}
if (OrderedSources.Item[j].KeyRelation.ArgExpressionB[y] <> nil)
and (OrderedSources.Item[j].KeyRelation.RelationOperatorB[y] <> roNone)
and (OrderedSources.Item[j].KeyRelation.RelationB[y] <> nil) then
write(IALog, 'secondary expression:',OrderedSources.Item[j].KeyRelation.ArgExpressionB[y].SQLText,
' operator:',RelOpStr[OrderedSources.Item[j].KeyRelation.RelationOperatorB[y]]);
{!!.11 end}
end;
write(IALog, ')');
write(IALog, ' index:',OrderedSources.Item[j].KeyRelation.NativeKeyIndex{RelationKeyIndexNative});
(* !!.11
if (OrderedSources.Item[j].KeyRelation.ArgExpressionB <> nil)
and (OrderedSources.Item[j].KeyRelation.RelationOperatorB <> roNone)
and (OrderedSources.Item[j].KeyRelation.RelationB <> nil) then
write(IALog, 'secondary expression:',OrderedSources.Item[j].KeyRelation.ArgExpressionB.SQLText,
' operator:',RelOpStr[OrderedSources.Item[j].KeyRelation.RelationOperatorB]);
*)
writeln(IALog);
end else
writeln(IALog, ' no relation');
end;
end;
{$ENDIF}
function FindRelations(CondTerm: TffSqlCondTerm;
MoreThanOne: Boolean): Boolean;
var
l, j, k, y : Integer;
Best, x : Integer;
F, F2 : TFFSqlFieldProxy;
IndexRefs : array[0..pred(ffcl_MaxIndexes)] of Integer;
IgnoreCase: Boolean;
IndexFields : array[0..pred(ffcl_MaxIndexFlds)] of Integer;
IndxFldCnt : Integer;
Found: Boolean;
CF : TFFSqlCondFactor;
CurIgnoreCase : Boolean;
DepFound: Integer;
BestRelation: TFFSqlTableProxySubset;
BestKeyRelation, CurKeyRelation: TFFSqlKeyRelation;
HaveKeyRelation: Boolean;
SameCase: Boolean;
{$IFDEF LogIndexAnalysis}
procedure DumpBest;
var
i : Integer;
begin
with BestKeyRelation do begin
writeln(IALog,' condition:',CondF.SQLText);
writeln(IALog,' key:',NativeKeyIndex);
writeln(IALog,' Fields in key:',RelationKeyFieldCount);
writeln(IALog,' Fields:',RelationFieldCount);
for i := 0 to pred(RelationFieldCount) do begin
writeln(IALog, ' ',RelationFields[i].Name,' ',RelOpStr[RelationOperators[i]], ' ',
ArgExpressions[i].SQLText);
{!!.11 begin}
if RelationOperatorB[i] <> roNone then
writeln(IALog, ' Secondary relation:',
RelOpStr[RelationOperatorB[i]], ' ',
ArgExpressionB[i].SQLText);
{!!.11 end}
end;
{!!.11 begin
if RelationOperatorB <> roNone then
writeln(IALog, ' Secondary relation on last key field:',
RelOpStr[RelationOperatorB], ' ',
ArgExpressionB.SQLText);
!!.11 end}
end;
end;
{$ENDIF}
var
z: Integer;
begin
Result := False;
{CurKeyRelation.ArgExpressionB := nil;} {!!.11}
for z := 0 to pred(ffcl_MaxIndexFlds) do begin {!!.11}
CurKeyRelation.ArgExpressionB[z] := nil; {!!.11}
CurKeyRelation.RelationOperatorB[z] := roNone; {!!.11}
end; {!!.11}
with CondTerm do
repeat
//KeyState := ksNone;
//Depth := 0;
for j := 0 to pred(RestSources.Count) do begin
RestSources.Item[j].Relations := 0;
{$IFDEF LogIndexAnalysis}
writeln(IALog, ' looking for relations on ',
RestSources.Item[j].Table.Name, ' (', RestSources.Item[j].Table.Alias,')');
{$ENDIF}
{we select among multiple keys as follows:}
{if we find a unique key on the available field(s) we use that
otherwise,
we use the deepest key we can find, i.e. the key where the
most segments can be satisfied.
among keys with the same depth, we pick the ones with
the tightest or the most relations, e.g.
= is better than >
> and < is better than only >
ties could be further settled based on the number of
key values in an index, but we don't currently do that}
HaveKeyRelation := False;
CurKeyRelation.RelationFieldCount := 0;
for k := 0 to pred(CondFactorCount) do begin
if not OrderedSources.RelationUsed(CondFactor[k]) then
with CondFactor[k] do begin
if IsRelationTo(RestSources.Item[j].Table,
F, CurKeyRelation.RelationOperators[0],
CurKeyRelation.ArgExpressions[0], SameCase)
and CanOptimizeOnOperator[CurKeyRelation.
RelationOperators[0]] then begin
if RestSources.Item[j].Outer
and CurKeyRelation.ArgExpressions[0].DependsOn(
RestSources.Item[j].Opposite) then begin
{$IFDEF LogIndexAnalysis}
writeln(IALOG,' ',CondFactor[k].SQLText,' is a relation to ',
RestSources.Item[j].Table.Name,' (',RestSources.Item[j].Table.Alias,'). Arg expression:', CurKeyRelation.ArgExpressions[0].SQLText);
writeln(IALOG,' but using would violate the outer join, so we can''t use it. Skipped.');
{$ENDIF}
end else begin
{$IFDEF LogIndexAnalysis}
writeln(IALOG,' ',CondFactor[k].SQLText,' is a relation to ',
RestSources.Item[j].Table.Name,' (',RestSources.Item[j].Table.Alias,'). Arg expression:',
CurKeyRelation.ArgExpressions[0].SQLText);
{$ENDIF}
CurKeyRelation.CondF := CondFactor[k];
{CurKeyRelation.RelationB := nil;} {!!.11}
for z := 0 to pred(ffcl_MaxIndexFlds) do begin {!!.11}
CurKeyRelation.ArgExpressionB[z] := nil; {!!.11}
CurKeyRelation.RelationOperatorB[z] := roNone; {!!.11}
end; {!!.11}
{Check that this relation does not depend on something
we can't determine at this level. For example, if we
have table1 at the deepest level, then table2 at the
next, we are looking for conditional expressions on
table2 that will limit the number of rows we need to
read but we can't use conditions whose other side
refer to anything in table1.}
{$IFDEF LogIndexAnalysis}
writeln(IALog, ' Checking dependencies on deeper tables for :' +
CurKeyRelation.ArgExpressions[0].SQLText);
{$ENDIF}
DepFound := -1;
for l := pred(OrderedSources.Count) downto 0 do
if CurKeyRelation.ArgExpressions[0].DependsOn(
OrderedSources.Item[l].Table) then begin
DepFound := l;
break;
end;
{$IFDEF LogIndexAnalysis}
if DepFound <> -1 then
writeln(IALog, ' Deeper dependency found:',
CurKeyRelation.ArgExpressions[0].SQLText,' : ',
OrderedSources.Item[l].Table.Name,' (',OrderedSources.Item[l].Table.Alias,')')
else
writeln(IALog, ' No deeper dependency found on ',
CurKeyRelation.ArgExpressions[0].SQLText);
{$ENDIF}
{Part of the expression opposite our field is from a table, which
has already been put in the list. We can still use this relation
by putting it below that other table *unless* something in the
existing list depends on us (the table we're looking at now)}
if (DepFound <> -1)
and OrderedSources.DependencyExists(RestSources.
Item[j].Table) then begin
{$IFDEF LogIndexAnalysis}
writeln(IALog, ' Can''t use this - something else depends on it');
{$ENDIF}
CurKeyRelation.CondF := nil;
end else begin
{$IFDEF LogIndexAnalysis}
writeln(IALog, ' Relation found:', SQLText);
writeln(IALog, ' field:',F.Name);
writeln(IALog, ' same case:', SameCase); {!!.10}
writeln(IALog, ' operator:', RelOpStr[CurKeyRelation.RelationOperators[0]]);
writeln(IALog, ' arg expression:', CurKeyRelation.ArgExpressions[0].SQLTExt);
writeln(IALog, ' looking for indexes on that field');
{$ENDIF}
x := RestSources.Item[j].Table.IndexesOnField(F,
not SameCase, IndexRefs);
CurKeyRelation.RelationFieldCount := 1;
{$IFDEF LogIndexAnalysis}
CurKeyRelation.RelationFields[0] := F;
{$ENDIF}
if x <> 0 then begin
case CurKeyRelation.RelationOperators[0] of
roEQ :
begin
for y := 0 to pred(x) do begin
RestSources.Item[j].Table.GetIndexProperties
(IndexRefs[y], CurKeyRelation.RelationKeyIsUnique,
CurIgnoreCase, IndexAsc, IndxFldCnt,
IndexFields);
CurKeyRelation.RelationFieldCount := 1;
CurKeyRelation.RelationKeyFieldCount := IndxFldCnt;
CurKeyRelation.RelationOperators[0] := roEQ;
CurKeyRelation.RelationOperatorB[0] := roNone; {!!.11}
CurKeyRelation.RelationKeyIsCaseInsensitive :=
CurIgnoreCase; {!!.11}
CurKeyRelation.RelationKeyIndexAsc := IndexAsc;
CurKeyRelation.NativeKeyIndex := IndexRefs[y];
CurKeyRelation.DepIndex := DepFound;
(* !!.11 actually, whether relation key is unique is irrelevant here
if CurKeyRelation.RelationKeyIsUnique then begin
if IndxFldCnt = 1 then begin
IgnoreCase := CurIgnoreCase;
end else begin
{Multi-segment key.
See if we have other relations that satisfy
the following fields in the key}
CurKeyRelation.RelationFieldCount := 1;
repeat
F2 := RestSources.Item[j].Table.
Field(IndexFields[CurKeyRelation.
RelationFieldCount]);
CF := FindRelation(CondTerm, CondFactor[k],
nil, RestSources.Item[j].Table, F2,
CurKeyRelation.RelationOperators[
CurKeyRelation.RelationFieldCount],
CurKeyRelation.ArgExpressions[
CurKeyRelation.RelationFieldCount],
CurKeyRelation.SameCases[
CurKeyRelation.RelationFieldCount]);
if CF = nil then begin
{No further fields found.
We have a key, but not a unique one}
IgnoreCase := CurIgnoreCase;
break;
end else begin
{we have a relation on this key segment}
{$IFDEF LogIndexAnalysis}
CurKeyRelation.RelationFields[
CurKeyRelation.RelationFieldCount] := F2;
{$ENDIF}
if CurKeyRelation.RelationOperators[
CurKeyRelation.RelationFieldCount] = roEQ then begin
{operator is = which means we can continue searching if
there are more fields in the key. Otherwise, we have a full
key}
IgnoreCase := CurIgnoreCase;
end else begin
{Operator wasn't =, so we can't continue.
We can use this field, though, as the last one}
IgnoreCase := CurIgnoreCase;
{See if we have a secondary expression to close the interval}
CF := FindRelation(CondTerm, CondFactor[k],
CF, RestSources.Item[j].Table, F2,
CurKeyRelation.RelationOperatorB,
CurKeyRelation.ArgExpressionB,
CurKeyRelation.SameCaseB);
if CF <> nil then begin
{we do - record data and update key state}
CurKeyRelation.RelationB := CF;
IgnoreCase := CurIgnoreCase;
end else begin
CurKeyRelation.ArgExpressionB := nil;
CurKeyRelation.RelationOperatorB := roNone;
end;
inc(CurKeyRelation.RelationFieldCount);
break;
end;
end;
inc(CurKeyRelation.RelationFieldCount);
until CurKeyRelation.RelationFieldCount >=
IndxFldCnt;
end;
end else begin {not a unique key}
*)
if IndxFldCnt = 1 then begin
IgnoreCase := CurIgnoreCase;
end else begin
{Multi-segment key.
See if we have other relations that satisfy
the following fields in the key}
CurKeyRelation.RelationFieldCount := 1;
repeat
F2 := RestSources.Item[j].Table.
Field(IndexFields[
CurKeyRelation.RelationFieldCount]);
CF := FindRelation(CondTerm, CondFactor[k],
nil, RestSources.Item[j].Table, F2,
CurKeyRelation.RelationOperators[
CurKeyRelation.RelationFieldCount],
CurKeyRelation.ArgExpressions[
CurKeyRelation.RelationFieldCount],
CurKeyRelation.SameCases[
CurKeyRelation.RelationFieldCount]);
if CF = nil then begin
{No further fields found, but
we have a key but not a full one}
IgnoreCase := CurIgnoreCase;
break;
end else begin
{we have a relation on this key segment}
{$IFDEF LogIndexAnalysis}
CurKeyRelation.RelationFields[CurKeyRelation.RelationFieldCount] := F2;
{$ENDIF}
if CurKeyRelation.RelationOperators[
CurKeyRelation.RelationFieldCount] = roEQ then begin
{operator is = which means we can continue searching if
there are more fields in the key. Otherwise, we have a full
key}
IgnoreCase := CurIgnoreCase;
CurKeyRelation.RelationOperatorB[CurKeyRelation.RelationFieldCount] := roNone; {!!.11}
end else begin
{Operator wasn't =, so we can't continue.
We can use this field, though, as the last one}
IgnoreCase := CurIgnoreCase;
{see if we have other relations on this same segment}
CF := FindRelation(CondTerm, CondFactor[k],
CF, RestSources.Item[j].Table,
F2, CurKeyRelation.RelationOperatorB[CurKeyRelation.RelationFieldCount], {!!.11}
CurKeyRelation.ArgExpressionB[CurKeyRelation.RelationFieldCount], {!!.11}
CurKeyRelation.SameCaseB[CurKeyRelation.RelationFieldCount]); {!!.11}
if CF <> nil then begin
{we do - record data and update key state}
CurKeyRelation.RelationB[CurKeyRelation.RelationFieldCount] := CF; {!!.11}
IgnoreCase := CurIgnoreCase;
end else begin
CurKeyRelation.ArgExpressionB[CurKeyRelation.RelationFieldCount] := nil; {!!.11}
CurKeyRelation.RelationOperatorB[CurKeyRelation.RelationFieldCount] := roNone; {!!.11}
end;
inc(CurKeyRelation.RelationFieldCount);
break;
end;
end;
inc(CurKeyRelation.RelationFieldCount);
until CurKeyRelation.RelationFieldCount >=
IndxFldCnt;
end;
{end;} {!!.11}
if HaveKeyRelation then
if CompareKeyRelations(CurKeyRelation, BestKeyRelation) then begin
{$IFDEF LogIndexAnalysis}
writeln(IALog,' New best key relation');
ShowComparison(CurKeyRelation, BestKeyrelation);
{$ENDIF}
BestKeyRelation := CurKeyRelation;
{$IFDEF LogIndexAnalysis}
DumpBest;
{$ENDIF}
end else
else begin
BestKeyRelation := CurKeyRelation;
{$IFDEF LogIndexAnalysis}
writeln(IALog,' initial key relation');
DumpBest;
{$ENDIF}
HaveKeyRelation := True;
end;
end;
end;
else {~ Op <> roEQ}
{non equal join operator}
for y := 0 to pred(x) do begin
RestSources.Item[j].Table.GetIndexProperties
(IndexRefs[y], CurKeyRelation.RelationKeyIsUnique,
IgnoreCase, IndexAsc, IndxFldCnt, IndexFields);
CurKeyRelation.RelationFieldCount := 1;
CurKeyRelation.RelationKeyFieldCount := IndxFldCnt;
CurKeyRelation.RelationOperatorB[CurKeyRelation.RelationFieldCount-1] := roNone; {!!.11}
CurKeyRelation.RelationKeyIsCaseInsensitive :=
CurIgnoreCase; {!!.11}
CurKeyRelation.RelationKeyIndexAsc := IndexAsc;
CurKeyRelation.NativeKeyIndex := IndexRefs[y];
CurKeyRelation.DepIndex := DepFound;
IgnoreCase := CurIgnoreCase;
{see if we have other relations on this same segment}
CF := FindRelation(CondTerm, CondFactor[k], nil,
RestSources.Item[j].Table, F, CurKeyRelation.
RelationOperatorB[CurKeyRelation.RelationFieldCount-1], {!!.11}
CurKeyRelation.ArgExpressionB[CurKeyRelation.RelationFieldCount-1], {!!.11}
CurKeyRelation.SameCaseB[CurKeyRelation.RelationFieldCount-1]); {!!.11}
if CF <> nil then begin
{we do - record data and update key state}
IgnoreCase := CurIgnoreCase;
CurKeyrelation.RelationB[CurKeyRelation.RelationFieldCount-1] := CF; {!!.11}
{!!.11 begin}
{check for more interval segments}
if (IndxFldCnt > 1)
and (CurKeyRelation.RelationOperators[0] in [roEQ, roGE, roLE])
and (CurKeyRelation.RelationOperatorB[CurKeyRelation.RelationFieldCount-1] in [roEQ, roGE, roLE]) then begin
{Multi-segment key.
See if we have other relations that satisfy
the following fields in the key}
repeat
F2 := RestSources.Item[j].Table.
Field(IndexFields[
CurKeyRelation.RelationFieldCount]);
CF := FindRelation(CondTerm, CondFactor[k],
nil, RestSources.Item[j].Table, F2,
CurKeyRelation.RelationOperators[
CurKeyRelation.RelationFieldCount],
CurKeyRelation.ArgExpressions[
CurKeyRelation.RelationFieldCount],
CurKeyRelation.SameCases[
CurKeyRelation.RelationFieldCount]);
if CF = nil then begin
{No further fields found, but
we have a key but not a full one}
IgnoreCase := CurIgnoreCase;
break;
end else
if CurKeyRelation.RelationOperators[
CurKeyRelation.RelationFieldCount] in [roEQ, roGE, roLE] then
begin
{we have a relation on this key segment}
{$IFDEF LogIndexAnalysis}
CurKeyRelation.RelationFields[CurKeyRelation.RelationFieldCount] := F2;
{$ENDIF}
if CurKeyRelation.RelationOperators[
CurKeyRelation.RelationFieldCount] = roEQ then begin
{operator is = which means we can continue searching if
there are more fields in the key. Otherwise, we have a full
key}
IgnoreCase := CurIgnoreCase;
CurKeyRelation.RelationOperatorB[CurKeyRelation.RelationFieldCount] := roNone; {!!.11}
end else begin
{Operator wasn't =}
IgnoreCase := CurIgnoreCase;
{see if we have other relations on this same segment}
CF := FindRelation(CondTerm, CondFactor[k],
CF, RestSources.Item[j].Table,
F2, CurKeyRelation.RelationOperatorB[CurKeyRelation.RelationFieldCount], {!!.11}
CurKeyRelation.ArgExpressionB[CurKeyRelation.RelationFieldCount], {!!.11}
CurKeyRelation.SameCaseB[CurKeyRelation.RelationFieldCount]); {!!.11}
if CF <> nil then begin
if not (CurKeyRelation.RelationOperatorB[
CurKeyRelation.RelationFieldCount] in [roEQ, roGE, roLE]) then
break;
{we do - record data and update key state}
CurKeyRelation.RelationB[CurKeyRelation.RelationFieldCount] := CF; {!!.11}
IgnoreCase := CurIgnoreCase;
end else begin
CurKeyRelation.ArgExpressionB[CurKeyRelation.RelationFieldCount] := nil; {!!.11}
CurKeyRelation.RelationOperatorB[CurKeyRelation.RelationFieldCount] := roNone; {!!.11}
inc(CurKeyRelation.RelationFieldCount);
break;
end;
end;
end;
inc(CurKeyRelation.RelationFieldCount);
until CurKeyRelation.RelationFieldCount >=
IndxFldCnt;
end;
{!!.11 end}
end else begin
CurKeyRelation.ArgExpressionB[CurKeyRelation.RelationFieldCount-1] := nil; {!!.11}
CurKeyRelation.RelationOperatorB[CurKeyRelation.RelationFieldCount-1] := roNone; {!!.11}
end;
if HaveKeyRelation then
if CompareKeyRelations(CurKeyRelation,
BestKeyRelation) then begin
{$IFDEF LogIndexAnalysis}
ShowComparison(CurKeyRelation, BestKeyrelation);
{$ENDIF}
BestKeyRelation := CurKeyRelation;
{$IFDEF LogIndexAnalysis}
writeln(IALog,' new best key relation');
DumpBest;
{$ENDIF}
end else
else begin
BestKeyRelation := CurKeyRelation;
{$IFDEF LogIndexAnalysis}
writeln(IALog,' initial key relation');
DumpBest;
{$ENDIF}
HaveKeyRelation := True;
end;
end;
end;
{$IFDEF LogIndexAnalysis}
writeln(IALog, ' ', x, ' found!');
for y := 0 to pred(x) do begin
RestSources.Item[j].Table.GetIndexProperties
(IndexRefs[y], CurKeyRelation.RelationKeyIsUnique,
IgnoreCase, IndexAsc, IndxFldCnt, IndexFields);
writeln(IALog, ' key', y, ': ',
' Unique:', CurKeyRelation.RelationKeyIsUnique,
' IgnoreCase:', IgnoreCase,
' IndexAsc:', IndexAsc,
' Segments:',IndxFldCnt);
if IndxFldCnt <> 0 then begin
write(IALog, ' (');
for z := 0 to pred(IndxFldCnt) do begin
write(IALog, RestSources.Item[j].Table.
Field(IndexFields[z]).Name,' ');
end;
writeln(IALog, ')');
end;
end;
{$ENDIF}
inc(RestSources.Item[j].Relations);
end else
{$IFDEF LogIndexAnalysis}
writeln(IALog, ' none found');
{$ENDIF}
end;
end;
end;
end;
end;
if HaveKeyRelation then
RestSources.Item[j].KeyRelation := BestKeyRelation;
end;
Found := False;
Best := -1;
{$IFDEF LogIndexAnalysis}
writeln(IALog, ' Comparing relations');
{$ENDIF}
BestRelation := nil;
for j := 0 to pred(RestSources.Count) do begin
if (not MoreThanOne and (RestSources.Item[j].Relations = 1))
or (MoreThanOne and (RestSources.Item[j].Relations > 0)) then begin
{$IFDEF LogIndexAnalysis}
writeln(IALog, ' ', RestSources.Item[j].Table.Name,' (',
RestSources.Item[j].Table.Alias,') relations:',
RestSources.Item[j].Relations);
{$ENDIF}
if CompareRelations(RestSources.Item[j], BestRelation) then begin
BestRelation := RestSources.Item[j];
Best := j;
end;
end;
end;
if BestRelation <> nil then begin
{$IFDEF LogIndexAnalysis}
writeln(IALog, ' Best:', BestRelation.Table.Name,' (',BestRelation.Table.Alias,')');
{$ENDIF}
if BestRelation.KeyRelation.DepIndex = -1 then
OrderedSources.Add(RestSources.Item[Best])
else
OrderedSources.Insert(RestSources.Item[Best]);
RestSources.Delete(Best);
Found := True;
{$IFDEF LogIndexAnalysis}
DumpOrderedList(OrderedSources, ' Ordered list so far(inner to outer):');
{$ENDIF}
Result := True;
end;
until not Found;
end;
var
i, j : Integer;
{$IFDEF LogIndexAnalysis}
y : Integer;
{$ENDIF}
begin
if OptimizeCalled then exit;
WasOptimized := False;
if (CondExpWhere <> nil) and UseIndex then begin
{$IFDEF LogIndexAnalysis}
AssignFile(IALog, IALogFile);
{$I-}
Append(IALog);
if IOResult <> 0 then
Rewrite(IALog);
writeln(IALog);
writeln(IALog, 'Analyzing ' + CondExpWhere.Owner.SQLText);
writeln(IALog, 'Analysis started at :',DateTimeToStr(Now));
{$ENDIF}
{look for relations that might be used for optimizing the join}
{$IFDEF LogIndexAnalysis}
writeln(IALog, 'Scanning for relations');
{$ENDIF}
for i := 0 to pred(CondExpWhere.GetCondTermCount) do begin
{process each term separately}
with CondExpWhere.CondTerm[i] do begin
{$IFDEF LogIndexAnalysis}
writeln(IALog, 'Term ', i, ' : ',SQLText);
{$ENDIF}
OrderedSources.Free;
OrderedSources := TFFSqlTableProxySubsetList.Create(Owner);
RestSources := TFFSqlTableProxySubsetList.Create(Owner);
try
{We build an ordered list of tables to process so that
the inner-most table in the list is first.}
{Specifically, we do this by looking for key relations
which will limit the number of rows we need to read from
each table.}
{RestSources are the tables at any time which have not
yet been selected for processing.
When RestSources.Count = 0, we're done.}
RestSources.Assign(Sources);
{First, find and process the relations with
exactly one key resolution.}
{$IFDEF LogIndexAnalysis}
writeln(IALog, ' Looking for relations with exactly one resolution');
{$ENDIF}
if FindRelations(CondExpWhere.CondTerm[i], False) then
WasOptimized := True;
{$IFDEF LogIndexAnalysis}
DumpOrderedList(OrderedSources, 'Final ordered list (inner to outer):');
{$ENDIF}
{Then, find and process the relations with
more than one key resolution, if any.}
{$IFDEF LogIndexAnalysis}
writeln(IALog, ' Looking for relations with more than one resolution');
{$ENDIF}
if FindRelations(CondExpWhere.CondTerm[i], True) then
WasOptimized := True;
{Finally, add the sources with no key relations - if any}
for j := pred(RestSources.Count) downto 0 do begin
RestSources.Item[j].KeyRelation.CondF := nil;
OrderedSources.Add(RestSources.Item[j]);
RestSources.Delete(j);
end;
Assert(RestSources.Count = 0);
{done re-ordering}
{$IFDEF LogIndexAnalysis}
writeln(IALog, 'Ordered list (inner to outer):');
for j := 0 to pred(OrderedSources.Count) do begin
write(IALog, OrderedSources.Item[j].Table.Name,' (',OrderedSources.Item[j].Table.Alias,')');
if OrderedSources.Item[j].KeyRelation.CondF <> nil then begin
write(IALog, ' relation fields: ',OrderedSources.Item[j].KeyRelation.RelationFieldCount);
write(IALog, '(');
for y := 0 to pred(OrderedSources.Item[j].KeyRelation.RelationFieldCount) do begin
write(IALog, ' field:', OrderedSources.Item[j].KeyRelation.RelationFields[y].Name);
write(IALog, ' argexp:',OrderedSources.Item[j].KeyRelation.ArgExpressions[y].SQLText);
write(IALog, ' Operator:',RelOpStr[OrderedSources.Item[j].KeyRelation.RelationOperators[y]]);
{!!.11 begin}
if (OrderedSources.Item[j].KeyRelation.ArgExpressionB[y] <> nil)
and (OrderedSources.Item[j].KeyRelation.RelationOperatorB[y] <> roNone)
and (OrderedSources.Item[j].KeyRelation.RelationB[y] <> nil) then
write(IALog, 'secondary expression:',OrderedSources.Item[j].KeyRelation.ArgExpressionB[y].SQLText,
' operator:',RelOpStr[OrderedSources.Item[j].KeyRelation.RelationOperatorB[y]]);
{!!.11 end}
end;
write(IALog, ')');
write(IALog, ' index:',OrderedSources.Item[j].KeyRelation.NativeKeyIndex);
{!!.11 begin
if (OrderedSources.Item[j].KeyRelation.ArgExpressionB <> nil)
and (OrderedSources.Item[j].KeyRelation.RelationOperatorB <> roNone)
and (OrderedSources.Item[j].KeyRelation.RelationB <> nil) then
write(IALog, 'secondary expression:',OrderedSources.Item[j].KeyRelation.ArgExpressionB.SQLText,
' operator:',RelOpStr[OrderedSources.Item[j].KeyRelation.RelationOperatorB]);
!!.11 end}
writeln(IALog);
end else
writeln(IALog, ' no relation');
end;
{$ENDIF}
finally
RestSources.Free;
end;
end;
end;
{$IFDEF LogIndexAnalysis}
writeln(IALog);
writeln(IALog, 'Analysis ended at :',DateTimeToStr(Now));
CloseFile(IALog);
{$ENDIF}
end;
OptimizeCalled := True;
end;
{===Utility routines=================================================}
function BothNil(O1, O2: TffSqlNode): Boolean;
begin
Result := (O1 = nil) and (O2 = nil);
end;
{--------}
function BothNonNil(O1, O2: TffSqlNode): Boolean;
begin
Result := (O1 <> nil) and (O2 <> nil);
end;
{====================================================================}
{===TffSqlNode=======================================================}
{--------}
procedure TffSqlNode.AddAggregate(Target: TList);
begin
end;
{--------}
procedure TffSqlNode.FlagAggregate;
begin
end;
{--------}
function TffSqlNode.GetDecimals: Integer;
begin
raise Exception.CreateFmt('Internal error:GetDecimals not implemented for %s',
[ClassName]);
end;
{--------}
function TffSqlNode.GetSize: Integer;
begin
Result := 0;
end;
{--------}
function TffSqlNode.GetType: TffFieldType;
begin
raise Exception.CreateFmt('Internal error:GetType not implemented for %s',
[ClassName]);
end;
{--------}
function TffSqlNode.IsAggregate: Boolean;
begin
raise Exception.CreateFmt('Internal error:IsAggregate not implemented for %s',
[ClassName]);
end;
{--------}
function TffSqlNode.GetOwner: TffSqlStatement;
begin
if (FOwner = nil)
and not (Self is TffSqlStatement) then begin
Assert(Parent <> nil);
FOwner := TffSqlStatement(Parent);
while FOwner.Parent <> nil do
FOwner := TffSqlStatement(FOwner.Parent);
Assert(Owner is TffSqlStatement);
end;
Result := FOwner;
end;
{--------}
{Begin !!.11}
function TffSqlNode.GetOwnerStmt: TFFSqlColumnListOwner;
begin
if (FOwnerStmt = nil) then begin
FOwnerStmt := TFFSqlColumnListOwner(Self);
while (FOwnerStmt <> nil)
and not (TObject(FOwnerStmt) is TFFSqlColumnListOwner) do
FOwnerStmt := TFFSqlColumnListOwner(FOwnerStmt.Parent);
if not (TObject(FOwnerStmt) is TFFSqlColumnListOwner) then
FOwnerStmt := nil;
end;
Result := FOwnerStmt;
end;
{--------}
function TffSqlNode.GetOwnerSelect: TFFSqlSelect;
begin
if (FOwnerStmt = nil) then begin
FOwnerStmt := TFFSqlSelect(Self);
while (FOwnerStmt <> nil)
and not (TObject(FOwnerStmt) is TFFSqlSelect) do
FOwnerStmt := TFFSqlSelect(FOwnerStmt.Parent);
if not (TObject(FOwnerStmt) is TFFSqlSelect) then
FOwnerStmt := nil;
end;
Result := TffSqlSelect(FOwnerStmt);
end;
{End !!.11}
{--------}
procedure TffSqlNode.TypeMismatch;
begin
SQLError('Type mismatch');
end;
{--------}
procedure TffSqlNode.WriteEOF(Stream: TStream);
const
NullChar : Char = #0;
begin
Stream.Write(NullChar, 1);
end;
{--------}
procedure TffSqlNode.WriteStr(Stream: TStream; const S: string);
begin
if S <> '' then
Stream.Write(S[1], length(S));
end;
{--------}
procedure TffSqlNode.AddTableReference;
begin
end;
{--------}
procedure TffSqlNode.AddColumnDef;
begin
end;
{--------}
procedure TffSqlNode.AssignError(Source: TffSqlNode);
begin
raise Exception.Create(Source.ClassName + ' not compatible with ' + ClassName);
end;
{--------}
function TffSqlNode.BindField(const TableName,
FieldName: string): TFFSqlFieldProxy;
begin
if Parent <> nil then
Result := Parent.BindField(TableName, FieldName)
else
raise Exception.CreateFmt('No node could resolve the field %s.%s', {!!.11}
[TableName, FieldName]); {!!.11}
end;
{--------}
procedure TffSqlNode.ClearBinding;
begin
end;
{--------}
function TffSqlNode.IsAncestor(const Node : TffSqlNode) : Boolean;
var
aParent : TffSqlNode;
begin
aParent := FParent;
repeat
Result := (aParent = Node);
aParent := aParent.Parent;
until Result or (aParent = nil);
end;
{--------}
procedure TffSqlNode.ResetConstant;
begin
end;
{--------}
function TffSqlNode.SQLText: string;
var
M : TMemoryStream;
begin
M := TMemoryStream.Create;
try
EmitSQL(M);
SetLength(Result, M.Size);
M.Seek(0, 0);
M.Read(Result[1], M.Size);
finally
M.Free;
end;
end;
{--------}
procedure TffSqlNode.SQLError(const ErrorMsg: string);
begin
raise Exception.CreateFmt('Error in statement: %s', [ErrorMsg]);
end;
{--------}
constructor TffSqlNode.Create(AParent: TffSqlNode);
begin
inherited Create;
FParent := AParent;
end;
{--------}
procedure TffSqlNode.EmitSQL(Stream: TStream);
begin
raise Exception.CreateFmt('Internal error:EmitSQL not implemented for %s',
[ClassName]);
end;
{====================================================================}
{===TffSqlSelectionList==============================================}
function TffSqlSelectionList.AddSelection(
NewSelection: TffSqlSelection): TffSqlSelection;
begin
FSelections.Add(NewSelection);
Result := NewSelection;
end;
{--------}
procedure TffSqlSelectionList.Assign(const Source: TffSqlNode);
var
i : Integer;
begin
if Source is TffSqlSelectionList then begin
Clear;
for i := 0 to pred(TffSqlSelectionList(Source).SelectionCount) do
AddSelection(TffSqlSelection.Create(Self)).Assign(
TffSqlSelectionList(Source).Selection[i]);
end else
AssignError(Source);
end;
{--------}
constructor TffSqlSelectionList.Create(AParent: TffSqlNode);
begin
inherited Create(AParent);
FSelections := TList.Create;
end;
{--------}
procedure TffSqlSelectionList.Clear;
var
i : Integer;
begin
for i := 0 to pred(SelectionCount) do
Selection[i].Free;
FSelections.Clear;
end;
{--------}
destructor TffSqlSelectionList.Destroy;
begin
Clear;
FSelections.Free;
inherited;
end;
{--------}
procedure TffSqlSelectionList.EmitSQL(Stream: TStream);
var
i : Integer;
First: Boolean;
begin
if SelectionCount > 0 then begin
First := True;
for i := 0 to pred(SelectionCount) do begin
if not First then
WriteStr(Stream, ', ');
if not Selection[i].AddedByWildcard then begin
Selection[i].EmitSQL(Stream);
First := False;
end;
end;
end;
end;
{--------}
procedure TffSqlSelectionList.EnumNodes(EnumMethod: TffSqlEnumMethod;
const Deep: Boolean);
var
i : Integer;
begin
Assert(TObject(Self) is TffSqlSelectionList);
EnumMethod(Self);
for i := 0 to pred(SelectionCount) do
Selection[i].EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlSelectionList.Equals(Other: TffSqlNode): Boolean;
var
i : Integer;
begin
Result := False;
if Other is TffSqlSelectionList then begin
if NonWildSelectionCount <> TffSqlSelectionList(Other).NonWildSelectionCount then
exit;
for i := 0 to pred(NonWildSelectionCount) do
if not NonWildSelection[i].Equals(TffSqlSelectionList(Other).
NonWildSelection[i]) then
exit;
Result := True;
end;
end;
{--------}
function TffSqlSelectionList.FindSelection(GroupCol :
TffSqlGroupColumn) : TffSqlSelection;
var
i : Integer;
F : TffSqlFieldProxy;
Name : string;
begin
Name := GroupCol.QualColumnName;
for i := 0 to pred(SelectionCount) do
if Assigned(Selection[i].SimpleExpression.Term[0].Factor[0].FieldRef) and
(AnsiCompareText(Trim(Selection[i].SimpleExpression.Term[0].Factor[0].
FieldRef.QualName), Name) = 0) then begin
Result := Selection[i];
exit;
end else
if AnsiCompareText(Trim(Selection[i].SQLText), Name) = 0 then begin
Result := Selection[i];
exit;
end else
if Selection[i].Column <> nil then
if AnsiCompareText(Selection[i].Column.ColumnName, Name) = 0 then begin
Result := Selection[i];
exit;
end else
else
if Selection[i].SimpleExpression.IsField(F) then
if (AnsiCompareText(F.Name, Name) = 0) or
(AnsiCompareText(F.QualName, Name) = 0) then begin
Result := Selection[i];
exit;
end;
Result := nil;
end;
{--------}
function TffSqlSelectionList.GetNonWildSelection(
Index: Integer): TffSqlSelection;
var
i: Integer;
begin
for i := 0 to pred(SelectionCount) do
if not Selection[i].AddedByWildcard then begin
dec(Index);
if Index < 0 then begin
Result := Selection[i];
exit;
end;
end;
Result := nil;
end;
{--------}
function TffSqlSelectionList.GetSelection(
Index: Integer): TffSqlSelection;
begin
Result := TffSqlSelection(FSelections[Index]);
Assert(TObject(Result) is TffSqlSelection);
end;
{--------}
function TffSqlSelectionList.GetSelectionCount: Integer;
begin
Result := FSelections.Count;
end;
{--------}
procedure TffSqlSelectionList.InsertSelection(Index: Integer;
NewSelection: TffSqlSelection);
begin
FSelections.Insert(Index, NewSelection);
end;
{--------}
function TffSqlSelectionList.NonWildSelectionCount: Integer;
var
i : Integer;
begin
Result := 0;
for i := 0 to pred(SelectionCount) do
if not Selection[i].AddedByWildcard then
inc(Result);
end;
function TffSqlSelectionList.Reduce: Boolean;
var
i : Integer;
begin
Result := False;
for i := 0 to pred(SelectionCount) do
Result := Result or Selection[i].Reduce;
end;
procedure TffSqlSelectionList.SetSelection(Index: Integer;
const Value: TffSqlSelection);
begin
FSelections[Index] := Value;
end;
{====================================================================}
{===TffSqlSimpleExpression===========================================}
function TffSqlSimpleExpression.AddTerm(Term: TffSqlTerm): TffSqlTerm;
begin
TermList.Add(Term);
Result := Term;
end;
{--------}
procedure TffSqlSimpleExpression.Assign(const Source: TffSqlNode);
var
i : Integer;
begin
if Source is TffSqlSimpleExpression then begin
Clear;
for i := 0 to pred(TffSqlSimpleExpression(Source).TermCount) do begin
AddTerm(TffSqlTerm.Create(Self)).Assign(
TffSqlSimpleExpression(Source).Term[i]);
end;
end else
AssignError(Source);
end;
{--------}
constructor TffSqlSimpleExpression.Create(AParent: TffSqlNode);
begin
inherited Create(AParent);
TermList := TList.Create;
end;
{--------}
procedure TffSqlSimpleExpression.Clear;
var
i : Integer;
begin
for i := 0 to pred(TermCount) do
Term[i].Free;
TermList.Clear;
inherited;
end;
{--------}
{Begin !!.13}
function TffSqlSimpleExpression.ConcatBLOBValues(const Value1, Value2 : Variant) : Variant;
var
VPtr1, VPtr2 : PAnsiChar;
VStr1, VStr2 : string;
VLen1, VLen2 : Integer;
VPtrResult : PAnsiChar;
begin
try
if VarType(Value1) and VarTypeMask = varByte then begin
VPtr1 := VarArrayLock(Value1);
VStr1 := '';
VLen1 := VarArrayHighBound(Value1, 1);
end
else begin
VStr1 := VarToStr(Value1);
VPtr1 := PAnsiChar(VStr1);
VLen1 := Length(VStr1);
end;
if VarType(Value2) and VarTypeMask = varByte then begin
VPtr2 := VarArrayLock(Value2);
VStr2 := '';
VLen2 := VarArrayHighBound(Value2, 1);
end
else begin
VStr2 := VarToStr(Value2);
VPtr2 := PAnsiChar(VStr2);
VLen2 := Length(VStr2);
end;
{ Assumption: The result may always be returned as a BLOB value. }
Result := VarArrayCreate([1, VLen1 + VLen2], varByte);
VPtrResult := VarArrayLock(Result);
try
Move(VPtr1^, VPtrResult^, VLen1);
inc(VPtrResult, VLen1);
Move(VPtr2^, VPtrResult^, VLen2);
finally
VarArrayUnlock(Result);
end;
finally
if VStr1 = '' then
VarArrayUnlock(Value1);
if VStr2 = '' then
VarArrayUnlock(Value2);
end;
end;
{End !!.13}
{--------}
function TffSqlSimpleExpression.DependsOn(
Table: TFFSqlTableProxy): Boolean;
var
i : Integer;
begin
for i := 0 to pred(TermCount) do
if Term[i].DependsOn(Table) then begin
Result := True;
exit;
end;
Result := False;
end;
{--------}
destructor TffSqlSimpleExpression.Destroy;
begin
Clear;
TermList.Free;
inherited;
end;
{--------}
procedure TffSqlSimpleExpression.EmitSQL(Stream: TStream);
const
AddOpStr : array[TffSqlAddOp] of string = (' + ', ' - ', ' || ');
var
i : Integer;
begin
Term[0].EmitSQL(Stream);
for i := 1 to pred(TermCount) do begin
WriteStr(Stream, AddOpStr[Term[i].AddOp]);
Term[i].EmitSQL(Stream);
end;
end;
{--------}
procedure TffSqlSimpleExpression.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
var
i : Integer;
begin
EnumMethod(Self);
for i := 0 to pred(TermCount) do
Term[i].EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlSimpleExpression.Equals(Other: TffSqlNode): Boolean;
var
i : Integer;
begin
Result := False;
if Other is TffSqlSimpleExpression then begin
if TermCount <> TffSqlSimpleExpression(Other).TermCount then
exit;
for i := 0 to pred(TermCount) do
if not Term[i].Equals(TffSqlSimpleExpression(Other).Term[i]) then
exit;
Result := True;
end;
end;
{--------}
function TffSqlSimpleExpression.GetValue: Variant;
var
i : Integer;
Op: Variant;
Type1, Type2 : TffFieldType; {!!.13}
begin
if assigned(OwnerSelect) and
(OwnerSelect.AggQueryMode = aqmHaving) and not IsConstant
and not IsParameter then begin
Assert(BoundHaving);
Result := BoundHavingField.GetValue;
exit;
end;
if IsConstant then begin
Result := ConstantValue;
exit;
end;
Result := Term[0].GetValue;
if VarIsNull(Result) then exit;
for i := 1 to pred(TermCount) do begin
Op := Term[i].GetValue;
if VarIsNull(Op) then begin
Result := Null;
exit;
end;
Type1 := Term[0].GetType;
Type2 := Term[i].GetType;
case Term[i].AddOp of
aoPlus :
if (Type1 in [fftStDate, fftStTime, fftDateTime]) and
(Type2 = fftInterval) then
Result := Term[i].AddIntervalTo(Result)
else if (Type1 in [fftBLOB..fftBLOBTypedBin]) or
(Type2 in [fftBLOB..fftBLOBTypedBin]) then
Result := ConcatBLOBValues(Result, Op)
else
Result := Result + Op;
aoMinus :
if (Type1 in [fftStDate, fftStTime, fftDateTime]) and
(Type2 = fftInterval) then
Result := Term[i].SubtractIntervalFrom(Result)
else
Result := Result - Op;
aoConcat :
if (Type1 in [fftBLOB..fftBLOBTypedBin]) or
(Type2 in [fftBLOB..fftBLOBTypedBin]) then
Result := ConcatBLOBValues(Result, Op)
else
Result := Result + Op;
end;
end;
end;
{--------}
function TffSqlSimpleExpression.HasFieldRef: Boolean;
var
i : Integer;
begin
for i := 0 to pred(TermCount) do
if Term[i].HasFieldRef then begin
Result := True;
exit;
end;
Result := False;
end;
{--------}
function TffSqlSimpleExpression.IsAggregateExpression: Boolean;
var
i : Integer;
begin
for i := 0 to pred(TermCount) do
if Term[i].IsAggregateExpression then begin
Result := True;
exit;
end;
Result := False;
end;
{--------}
function TffSqlSimpleExpression.IsField(var FieldReferenced:
TFFSqlFieldProxy): Boolean;
begin
Result := (TermCount = 1) and Term[0].IsField(FieldReferenced);
end;
{--------}
function TffSqlSimpleExpression.IsFieldFrom(
Table: TFFSqlTableProxy; var FieldReferenced: TFFSqlFieldProxy;
var SameCase: Boolean): Boolean;
begin
Result := (TermCount = 1) and Term[0].IsFieldFrom(Table,
FieldReferenced, SameCase);
end;
{--------}
function TffSqlSimpleExpression.IsNull: Boolean;
var
i: Integer;
begin
for i := 0 to pred(TermCount) do
if Term[i].IsNull then begin
Result := True;
exit;
end;
Result := False;
end;
{--------}
function TffSqlSimpleExpression.GetTerm(
Index: Integer): TffSqlTerm;
begin
Result := TffSqlTerm(TermList[Index]);
end;
{--------}
function TffSqlSimpleExpression.GetTermCount: Integer;
begin
Result := TermList.Count;
end;
{--------}
function TffSqlSimpleExpression.GetTitle(const Qualified : Boolean): string; {!!.11}
begin
if TermCount = 1 then
Result := Term[0].GetTitle(Qualified) {!!.11}
else
Result := 'EXP';
end;
{--------}
function TffSqlSimpleExpression.IsParameter: Boolean;
begin
Result := (TermCount = 1)
and (Term[0].FactorCount = 1)
and (Term[0].Factor[0].Param <> nil);
end;
{--------}
procedure TffSqlSimpleExpression.BindHaving;
var
i: Integer;
begin
BindingHaving := True;
try
if IsConstant
or IsParameter then
exit;
finally
BindingHaving := False;
end;
for i := 0 to pred(OwnerSelect.SelectionList.SelectionCount) do
if OwnerSelect.SelectionList.Selection[i].SimpleExpression.Equals(
Self) then begin
BoundHavingField := OwnerSelect.HavingTable.Field(i);
BoundHaving := True;
exit;
end;
(* test code
{attempt to bind to aliased expression}
else
if OwnerSelect.SelectionList.Selection[i].Column <> nil then begin
if SameText(OwnerSelect.SelectionList.Selection[i].Column.ColumnName,
trim(Self.SQLText)) then begin
BoundHavingField := OwnerSelect.HavingTable.Field(i);
BoundHaving := True;
exit;
end;
end;
*)
SQLError('Expression in HAVING clause doesn''t match any columns');
end;
{--------}
function PropagateType(Type1, Type2: TffFieldType): TffFieldType;
function IsInt(Type1: TffFieldType): Boolean;
begin
Result := Type1 in [fftByte, fftWord16, fftWord32,
fftInt8, fftInt16, fftInt32, fftAutoInc];
end;
function IsSigned(Type1: TffFieldType): Boolean;
begin
Result := Type1 in [fftInt8, fftInt16, fftInt32];
end;
begin
if Type1 = Type2 then
Result := Type1
else
if IsInt(Type1) then
if IsInt(Type2) then
if IsSigned(Type1) then
if IsSigned(Type2) then
Result := fftInt32
else
Result := fftSingle
else
if IsSigned(Type2) then
Result := fftSingle
else
Result := fftWord32
else
Result := Type2
else
if IsInt(Type2) then
Result := Type1
else
Result := fftExtended;
end;
{--------}
procedure TffSqlSimpleExpression.CheckType;
var
i : Integer;
Type2: TffFieldType;
begin
FType := Term[0].GetType;
if TermCount > 1 then begin
case Term[1].AddOp of
aoPlus :
case FType of
fftByte,
fftWord16,
fftWord32,
fftInt8,
fftInt16,
fftInt32,
fftAutoInc,
fftSingle,
fftDouble,
fftExtended,
fftComp,
fftCurrency,
fftStDate,
fftStTime,
fftDateTime,
fftChar,
fftWideChar,
fftShortString,
fftShortAnsiStr,
fftNullString,
fftNullAnsiStr,
fftWideString :
;
else
SQLError('Operator/operand mismatch');
end;
aoMinus :
case FType of
fftByte,
fftWord16,
fftWord32,
fftInt8,
fftInt16,
fftInt32,
fftAutoInc,
fftSingle,
fftDouble,
fftExtended,
fftComp,
fftCurrency:
;
fftStDate,
fftStTime,
fftDateTime :
case Term[1].GetType of
fftStDate, fftStTime, fftDateTime :
FType := fftDouble;
end; { case }
else
SQLError('Operator/operand mismatch');
end;
aoConcat :
case FType of
fftChar,
fftWideChar,
fftShortString,
fftShortAnsiStr,
fftNullString,
fftNullAnsiStr,
fftWideString :
;
else
SQLError('Operator/operand mismatch');
end;
end;
for i := 1 to pred(TermCount) do begin
Type2 := Term[i].GetType;
case Term[i].AddOp of
aoPlus :
case Type2 of
fftByte,
fftWord16,
fftWord32,
fftInt8,
fftInt16,
fftInt32,
fftAutoInc,
fftSingle,
fftDouble,
fftExtended,
fftComp,
fftCurrency,
fftChar,
fftWideChar,
fftShortString,
fftShortAnsiStr,
fftNullString,
fftNullAnsiStr,
fftWideString,
fftStDate,
fftStTime,
fftDateTime,
fftInterval:
else
SQLError('Operator/operand mismatch');
end;
aoMinus :
case Type2 of
fftByte,
fftWord16,
fftWord32,
fftInt8,
fftInt16,
fftInt32,
fftAutoInc,
fftSingle,
fftDouble,
fftExtended,
fftComp,
fftCurrency,
fftStDate,
fftStTime,
fftDateTime,
fftInterval:
;
else
SQLError('Operator/operand mismatch');
end;
aoConcat :
case Type2 of
fftChar,
fftWideChar,
fftShortString,
fftShortAnsiStr,
fftNullString,
fftNullAnsiStr,
fftWideString :
;
else
SQLError('Operator/operand mismatch');
end;
end;
case Type2 of
fftByte, fftWord16, fftWord32, fftInt8, fftInt16, fftInt32,
fftAutoInc, fftSingle, fftDouble, fftExtended, fftComp, fftCurrency :
FType := PropagateType(FType, Type2);
end;
end;
end;
TypeKnown := True;
end;
{--------}
function TffSqlSimpleExpression.GetDecimals: Integer;
var
i, j : Integer;
begin
Result := Term[0].GetDecimals;
for i := 1 to pred(TermCount) do begin
j := Term[i].GetDecimals;
if j > Result then
Result := j;
end;
end;
{--------}
function TffSqlSimpleExpression.GetSize: Integer;
var
i : Integer;
begin
Result := Term[0].GetSize;
{operator here can only be aoConcat
(because GetSize is only called for text fields)}
for i := 1 to pred(TermCount) do
inc(Result, Term[i].GetSize);
end;
{--------}
function TffSqlSimpleExpression.GetType: TffFieldType;
begin
if not TypeKnown then
CheckType;
Result := FType
end;
{--------}
function TffSqlSimpleExpression.IsAggregate: Boolean;
begin
Result := (TermCount = 1) and Term[0].IsAggregate;
end;
{--------}
procedure TffSqlSimpleExpression.CheckIsConstant;
var
i : Integer;
Save : TffSqlAggQueryMode;
begin
FIsConstantChecked := True;
for i := 0 to pred(TermCount) do
if not Term[i].IsConstant then begin
FIsConstant := False;
exit;
end;
if not BindingHaving then begin
Save := aqmIdle;
if assigned(OwnerSelect) then begin
Save := OwnerSelect.AggQueryMode;
OwnerSelect.AggQueryMode := aqmIdle;
end;
ConstantValue := GetValue;
if assigned(OwnerSelect) then
OwnerSelect.AggQueryMode := Save;
end;
FIsConstant := True;
end;
{--------}
function TffSqlSimpleExpression.IsConstant: Boolean;
begin
if not FIsConstantChecked then
CheckIsConstant;
Result := FIsConstant;
end;
{--------}
procedure TffSqlSimpleExpression.MatchType(ExpectedType: TffFieldType);
var
i : Integer;
begin
for i := 0 to pred(TermCount) do
Term[i].MatchType(ExpectedType);
end;
{--------}
function TffSqlSimpleExpression.Reduce: Boolean;
var
i : Integer;
begin
for i := 0 to pred(TermCount) do
if Term[i].Reduce then begin
Result := True;
exit;
end;
Result := False;
end;
{--------}
procedure TffSqlSimpleExpression.ResetConstant;
begin
FIsConstantChecked := False;
FIsConstant := False;
end;
{--------}
procedure TffSqlSimpleExpression.SetTerm(Index: Integer;
const Value: TffSqlTerm);
begin
TermList[Index] := Value;
end;
{Begin !!.11}
{--------}
function TffSqlSimpleExpression.WasWildcard : Boolean;
begin
if TermCount = 1 then
Result := Term[0].WasWildcard
else
Result := False;
end;
{End !!.11}
{====================================================================}
{===TffSqlTerm=======================================================}
function TffSqlTerm.AddFactor(Factor: TffSqlFactor): TffSqlFactor;
begin
FactorList.Add(Factor);
Result := Factor;
end;
{--------}
function TffSqlTerm.AddIntervalTo(Target: TDateTime): TDateTime;
begin
Result := Factor[0].AddIntervalTo(Target);
end;
{--------}
function TffSqlTerm.SubtractIntervalFrom(Target: TDateTime): TDateTime;
begin
Result := Factor[0].SubtractIntervalFrom(Target);
end;
{--------}
procedure TffSqlTerm.CheckIsConstant;
var
i : Integer;
begin
FIsConstantChecked := True;
for i := 0 to pred(FactorCount) do
if not Factor[i].IsConstant then begin
FIsConstant := False;
exit;
end;
ConstantValue := GetValue;
FIsConstant := True;
end;
{--------}
procedure TffSqlTerm.CheckType;
var
i : Integer;
Type2: TffFieldType;
begin
FType := Factor[0].GetType;
if FactorCount > 1 then begin
case Factor[1].MulOp of
moMul, moDiv :
case FType of
fftByte,
fftWord16,
fftWord32,
fftInt8,
fftInt16,
fftInt32,
fftAutoInc,
fftSingle,
fftDouble,
fftExtended,
fftComp,
fftCurrency :
;
else
SQLError('Operator/operand mismatch');
end;
end;
for i := 1 to pred(FactorCount) do begin
case Factor[i].MulOp of
moMul, moDiv :
begin
Type2 := Factor[i].GetType;
case Type2 of
fftByte,
fftWord16,
fftWord32,
fftInt8,
fftInt16,
fftInt32,
fftAutoInc,
fftSingle,
fftDouble,
fftExtended,
fftComp,
fftCurrency :
;
else
SQLError('Operator/operand mismatch');
end;
case Type2 of
fftByte, fftWord16, fftWord32, fftInt8, fftInt16, fftInt32,
fftAutoInc, fftSingle, fftDouble, fftExtended, fftComp,
fftCurrency :
FType := PropagateType(FType, Type2);
end;
end;
end;
end;
end;
TypeKnown := True;
end;
{--------}
procedure TffSqlTerm.Assign(const Source: TffSqlNode);
var
i : Integer;
begin
if Source is TffSqlTerm then begin
Clear;
for i := 0 to pred(TffSqlTerm(Source).FactorCount) do begin
AddFactor(TffSqlFactor.Create(Self)).Assign(
TffSqlTerm(Source).Factor[i]);
end;
AddOp := TffSqlTerm(Source).AddOp;
end else
AssignError(Source);
end;
{--------}
constructor TffSqlTerm.Create(AParent: TffSqlNode);
begin
inherited Create(AParent);
FactorList := TList.Create;
end;
{--------}
procedure TffSqlTerm.Clear;
var
i : Integer;
begin
for i := 0 to pred(FactorCount) do
Factor[i].Free;
FactorList.Clear;
end;
{--------}
function TffSqlTerm.DependsOn(Table: TFFSqlTableProxy): Boolean;
var
i : Integer;
begin
for i := 0 to pred(FactorCount) do
if Factor[i].DependsOn(Table) then begin
Result := True;
exit;
end;
Result := False;
end;
{--------}
destructor TffSqlTerm.Destroy;
begin
Clear;
FactorList.Free;
inherited;
end;
{--------}
procedure TffSqlTerm.EmitSQL(Stream: TStream);
const
MulOpStr : array[TffSqlMulOp] of string = (' * ', ' / ');
var
i : Integer;
begin
Factor[0].EmitSQL(Stream);
for i := 1 to pred(FactorCount) do begin
WriteStr(Stream, MulOpStr[Factor[i].MulOp]);
Factor[i].EmitSQL(Stream);
end;
end;
{--------}
procedure TffSqlTerm.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
var
i : Integer;
begin
EnumMethod(Self);
for i := 0 to pred(FactorCount) do
Factor[i].EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlTerm.Equals(Other: TffSqlNode): Boolean;
var
i : Integer;
begin
Result := False;
if (Other is TffSqlTerm)
and (AddOp = TffSqlTerm(Other).AddOp) then begin
if FactorCount <> TffSqlTerm(Other).FactorCount then
exit;
for i := 0 to pred(FactorCount) do
if not Factor[i].Equals(TffSqlTerm(Other).Factor[i]) then
exit;
Result := True;
end;
end;
{--------}
function TffSqlTerm.GetFactor(Index: Integer): TffSqlFactor;
begin
Result := TffSqlFactor(FactorList[Index]);
end;
{--------}
function TffSqlTerm.GetFactorCount: Integer;
begin
Result := FactorList.Count;
end;
{--------}
function TffSqlTerm.GetDecimals: Integer;
var
i, j : Integer;
begin
Result := Factor[0].GetDecimals;
for i := 1 to pred(FactorCount) do begin
j := Factor[i].GetDecimals;
if j > Result then
Result := j;
end;
end;
{--------}
function TffSqlTerm.GetSize: Integer;
begin
Result := Factor[0].GetSize;
end;
{--------}
function TffSqlTerm.GetTitle(const Qualified : Boolean): string; {!!.11}
begin
if FactorCount = 1 then
Result := Factor[0].GetTitle(Qualified) {!!.11}
else
Result := 'EXP';
end;
{--------}
function TffSqlTerm.GetType: TffFieldType;
begin
if not TypeKnown then
CheckType;
Result := FType
end;
{--------}
function TffSqlTerm.GetValue: Variant;
var
i : Integer;
Op: Variant;
begin
if IsConstant then begin
Result := ConstantValue;
exit;
end;
Result := Factor[0].GetValue;
if VarIsNull(Result) then exit;
for i := 1 to pred(FactorCount) do begin
Op := Factor[i].GetValue;
if VarIsNull(Op) then begin
Result := Null;
exit;
end;
case Factor[i{1}].MulOp of {!!.11}
moMul :
Result := Result * Op;
moDiv :
Result := Result / Op;
end;
end;
end;
{--------}
function TffSqlTerm.IsAggregate: Boolean;
begin
Result := (FactorCount = 1) and Factor[0].IsAggregate;
end;
{--------}
function TffSqlTerm.HasFieldRef: Boolean;
var
i : Integer;
begin
for i := 0 to pred(FactorCount) do
if Factor[i].HasFieldRef then begin
Result := True;
exit;
end;
Result := False;
end;
{--------}
function TffSqlTerm.IsAggregateExpression: Boolean;
var
i : Integer;
begin
for i := 0 to pred(FactorCount) do
if Factor[i].IsAggregate then begin
Result := True;
exit;
end;
Result := False;
end;
{--------}
function TffSqlTerm.IsConstant: Boolean;
begin
if not FIsConstantChecked then
CheckIsConstant;
Result := FIsConstant;
end;
{--------}
function TffSqlTerm.IsField(var FieldReferenced: TFFSqlFieldProxy): Boolean;
begin
Result := (FactorCount = 1) and Factor[0].IsField(FieldReferenced);
end;
{--------}
function TffSqlTerm.IsFieldFrom(Table: TFFSqlTableProxy;
var FieldReferenced: TFFSqlFieldProxy; var SameCase: Boolean): Boolean;
begin
Result := (FactorCount = 1) and Factor[0].IsFieldFrom(Table, FieldReferenced,
SameCase);
end;
{--------}
function TffSqlTerm.IsNull: Boolean;
var
i : Integer;
begin
for i := 0 to pred(FactorCount) do
if Factor[i].IsNull then begin
Result := True;
exit;
end;
Result := False;
end;
{--------}
procedure TffSqlTerm.MatchType(ExpectedType: TffFieldType);
var
i : Integer;
begin
for i := 0 to pred(FactorCount) do
Factor[i].MatchType(ExpectedType);
end;
{--------}
function TffSqlTerm.Reduce: Boolean;
var
i : Integer;
begin
for i := 0 to pred(FactorCount) do
if Factor[i].Reduce then begin
Result := True;
exit;
end;
Result := False;
end;
{--------}
procedure TffSqlTerm.ResetConstant;
begin
FIsConstantChecked := False;
FIsConstant := False;
end;
{--------}
procedure TffSqlTerm.SetFactor(Index: Integer;
const Value: TffSqlFactor);
begin
FactorList[Index] := Value;
end;
{Begin !!.11}
{--------}
function TffSqlTerm.WasWildcard : Boolean;
begin
if FactorCount = 1 then
Result := Factor[0].WasWildcard
else
Result := False;
end;
{End !!.11}
{====================================================================}
{===TffSqlCondExp====================================================}
function TffSqlCondExp.AddCondTerm(Term: TffSqlCondTerm): TffSqlCondTerm;
begin
CondTermList.Add(Term);
Result := Term;
end;
{--------}
function TffSqlCondExp.AsBooleanLevel(Level: Integer): Boolean;
var
i : Integer;
begin
if IsConstant then begin
Result := ConstantValue;
exit;
end;
for i := 0 to pred(CondTermCount) do
if CondTerm[i].AsBooleanLevel(Level) then begin
Result := True;
exit;
end;
Result := False;
end;
{--------}
function TffSqlCondExp.AsBoolean: Boolean;
var
i : Integer;
begin
if IsConstant then begin
Result := ConstantValue;
exit;
end;
for i := 0 to pred(CondTermCount) do
if CondTerm[i].AsBoolean then begin
Result := True;
exit;
end;
Result := False;
end;
{--------}
procedure TffSqlCondExp.Assign(const Source: TffSqlNode);
var
i : Integer;
begin
if Source is TffSqlCondExp then begin
Clear;
for i := 0 to pred(TffSqlCondExp(Source).CondTermCount) do
AddCondTerm(TffSqlCondTerm.Create(Self)).Assign(
TffSqlCondExp(Source).CondTerm[i]);
end else
AssignError(Source);
end;
procedure TffSqlCondExp.BindHaving;
var
i : Integer;
begin
for i := 0 to pred(CondTermCount) do
CondTerm[i].BindHaving;
end;
procedure TffSqlCondExp.CheckIsConstant;
var
i : Integer;
begin
FIsConstantChecked := True;
for i := 0 to pred(CondTermCount) do
if not CondTerm[i].IsConstant then begin
FIsConstant := False;
exit;
end;
ConstantValue := GetValue;
FIsConstant := True;
end;
constructor TffSqlCondExp.Create(AParent: TffSqlNode);
begin
inherited Create(AParent);
CondTermList := TList.Create;
end;
{--------}
procedure TffSqlCondExp.Clear;
var
i : Integer;
begin
for i := 0 to pred(CondTermCount) do
CondTerm[i].Free;
CondTermList.Clear;
end;
{--------}
function TffSqlCondExp.DependsOn(Table: TFFSqlTableProxy): Boolean;
var
i : Integer;
begin
for i := 0 to pred(CondTermCount) do
if CondTerm[i].DependsOn(Table) then begin
Result := True;
exit;
end;
Result := False;
end;
{--------}
destructor TffSqlCondExp.Destroy;
begin
Clear;
CondTermList.Free;
inherited;
end;
{--------}
procedure TffSqlCondExp.EmitSQL(Stream: TStream);
var
i : Integer;
begin
CondTerm[0].EmitSQL(Stream);
for i := 1 to pred(CondTermCount) do begin
WriteStr(Stream, ' OR');
CondTerm[i].EmitSQL(Stream);
end;
end;
{--------}
procedure TffSqlCondExp.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
var
i : Integer;
begin
EnumMethod(Self);
for i := 0 to pred(CondTermCount) do
CondTerm[i].EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlCondExp.Equals(Other: TffSqlNode): Boolean;
var
i : Integer;
begin
Result := False;
if Other is TffSqlCondExp then begin
if CondTermCount <> TffSqlCondExp(Other).CondTermCount then
exit;
for i := 0 to pred(CondTermCount) do
if not CondTerm[i].Equals(TffSqlCondExp(Other).CondTerm[i]) then
exit;
Result := True;
end;
end;
{--------}
function TffSqlCondExp.GetCondTerm(
Index: Integer): TffSqlCondTerm;
begin
Result := TffSqlCondTerm(CondTermList[Index]);
end;
{--------}
function TffSqlCondExp.GetCondTermCount: Integer;
begin
Result := CondTermList.Count;
end;
{--------}
function TffSqlCondExp.GetDecimals: Integer;
begin
if CondTermCount > 1 then
TypeMismatch;
Result := CondTerm[0].GetDecimals;
end;
{--------}
{!!.10 new}
function TffSqlCondExp.GetSize: Integer;
begin
if CondTermCount > 1 then
Result := 1
else
Result := CondTerm[0].GetSize;
end;
{--------}
function TffSqlCondExp.GetTitle(const Qualified : Boolean): string; {!!.11}
begin
if CondTermCount > 1 then
Result := 'COND'
else
Result := CondTerm[0].GetTitle(Qualified); {!!.11}
end;
{--------}
function TffSqlCondExp.GetType: TffFieldType;
var
i: Integer;
begin
if CondTermCount > 1 then begin
{force type conversion at lower level if necessary}
for i := 0 to pred(CondTermCount) do
CondTerm[i].GetType;
Result := fftBoolean
end else
Result := CondTerm[0].GetType;
end;
{--------}
function TffSqlCondExp.GetValue: Variant;
begin
if IsConstant then begin
Result := ConstantValue;
exit;
end;
if CondTermCount > 1 then
Result := AsBoolean
else
Result := CondTerm[0].GetValue;
end;
{--------}
function TffSqlCondExp.IsConstant: Boolean;
begin
if not FIsConstantChecked then
CheckIsConstant;
Result := FIsConstant;
end;
procedure TffSqlCondExp.MatchType(ExpectedType: TffFieldType);
begin
if CondTermCount = 1 then {!!.11}
CondTerm[0].MatchType(ExpectedType) {!!.11}
else {!!.11}
if GetType <> ExpectedType then
TypeMismatch;
end;
{--------}
function TffSqlCondExp.Reduce: Boolean;
var
i,j : Integer;
InFactIX,
InTermIX: Integer;
NewTerm, LiftTerm : TffSqlCondTerm;
NewFactor: TffSqlCondFactor;
NewPrimary: TffSqlCondPrimary;
LiftInClause: TffSqlInClause;
LiftInExp: TffSqlSimpleExpression;
LiftExp : TffSqlCondExp;
begin
Result := False;
LiftInClause := nil;
LiftInExp := nil;
LiftExp := nil;
InTermIX := -1; //just to make the compiler happy
InFactIX := -1; //just to make the compiler happy
for i := 0 to pred(CondTermCount) do begin
{look for conditional terms nested inside redundant parens}
{eliminate parens when found}
LiftTerm := nil;
LiftExp := nil;
with CondTerm[i] do begin
if CondFactorCount = 1 then begin
with CondFactor[0] do
if not UnaryNot then
if (CondPrimary.RelOp = roNone) then
if CondPrimary.SimpleExp1 <> nil then
if CondPrimary.JustSimpleExpression then
with CondPrimary.SimpleExp1 do
if TermCount = 1 then begin
with Term[0] do
if FactorCount = 1 then
with Factor[0] do
if CondExp <> nil then
with CondExp do
if CondTermCount = 1 then begin
LiftTerm := TffSqlCondTerm.Create(Self);
LiftTerm.Assign(CondTerm[0]);
end;
end;
end;
if LiftTerm <> nil then begin
Clear;
Assign(LiftTerm);
LiftTerm.Free;
Result := True;
{Get out. We may have more to do here, but Global Logic will
call us again, and there may be other transformations that can
be applied first.}
break;
end;
if Reduce then begin
{term itself was reduced}
Result := True;
break;
end;
if not Result then begin
{look for IN expressions to be converted to simple comparisons}
for j := 0 to pred(CondFactorCount) do
with CondFactor[j] do
if not UnaryNot then {can't handle negated expressions}
if CondPrimary.RelOp = roNone then
if (CondPrimary.InClause <> nil)
and not (CondPrimary.InClause.Negated)
and (CondPrimary.InClause.SubQuery = nil)
and (CondPrimary.InClause.SimpleExpList.ExpressionCount <=
ffSqlInConvThreshold) then begin
{Here's one. Make a copy of it and get up to the
root level since we'll be doing surgery on this
very node hierarchy we're current looking at}
LiftInClause := TffSqlInClause.Create(Self);
LiftInClause.Assign(CondPrimary.InClause);
LiftInExp := TffSqlSimpleExpression.Create(Self);
LiftInExp.Assign(CondPrimary.SimpleExp1);
InTermIX := i; // just a reference back to here
if CondFactorCount > 1 then
{we have other factors that need to be copied -
make note of where the IN is - we should copy
everything BUT}
InFactIX := j
{we're the only factor, make a note of that by
setting the InFactIX flag to -1 indicating no
other factors should be copied}
else
InFactIX := -1;
break;
end;
end;
if not Result then begin
{look for nested conditional expressions to be lifted out, like
(A OR B) AND C to be converted to A AND C OR B AND C}
for j := 0 to pred(CondFactorCount) do
with CondFactor[j] do
if not UnaryNot then
if (CondPrimary.RelOp = roNone) then
if CondPrimary.SimpleExp1 <> nil then
if CondPrimary.JustSimpleExpression then
with CondPrimary.SimpleExp1 do
if TermCount = 1 then begin
with Term[0] do
if FactorCount = 1 then
with Factor[0] do
if CondExp <> nil then begin
LiftExp := TffSqlCondExp.Create(Self);
LiftExp.Assign(CondExp);
InTermIX := i; // A reference back to here
InFactIX := j; // A reference back to here
end;
end;
end;
if LiftInClause <> nil then
break;
if LiftExp <> nil then
break;
end;
end;
if LiftExp <> nil then begin
{create a top-level conditional term for each nested term,
then copy each conditional factor except the one we're converting
to each new term:}
for i := 0 to pred(LiftExp.CondTermCount) do begin
NewTerm := TffSqlCondTerm.Create(Self);
NewTerm.Assign(LiftExp.CondTerm[i]);
for j := 0 to pred(CondTerm[InTermIX].CondFactorCount) do
if j <> InFactIX then begin
NewFactor := TffSqlCondFactor.Create(NewTerm);
NewFactor.Assign(CondTerm[InTermIX].CondFactor[j]);
NewTerm.AddCondFactor(NewFactor);
end;
AddCondTerm(NewTerm);
end;
LiftInClause.Free;
LiftInExp.Free;
LiftExp.Free;
CondTerm[InTermIX].Free;
CondTermList.Delete(InTermIX);
Result := True;
exit;
end;
if (LiftInClause <> nil)
and (InFactIX = -1) then begin {only do this optimization if no other factors} {!!.11}
{Okay - that was the easy bit, finding the IN clause.
We now need to build conditional terms for each of the
alternatives - each with a simple comparison corresponding
to each entry in the IN clause list.}
for i := 0 to pred(LiftInClause.SimpleExpList.ExpressionCount) do begin
NewTerm := TffSqlCondTerm.Create(Self);
NewFactor := TffSqlCondFactor.Create(NewTerm);
NewPrimary := TffSqlCondPrimary.Create(NewFactor);
NewPrimary.SimpleExp1 := TffSqlSimpleExpression.Create(NewPrimary);
NewPrimary.SimpleExp1.Assign(LiftInExp);
NewPrimary.SimpleExp2 := TffSqlSimpleExpression.Create(NewPrimary);
NewPrimary.SimpleExp2.Assign(LiftInClause.SimpleExpList.Expression[i]);
NewPrimary.RelOp := roEQ;
NewFactor.CondPrimary := NewPrimary;
NewTerm.AddCondFactor(NewFactor);
{If we didn't have any other conditional factors
combined with the IN clause - IOW, we didn't have something like
Exp IN [blahblah] AND something else,
then we're actually done. All we need to do is add each term, then
finish off by deleting the original term which held the IN clause.
On the other hand, if we did have other factors, they all need to
be copied to the new term:}
if InFactIX <> -1 then begin
with CondTerm[InTermIX] do
for j := 0 to pred(CondFactorCount) do
if j <> InFactIX then begin
NewFactor := TffSqlCondFactor.Create(NewTerm);
NewFactor.Assign(CondFactor[j]);
NewTerm.AddCOndFactor(NewFactor);
end;
end;
AddCondTerm(NewTerm);
end;
{LiftInClause.Free;} {!!.12}
{LiftInExp.Free;} {!!.12}
//get rid of the original term with the IN clause
CondTerm[InTermIX].Free;
CondTermList.Delete(InTermIX);
Result := True;
end;
LiftInClause.Free; {!!.12}
LiftInExp.Free; {!!.12}
{!!.11 begin}
if not Result then
for i := 0 to pred(CondTermCount) do
if CondTerm[i].Reduce then begin
Result := True;
break;
end;
{!!.11 end}
end;
procedure TffSqlCondExp.ResetConstant;
begin
FIsConstantChecked := False;
FIsConstant := False;
end;
procedure TffSqlCondExp.SetCondTerm(Index: Integer;
const Value: TffSqlCondTerm);
begin
CondTermList[Index] := Value;
end;
procedure TffSqlCondExp.SetLevelDep(List: TFFSqlTableProxySubsetList);
var
i : Integer;
begin
for i := 0 to pred(CondTermCount) do
CondTerm[i].SetLevelDep(List);
end;
{====================================================================}
{===TffSqlCondTerm===================================================}
function TffSqlCondTerm.AddCondFactor(Factor: TffSqlCondFactor): TffSqlCondFactor;
begin
CondFactorList.Add(Factor);
Result := Factor;
end;
{--------}
function TffSqlCondTerm.InsertCondFactor(Index: Integer;
Factor : TffSqlCondFactor): TffSqlCondFactor;
begin
CondFactorList.Insert(Index, Factor);
Result := Factor;
end;
{--------}
procedure TffSqlCondTerm.SetLevelDep(List: TFFSqlTableProxySubsetList);
var
F, Level : Integer;
begin
for F := 0 to pred(CondFactorCount) do
with CondFactor[F] do begin
EvalLevel := List.Count;
for Level := pred(List.Count) downto 0 do
if DependsOn(List.Item[Level].Table) then
EvalLevel := Level;
end;
end;
function TffSqlCondTerm.AsBoolean: Boolean;
var
i : Integer;
begin
if IsConstant then begin
Result := ConstantValue;
exit;
end;
for i := 0 to pred(CondFactorCount) do
if not CondFactor[i].AsBoolean then begin
Result := False;
exit;
end;
Result := True;
end;
{--------}
function TffSqlCondTerm.AsBooleanLevel(Level: Integer): Boolean;
var
i : Integer;
begin
if IsConstant then begin
Result := ConstantValue;
exit;
end;
for i := 0 to pred(CondFactorCount) do
if (CondFactor[i].EvalLevel >= Level)
and not CondFactor[i].AsBoolean then begin
Result := False;
exit;
end;
Result := True;
end;
{--------}
procedure TffSqlCondTerm.Assign(const Source: TffSqlNode);
var
i : Integer;
begin
if Source is TffSqlCondTerm then begin
Clear;
for i := 0 to pred(TffSqlCondTerm(Source).CondFactorCount) do begin
AddCondFactor(TffSqlCondFactor.Create(Self)).Assign(
TffSqlCondTerm(Source).CondFactor[i]);
end;
end else
AssignError(Source);
end;
procedure TffSqlCondTerm.BindHaving;
var
i : Integer;
begin
for i := 0 to pred(CondFactorCount) do
CondFactor[i].BindHaving;
end;
procedure TffSqlCondTerm.CheckIsConstant;
var
i : Integer;
begin
FIsConstantChecked := True;
for i := 0 to pred(CondFactorCount) do
if not CondFactor[i].IsConstant then begin
FIsConstant := False;
exit;
end;
ConstantValue := GetValue;
FIsConstant := True;
end;
constructor TffSqlCondTerm.Create(AParent: TffSqlNode);
begin
inherited Create(AParent);
CondFactorList := TList.Create;
end;
{--------}
procedure TffSqlCondTerm.Clear;
var
i : Integer;
begin
for i := 0 to pred(CondFactorCount) do
CondFactor[i].Free;
CondFactorList.Clear;
end;
{--------}
function TffSqlCondTerm.DependsOn(Table: TFFSqlTableProxy): Boolean;
var
i : Integer;
begin
for i := 0 to pred(CondFactorCount) do
if CondFactor[i].DependsOn(Table) then begin
Result := True;
exit;
end;
Result := False;
end;
{--------}
destructor TffSqlCondTerm.Destroy;
begin
Clear;
CondFactorList.Free;
OrderedSources.Free;
inherited;
end;
{--------}
procedure TffSqlCondTerm.EmitSQL(Stream: TStream);
var
i : Integer;
begin
CondFactor[0].EmitSQL(Stream);
for i := 1 to pred(CondFactorCount) do begin
WriteStr(Stream,' AND');
CondFactor[i].EmitSQL(Stream);
end;
end;
{--------}
procedure TffSqlCondTerm.EnumNodes(EnumMethod: TffSqlEnumMethod;
const Deep: Boolean);
var
i : Integer;
begin
EnumMethod(Self);
for i := 0 to pred(CondFactorCount) do
CondFactor[i].EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlCondTerm.Equals(Other: TffSqlNode): Boolean;
var
i : Integer;
begin
Result := False;
if Other is TffSqlCondTerm then begin
if CondFactorCount <> TffSqlCondTerm(Other).CondFactorCount then
exit;
for i := 0 to pred(CondFactorCount) do
if not CondFactor[i].Equals(TffSqlCondTerm(Other).CondFactor[i]) then
exit;
Result := True;
end;
end;
{--------}
function TffSqlCondTerm.GetCondFactor(
Index: Integer): TffSqlCondFactor;
begin
Result := TffSqlCondFactor(CondFactorList[Index]);
end;
{--------}
function TffSqlCondTerm.GetCondFactorCount: Integer;
begin
Result := CondFactorList.Count;
end;
{--------}
function TffSqlCondTerm.GetDecimals: Integer;
begin
if CondFactorCount > 1 then
TypeMismatch;
Result := CondFactor[0].GetDecimals;
end;
{--------}
{!!.10 new}
function TffSqlCondTerm.GetSize: Integer;
begin
if CondFactorCount > 1 then
Result := 1
else
Result := CondFactor[0].GetSize;
end;
{--------}
function TffSqlCondTerm.GetTitle(const Qualified : Boolean): string; {!!.11}
begin
if CondFactorCount > 1 then
Result := 'COND'
else
Result := CondFactor[0].GetTitle(Qualified); {!!.11}
end;
{--------}
function TffSqlCondTerm.GetType: TffFieldType;
var
i: Integer;
begin
if CondFactorCount > 1 then begin
{force type conversion at lower level if necessary}
for i := 0 to pred(CondFactorCount) do
CondFactor[i].GetType;
Result := fftBoolean
end else
Result := CondFactor[0].GetType;
end;
{--------}
function TffSqlCondTerm.GetValue: Variant;
begin
if IsConstant then begin
Result := ConstantValue;
exit;
end;
if CondFactorCount > 1 then
Result := AsBoolean
else
Result := CondFactor[0].GetValue;
end;
{--------}
function TffSqlCondTerm.IsConstant: Boolean;
begin
if not FIsConstantChecked then
CheckIsConstant;
Result := FIsConstant;
end;
{!!.11 new}
procedure TffSqlCondTerm.MatchType(ExpectedType: TffFieldType);
var
i: Integer;
T: TffFieldType;
begin
if CondFactorCount > 1 then begin
if ExpectedType <> fftBoolean then
TypeMismatch;
{force necessary type conversion at lower level}
T := CondFactor[0].GetType;
for i := 1 to CondFactorCount - 1 do
CondFactor[i].MatchType(T);
end else
CondFactor[0].MatchType(ExpectedType);
end;
function TffSqlCondTerm.Reduce: Boolean;
var
i, j : Integer;
LiftFactor : TffSqlCondFactor;
LiftTerm: TffSqlCondTerm;
B : Boolean;
begin
{Look for conditional factors nested inside redundant parens}
{ - eliminate parens when found}
{Look for BETWEEN expressions and convert them to two comparisons}
Result := False;
for i := 0 to pred(CondFactorCount) do begin
//LiftFactor := nil;
LiftTerm := nil;
with CondFactor[i] do begin
if (CondPrimary.RelOp = roNone) then
if CondPrimary.BetweenClause <> nil then begin
if not CondPrimary.BetweenClause.Negated xor UnaryNot then begin
{create a new CondPrimary to hold the >= comparison}
LiftFactor := TffSqlCondFactor.Create(Self);
LiftFactor.CondPrimary := TffSqlCondPrimary.Create(LiftFactor);
LiftFactor.CondPrimary.RelOp := roGE;
LiftFactor.CondPrimary.SimpleExp1 :=
TffSqlSimpleExpression.Create(LiftFactor.CondPrimary);
LiftFactor.CondPrimary.SimpleExp1.Assign(CondPrimary.SimpleExp1);
LiftFactor.CondPrimary.SimpleExp2 :=
TffSqlSimpleExpression.Create(LiftFactor.CondPrimary);
LiftFactor.CondPrimary.SimpleExp2.Assign(
CondPrimary.BetweenClause.SimpleLow);
InsertCondFactor(i, LiftFactor);
{convert current CondPrimary to a >= comparison}
CondPrimary.RelOp := roLE;
CondPrimary.SimpleExp2 := TffSqlSimpleExpression.Create(CondPrimary);
CondPrimary.SimpleExp2.Assign(CondPrimary.BetweenClause.SimpleHigh);
CondPrimary.BetweenClause.Free;
CondPrimary.BetweenClause := nil;
Result := True;
UnaryNot := False;
break;
end;
end else
if CondPrimary.LikeClause <> nil then begin
if not CondPrimary.LikeClause.Negated xor UnaryNot then begin
if CondPrimary.LikeClause.CanLimit then begin
{create a new CondPrimary to hold the >= comparison}
LiftFactor := TffSqlCondFactor.Create(Self);
LiftFactor.CondPrimary := TffSqlCondPrimary.Create(LiftFactor);
LiftFactor.CondPrimary.RelOp := roGE;
LiftFactor.CondPrimary.SimpleExp1 := TffSqlSimpleExpression.Create(LiftFactor.CondPrimary);
LiftFactor.CondPrimary.SimpleExp1.Assign(CondPrimary.SimpleExp1);
LiftFactor.CondPrimary.SimpleExp2 := CreateLiteralStringExp(LiftFactor, CondPrimary.LikeClause.GetLowLimit);
InsertCondFactor(i, LiftFactor);
{create a new CondPrimary to hold the <= comparison}
LiftFactor := TffSqlCondFactor.Create(Self);
LiftFactor.CondPrimary := TffSqlCondPrimary.Create(LiftFactor);
LiftFactor.CondPrimary.RelOp := roL;
LiftFactor.CondPrimary.SimpleExp1 := TffSqlSimpleExpression.Create(LiftFactor.CondPrimary);
LiftFactor.CondPrimary.SimpleExp1.Assign(CondPrimary.SimpleExp1);
LiftFactor.CondPrimary.SimpleExp2 := CreateLiteralStringExp(LiftFactor, CondPrimary.LikeClause.GetHighLimit);
InsertCondFactor(i, LiftFactor);
if CondPrimary.LikeClause.CanReplaceWithCompare then begin
{we no longer need the LIKE clause}
CondFactor[i + 2].Free;
CondFactorList.Delete(i + 2); // adjust for the two we just inserted
end else
CondPrimary.LikeClause.Limited := True;
Result := True;
break;
end;
end;
end else
if CondPrimary.InClause <> nil then
else
if CondPrimary.IsTest <> nil then
else
if CondPrimary.ExistsClause <> nil then
else
if CondPrimary.UniqueClause <> nil then
else
if CondPrimary.MatchClause <> nil then
else
if CondPrimary.SimpleExp1 <> nil then
with CondPrimary.SimpleExp1 do
if TermCount = 1 then begin
with Term[0] do
if FactorCount = 1 then
with Factor[0] do
if CondExp <> nil then
with CondExp do
if CondTermCount = 1 then
LiftTerm := CondTerm[0];
end;
if LiftTerm <> nil then begin
//first lift all but the very first conditional factor to this level
for j := 1 to pred(LiftTerm.CondFactorCount) do
Self.AddCondFactor(TffSqlCondFactor.Create(Self)).
Assign(LiftTerm.CondFactor[j]);
//then copy the contents of the first conditional factor
// (possibly the only one) into this one
B := UnaryNot; // save UnaryNot setting
LiftFactor := TffSqlCondFactor.Create(Self);
LiftFactor.Assign(LiftTerm.CondFactor[0]);
Clear;
Assign(LiftFactor);
LiftFactor.Free;
UnaryNot := UnaryNot xor B;
Result := True;
{Get out. We may have more to do here, but Global Logic will
call us again, and there may be other transformations that can
be applied first.}
break;
end;
if Reduce then begin
{factor itself was reduced}
Result := True;
break;
end;
end;
end;
{!!.11 begin}
if not Result then
for i := 0 to pred(CondFactorCount) do
if CondFactor[i].Reduce then begin
Result := True;
break;
end;
{!!.11 end}
end;
procedure TffSqlCondTerm.ResetConstant;
begin
FIsConstantChecked := False;
FIsConstant := False;
end;
procedure TffSqlCondTerm.SetCondFactor(Index: Integer;
const Value: TffSqlCondFactor);
begin
CondFactorList[Index] := Value;
end;
{====================================================================}
{===TffSqlGroupColumnList=================================================}
function TffSqlGroupColumnList.AddColumn(Column: TffSqlGroupColumn):
TffSqlGroupColumn;
begin
ColumnList.Add(Column);
Result := Column;
end;
{--------}
procedure TffSqlGroupColumnList.Assign(const Source: TffSqlNode);
var
i : Integer;
begin
if Source is TffSqlGroupColumnList then begin
Clear;
for i := 0 to pred(TffSqlGroupColumnList(Source).ColumnCount) do
AddColumn(TffSqlGroupColumn.Create(Self)).Assign(
TffSqlGroupColumnList(Source).Column[i]);
end else
AssignError(Source);
end;
{--------}
function TffSqlGroupColumnList.Contains(const aColName : string;
Se: TffSqlSelection): Boolean;
{Rewritten !!.06}
var
i : Integer;
aGrpColText,
aSelText : string;
begin
if Assigned(Se.SimpleExpression.Term[0].Factor[0].FieldRef) then
aSelText := Trim(Se.SimpleExpression.Term[0].Factor[0].FieldRef.QualName)
else
aSelText := Trim(Se.SQLText);
for i := 0 to pred(ColumnCount) do begin
aGrpColText := Trim(Column[i].QualColumnName);
Result := (AnsiCompareText(aColName, aGrpColText) = 0) or
(AnsiCompareText(aSelText, aGrpColText) = 0);
if Result then
Exit;
end; { for }
Result := False;
end;
{--------}
constructor TffSqlGroupColumnList.Create(AParent: TffSqlNode);
begin
inherited Create(AParent);
ColumnList := TList.Create;
end;
{--------}
procedure TffSqlGroupColumnList.Clear;
var
i : Integer;
begin
for i := 0 to pred(ColumnCount) do
Column[i].Free;
ColumnList.Clear;
end;
{--------}
destructor TffSqlGroupColumnList.Destroy;
begin
Clear;
ColumnList.Free;
inherited;
end;
{--------}
procedure TffSqlGroupColumnList.EmitSQL(Stream: TStream);
var
i: Integer;
begin
Column[0].EmitSQL(Stream);
for i := 1 to pred(ColumnCount) do begin
WriteStr(Stream,', ');
Column[i].EmitSQL(Stream);
end;
end;
{--------}
procedure TffSqlGroupColumnList.EnumNodes(EnumMethod: TffSqlEnumMethod;
const Deep: Boolean);
var
i : Integer;
begin
EnumMethod(Self);
for i := 0 to pred(ColumnCount) do
Column[i].EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlGroupColumnList.Equals(Other: TffSqlNode): Boolean;
var
i : Integer;
begin
Result := False;
if Other is TffSqlGroupColumnList then begin
if ColumnCount <> TffSqlGroupColumnList(Other).ColumnCount then
exit;
for i := 0 to pred(ColumnCount) do
if not Column[i].Equals(TffSqlGroupColumnList(Other).Column[i]) then
exit;
Result := True;
end;
end;
{--------}
function TffSqlGroupColumnList.GetColumn(Index: Integer): TffSqlGroupColumn;
begin
Result := TffSqlGroupColumn(ColumnList[Index]);
end;
{--------}
function TffSqlGroupColumnList.GetColumnCount: Integer;
begin
Result := ColumnList.Count;
end;
{--------}
function TffSqlGroupColumnList.Reduce: Boolean;
begin
Result := False;
end;
procedure TffSqlGroupColumnList.SetColumn(Index: Integer;
const Value: TffSqlGroupColumn);
begin
ColumnList[Index] := VAlue;
end;
{====================================================================}
{===TffSqlTableRefList===============================================}
function TffSqlTableRefList.AddTableRef(
NewTableRef: TffSqlTableRef): TffSqlTableRef;
begin
FTableRefList.Add(NewTableRef);
Result := NewTableRef;
end;
{--------}
procedure TffSqlTableRefList.Assign(const Source: TffSqlNode);
var
i: Integer;
begin
if Source is TffSqlTableRefList then begin
Clear;
for i := 0 to pred(TffSqlTableRefList(Source).TableRefCount) do
AddTableRef(TffSqlTableRef.Create(Self)).Assign(
TffSqlTableRefList(Source).TableRef[i]);
end else
AssignError(Source);
end;
constructor TffSqlTableRefList.Create(AParent: TffSqlNode);
begin
inherited Create(AParent);
FTableRefList := TList.Create;
end;
{--------}
function TffSqlTableRefList.BindFieldDown(const TableName,
FieldName: string): TFFSqlFieldProxy;
var
i : Integer;
begin
Result := nil;
for i := 0 to pred(TableRefCount) do begin
Result := TableRef[i].BindFieldDown(TableName, FieldName);
if Result <> nil then
exit;
end;
end;
function TffSqlTableRefList.BindTable(AOwner: TObject;
const TableName: string): TFFSqlTableProxy;
var
i : Integer;
begin
Result := nil;
for i := 0 to pred(TableRefCount) do begin
Result := TableRef[i].BindTable(AOwner, TableName);
if Result <> nil then
exit;
end;
end;
procedure TffSqlTableRefList.Clear;
var
i : Integer;
begin
for i := 0 to pred(TableRefCount) do
TableRef[i].Free;
FTableRefList.Clear;
inherited;
end;
{--------}
destructor TffSqlTableRefList.Destroy;
begin
Clear;
FTableRefList.Free;
inherited;
end;
{--------}
procedure TffSqlTableRefList.EmitSQL(Stream: TStream);
var
i : Integer;
begin
if TableRefCount > 0 then begin
TableRef[0].EmitSQL(Stream);
for i := 1 to pred(TableRefCount) do begin
WriteStr(Stream,' ,');
TableRef[i].EmitSQL(Stream);
end;
end;
end;
{--------}
procedure TffSqlTableRefList.EnumNodes(EnumMethod: TffSqlEnumMethod;
const Deep: Boolean);
var
i : Integer;
begin
EnumMethod(Self);
for i := 0 to pred(TableRefCount) do
TableRef[i].EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlTableRefList.Equals(Other: TffSqlNode): Boolean;
var
i : Integer;
begin
Result := False;
if Other is TffSqlTableRefList then begin
if TableRefCount <> TffSqlTableRefList(Other).TableRefCount then
exit;
for i := 0 to pred(TableRefCount) do
if not TableRef[i].Equals(TffSqlTableRefList(Other).TableRef[i]) then
exit;
Result := True;
end;
end;
{--------}
{!!.11 new}
function TffSqlTableRefList.GetFieldsFromTable(const TableName: string;
List: TList): TffSqlTableProxy;
{-returns fields from table that are ultimately coming from the table
specified in the TableName argument. NIL if not found.}
var
i, j: Integer;
begin
Result := nil; {!!.11}
for i := 0 to TableRefCount - 1 do
if SameText(TableRef[i].Alias, TableName)
or SameText(TableRef[i].TableName, TableName) then begin
Result := TableRef[i].ResultTable;
for j := 0 to Result.FieldCount - 1 do
List.Add(Result.Field(j));
exit;
end;
{still here, which means that if there's a match, it's in a nested table}
for i := 0 to TableRefCount - 1 do begin
if TableRef[i].TableExp <> nil then {!!.11}
Result := TableRef[i].TableExp.GetFieldsFromTable(TableName, List);
if Result <> nil then
exit;
end;
// Result := nil; {Deleted !!.11}
end;
{--------}
function TffSqlTableRefList.GetNameForAlias(const Alias : string) : string;
var
Inx : Integer;
begin
Result := '';
for Inx := 0 to Pred(FTableRefList.Count) do begin
if TffSqlTableRef(FTableRefList[Inx]).Alias = Alias then begin
Result := TffSqlTableRef(FTableRefList[Inx]).TableName;
Break;
end;
end;
end;
{--------}
function TffSqlTableRefList.GetTableRef(
Index: Integer): TffSqlTableRef;
begin
Result := TffSqlTableRef(FTableRefList[Index]);
end;
{--------}
function TffSqlTableRefList.GetTableRefCount: Integer;
begin
Result := FTableRefList.Count;
end;
{--------}
{!!.11 rewritten}
function TffSqlTableRefList.Reduce: Boolean;
var
i: Integer;
begin
for i := 0 to TableRefCount - 1 do
if TableRef[i].Reduce then begin
Result := True;
exit;
end;
Result := False;
end;
procedure TffSqlTableRefList.SetTableRef(Index: Integer;
const Value: TffSqlTableRef);
begin
FTableRefList[Index] := Value;
end;
{====================================================================}
{===TffSqlStatement==================================================}
procedure TffSqlStatement.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlStatement then begin
Clear;
if TffSqlStatement(Source).Insert <> nil then begin
Insert := TffSqlINSERT.Create(Self);
Insert.Assign(TffSqlStatement(Source).Insert);
end;
if TffSqlStatement(Source).Update <> nil then begin
Update := TffSqlUPDATE.Create(Self);
Update.Assign(TffSqlStatement(Source).Update);
end;
if TffSqlStatement(Source).Delete <> nil then begin
Delete := TffSqlDELETE.Create(Self);
Delete.Assign(TffSqlStatement(Source).Delete);
end;
if TffSqlStatement(Source).TableExp <> nil then begin
TableExp := TffSqlTableExp.Create(Self);
TableExp.Assign(TffSqlStatement(Source).TableExp);
end;
Reduce := TffSqlStatement(Source).Reduce;
UseIndex := TffSqlStatement(Source).UseIndex;
end else
AssignError(Source);
end;
{Begin !!.11}
{--------}
procedure TffSqlStatement.Bind(const ClientID: TffClientID;
const SessionID: TffSessionID;
Database : TffSqlDatabaseProxy);
begin
FClientID := ClientID;
FSessionID := SessionID;
FDatabase := Database;
if assigned(Insert) then
Insert.Bind
else if assigned(Update) then
Update.Bind
else if assigned(Delete) then
Delete.Bind;
end;
{--------}
{End !!.11}
procedure TffSqlStatement.Clear;
begin
Insert.Free;
Insert := nil;
Update.Free;
Update := nil;
Delete.Free;
Delete := nil;
TableExp.Free;
TableExp := nil;
end;
{--------}
constructor TffSqlStatement.Create;
begin
inherited Create(nil);
{$IFDEF ExposeLastStatement}
LastStatement := Self; {debug hook}
{$ENDIF}
end;
{--------}
destructor TffSqlStatement.Destroy;
begin
ParmList.Free;
Clear;
inherited;
{$IFDEF ExposeLastStatement}
LastStatement := nil; {debug hook}
{$ENDIF}
end;
{--------}
procedure TffSqlStatement.EmitSQL(Stream: TStream);
begin
if not UseIndex then
WriteStr(Stream,'NOINDEX ');
if not Reduce then
WriteStr(Stream,'NOREDUCE ');
if assigned(Insert) then
Insert.EmitSQL(Stream);
if assigned(Update) then
Update.EmitSQL(Stream);
if assigned(Delete) then
Delete.EmitSQL(Stream);
if assigned(TableExp) then
TableExp.EmitSQL(Stream);
WriteStr(Stream,';');
WriteEOF(Stream);
end;
{--------}
procedure TffSqlStatement.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
EnumMethod(Self);
if assigned(Insert) then
Insert.EnumNodes(EnumMethod, Deep);
if assigned(Update) then
Update.EnumNodes(EnumMethod, Deep);
if assigned(Delete) then
Delete.EnumNodes(EnumMethod, Deep);
if assigned(TableExp) then
TableExp.EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlStatement.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlStatement)
and ((BothNil(Insert, TffSqlStatement(Other).Insert)
or (BothNonNil(Insert, TffSqlStatement(Other).Insert)
and Insert.Equals(TffSqlStatement(Other).Insert))))
and ((BothNil(Update, TffSqlStatement(Other).Update)
or (BothNonNil(Update, TffSqlStatement(Other).Update)
and Update.Equals(TffSqlStatement(Other).Update))))
and ((BothNil(Delete, TffSqlStatement(Other).Delete)
or (BothNonNil(Delete, TffSqlStatement(Other).Delete)
and Delete.Equals(TffSqlStatement(Other).Delete))))
and ((BothNil(TableExp, TffSqlStatement(Other).TableExp)
or (BothNonNil(TableExp, TffSqlStatement(Other).TableExp)
and TableExp.Equals(TffSqlStatement(Other).TableExp))));
end;
{--------}
{Begin !!.11}
function TffSqlStatement.Execute(var aLiveResult: Boolean;
var aCursorID: TffCursorID;
var RowsAffected,
aRecordsRead: integer) : TffResult;
{End !!.11}
begin
Result := DBIERR_NONE; {!!.11}
StartDate := Date;
StartTime := Time;
StartDateTime := Now;
aCursorID := 0;
RecordsRead := 0;
if assigned(TableExp) then
TableExp.Execute(aLiveResult, aCursorID, RecordsRead)
{Begin !!.11}
else if assigned(Insert) then
Result := Insert.Execute(RowsAffected)
else if assigned(Update) then
Result := Update.Execute(RowsAffected)
else if assigned(Delete) then
Result := Delete.Execute(RowsAffected)
else
raise Exception.Create('Statement is empty');
{End !!.11}
aRecordsRead := RecordsRead;
end;
{-------}
procedure TffSqlStatement.ReduceStrength;
begin
{$IFDEF LogTransformations}
AssignFile(TRLog, TRLogFile);
{$I-}
Append(TRLog);
if IOResult <> 0 then
Rewrite(TRLog);
writeln(TRLog);
writeln(TRLog, 'Transforming ' + SQLText);
writeln(TRLog, 'started at :',DateTimeToStr(Now));
{$ENDIF}
if assigned(TableExp) then begin
while TableExp.Reduce do begin
{$IFDEF LogTransformations}
writeln(TRLog, 'new form:' + SQLText);
{$ENDIF}
end;
end else
{!!.11 begin}
if assigned(Insert) then begin
while Insert.Reduce do begin
{$IFDEF LogTransformations}
writeln(TRLog, 'new form:' + SQLText);
{$ENDIF}
end;
end
else
if assigned(Update) then begin
while Update.Reduce do begin
{$IFDEF LogTransformations}
writeln(TRLog, 'new form:' + SQLText);
{$ENDIF}
end;
end else
if assigned(Delete) then begin
while Delete.Reduce do begin
{$IFDEF LogTransformations}
writeln(TRLog, 'new form:' + SQLText);
{$ENDIF}
end;
end;
{!!.11 end}
{$IFDEF LogTransformations}
writeln(TRLog);
writeln(TRLog, 'ended at :',DateTimeToStr(Now));
CloseFile(TRLog);
{$ENDIF}
end;
procedure TffSqlStatement.SetParameter(Index: Integer; Value: Variant);
begin
if ParmCount = 0 then
raise Exception.Create('Error: Attempt to set parameter on non-parameterized query');
if ParmList = nil then
ParmList := TFFVariantList.Create(ParmCount);
ParmList.SetValue(Index, Value);
end;
{====================================================================}
{===TffSqlSelect=====================================================}
{--------}
procedure TffSqlSELECT.AddTableRefs(Node: TffSqlNode);
begin
Node.AddTableReference(Self);
end;
{--------}
procedure TffSqlSELECT.AddColumns(Node: TffSqlNode);
begin
Node.AddColumnDef(Self);
end;
{--------}
procedure TffSqlSELECT.ClearBindings(Node: TffSqlNode);
begin
Node.ClearBinding;
end;
{--------}
function TffSqlSELECT.Reduce: Boolean;
begin
if SelectionList <> nil then
Result := SelectionList.Reduce
else
Result := False;
Result := Result or TableRefList.Reduce;
if CondExpWhere <> nil then
Result := Result or CondExpWhere.Reduce;
if GroupColumnList <> nil then
Result := Result or GroupColumnList.Reduce;
if CondExpHaving <> nil then
Result := Result or CondExpHaving.Reduce;
if OrderList <> nil then
Result := Result or OrderList.Reduce;
end;
{--------}
procedure TffSqlSELECT.ResetIsConstant(Node: TffSqlNode);
begin
Node.ResetConstant;
end;
{--------}
procedure TffSqlSELECT.EmitSQL(Stream: TStream);
begin
WriteStr(Stream, 'SELECT');
if Distinct then
WriteStr(Stream, ' DISTINCT')
else
WriteStr(Stream, ' ALL');
if (SelectionList = nil) or WasStar then
WriteStr(Stream, ' *')
else
SelectionList.EmitSQL(Stream);
WriteStr(Stream, ' FROM');
TableRefList.EmitSQL(Stream);
if CondExpWhere <> nil then begin
WriteStr(Stream,' WHERE');
CondExpWhere.EmitSQL(Stream);
end;
if GroupColumnList <> nil then begin
WriteStr(Stream,' GROUP BY');
GroupColumnList.EmitSQL(Stream);
end;
if CondExpHaving <> nil then begin
WriteStr(Stream,' HAVING');
CondExpHaving.EmitSQL(Stream);
end;
if OrderList <> nil then
OrderList.EmitSQL(Stream);
end;
{--------}
procedure TffSqlSELECT.AddTableFields(Table : TffSqlTableProxy;
const StartPoint : Integer;
FieldRef : TffSqlFieldRef);
var
Factor : TFFSqlFactor;
j : Integer;
Selection : TFFSqlSelection;
StartVal : Integer;
Term : TFFSqlTerm;
begin
Assert(Table <> nil);
Assert(Table is TffSqlTableProxy);
if Table.FieldCount > 0 then begin
StartVal := Pred(Table.FieldCount);
{ If passed a field reference then replace its field name with the
first field of the table. }
if FieldRef <> nil then begin
FieldRef.WasWildcard := True;
FieldRef.FieldName := Table.Field(StartVal).Name;
dec(StartVal);
end;
for j := StartVal downto 0 do begin
Selection := TffSqlSelection.Create(SelectionList);
Selection.SimpleExpression :=
TffSqlSimpleExpression.Create(Selection);
Term := TFFSqlTerm.Create(Selection.SimpleExpression);
Factor := TFFSqlFactor.Create(Term);
Factor.FieldRef := TffSqlFieldRef.Create(Factor);
if Table.Alias <> '' then {!!.12}
Factor.FieldRef.TableName := Table.Alias {!!.12}
else {!!.12}
Factor.FieldRef.TableName := Table.Name;
Factor.FieldRef.FieldName := Table.Field(j).Name;
Term.AddFactor(Factor);
Selection.AddedByWildcard := True;
Selection.SimpleExpression.AddTerm(Term);
SelectionList.InsertSelection(StartPoint, Selection);
end;
end;
end;
{--------}
procedure TffSqlSELECT.AddTableFieldsFromList(Table : TffSqlTableProxy;
const StartPoint : Integer;
FieldRef : TffSqlFieldRef;
List: TList);
var
Factor : TFFSqlFactor;
j : Integer;
Selection : TFFSqlSelection;
StartVal : Integer;
Term : TFFSqlTerm;
begin
Assert(Table <> nil);
Assert(Table is TffSqlTableProxy);
if Table.FieldCount > 0 then begin
StartVal := Pred(List.Count);
{ If passed a field reference then replace its field name with the
first field of the table. }
if FieldRef <> nil then begin
FieldRef.WasWildcard := True;
FieldRef.FieldName := TffSqlFieldProxy(List[StartVal]).Name;
dec(StartVal);
end;
for j := StartVal downto 0 do begin
Selection := TffSqlSelection.Create(SelectionList);
Selection.SimpleExpression :=
TffSqlSimpleExpression.Create(Selection);
Term := TFFSqlTerm.Create(Selection.SimpleExpression);
Factor := TFFSqlFactor.Create(Term);
Factor.FieldRef := TffSqlFieldRef.Create(Factor);
Factor.FieldRef.TableName := Table.Name;
Factor.FieldRef.FieldName := TffSqlFieldProxy(List[j]).Name;
Term.AddFactor(Factor);
Selection.AddedByWildcard := True;
Selection.SimpleExpression.AddTerm(Term);
SelectionList.InsertSelection(StartPoint, Selection);
end;
end;
end;
{--------}
procedure TffSqlSELECT.ExpandWildcards;
var
i, j, ix : Integer;
T : TffSqlTableProxy;
Simp : TFFSqlSimpleExpression;
FR : TffSqlFieldRef;
List: TList; {!!.11}
begin
if SelectionList = nil then begin
{ If the selectionlist is empty then only a wildcard was specified.
Note that with the fix of issue 481, this is dead code. }
WasStar := True;
SelectionList := TffSqlSelectionList.Create(Self);
Assert(Assigned(TablesReferencedByOrder));
for i := Pred(TablesReferencedByOrder.Count) downto 0 do begin
T := TffSqlTableProxy(TablesReferencedByOrder.Objects[i]);
AddTableFields(T, 0, nil);
end;
end else begin
for i := pred(SelectionList.SelectionCount) downto 0 do begin
Simp := SelectionList.Selection[i].SimpleExpression;
if Simp <> nil then begin
FR := Simp.Term[0].Factor[0].FieldRef;
if FR <> nil then begin
if FR.FieldName = '' then begin
Assert(Assigned(TablesReferencedByOrder));
{ If no table name specified then add fields from all tables
referenced in the FROM clause. }
if FR.TableName = '' then begin
Assert(Assigned(TablesReferencedByOrder));
for j := pred(TablesReferencedByOrder.Count) downto 0 do begin
T := TffSqlTableProxy(TablesReferencedByOrder.Objects[j]);
if j = 0 then
AddTableFields(T, i, FR)
else
AddTableFields(T, i, nil);
end;
end
else begin
{ Otherwise the wildcard was qualified with a tablename. }
ix := TablesReferencedByOrder.IndexOf(FR.TableName);
if ix = -1 then begin
Assert(Assigned(TableAliases));
with TableAliases do begin
ix := IndexOf(FR.TableName);
if ix <> -1 then
ix := Integer(Objects[ix])
else begin
{!!.11 begin}
{might be part of a nested table expression}
List := TList.Create;
try
T := TableRefList.GetFieldsFromTable(FR.TableName, List);
if T <> nil then begin
AddTableFieldsFromList(T, i, FR, List);
ix := -1;
end else
{!!.11 end}
SQLError('Unknown table: ' + FR.TableName);
finally {!!.11}
List.Free; {!!.11}
end; {!!.11}
end;
end;
end;
if ix <> -1 then begin {!!.11}
T := TffSqlTableProxy(TablesReferencedByOrder.Objects[ix]);
AddTableFields(T, i, FR);
end; {!!.11}
end;
end;
end;
end;
end;
end;
end;
{--------}
procedure TffSqlSELECT.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
if Deep then begin
EnumMethod(Self);
if SelectionList <> nil then
SelectionList.EnumNodes(EnumMethod, Deep);
TableRefList.EnumNodes(EnumMethod, Deep);
if CondExpWhere <> nil then
CondExpWhere.EnumNodes(EnumMethod, Deep);
if GroupColumnList <> nil then
GroupColumnList.EnumNodes(EnumMethod, Deep);
if CondExpHaving <> nil then
CondExpHaving.EnumNodes(EnumMethod, Deep);
if OrderList <> nil then
OrderList.EnumNodes(EnumMethod, Deep);
end;
end;
{--------}
{!!.12 debug code
procedure TffSqlSELECT.CheckTableList;
var
i : Integer;
begin
if TablesReferencedByOrder <> nil then begin
for i := 0 to pred(TablesReferencedByOrder.Count) do
if pos('$$UNNAMED', TablesReferencedByOrder[i]) = 0 then
if assigned(TablesReferencedByOrder.Objects[i]) then
if not (TObject(TablesReferencedByOrder.Objects[i]) is TffSqlTableProxy) then
raise Exception.Create('Table list broken');
end;
end;
}
procedure TffSqlSELECT.ClearTableList;
var
i : Integer;
begin
{CheckTableList;} {!!.12 debug code}
if TablesReferencedByOrder <> nil then begin
for i := 0 to pred(TablesReferencedByOrder.Count) do
if assigned(TablesReferencedByOrder.Objects[i]) then
if TffSqlTableProxy(TablesReferencedByOrder.Objects[i]).Owner = Self then begin {!!.10}
TffSqlTableProxy(TablesReferencedByOrder.Objects[i]).Owner := nil; {!!.10}
TObject(TablesReferencedByOrder.Objects[i]).Free;
end; {!!.10}
TablesReferencedByOrder.Clear;
end;
if TableAliases <> nil then
TableAliases.Clear;
Bound := False;
end;
{--------}
procedure TffSqlSELECT.Bind;
var
i, j : Integer;
T : TffSqlTableProxy;
Alias: string; {!!.11}
begin
if CondExpWhere <> nil then
CondExpWhere.EnumNodes(ClearBindings, False);
if CondExpHaving <> nil then
CondExpHaving.EnumNodes(ClearBindings, False);
ClearTableList;
TableRefList.EnumNodes(AddTableRefs, False);
Assert(Assigned(TablesReferencedByOrder));
for i := 0 to pred(TablesReferencedByOrder.Count) do begin
Assert(TablesReferencedByOrder[i] <> '');
if pos('$$UNNAMED', TablesReferencedByOrder[i]) <> 0 then
Assert(TablesReferencedByOrder.Objects[i] <> nil)
else begin
j := TableAliases.IndexOfObject(TObject(i));
if j = -1 then
Alias := ''
else
Alias := TableAliases[j];
T := Owner.FDatabase.TableByName(Self, TablesReferencedByOrder[i],
False, Alias); {!!.11}
if T = nil then
SQLError('Unable to open table: ' + TablesReferencedByOrder[i] +
'. Ensure the table exists and is not in use by ' +
'another process.');
TablesReferencedByOrder.Objects[i] := T;
end;
end;
ExpandWildcards;
if CondExpWhere <> nil then
CondExpWhere.MatchType(fftBoolean);
{build column list}
Assert(Assigned(Columns));
Columns.Clear;
SelectionList.EnumNodes(AddColumns, False);
{figure out if we're using aggregates}
{if we are, we need to prepare for those}
HaveAggregates := False;
SelectionList.EnumNodes(FlagAggregates, False);
{!!.11 begin}
if Distinct then begin
{ensure that all fields have a type we can compare}
Assert(Assigned(Columns));
for i := 0 to pred(Columns.Count) do begin
case TffSqlNode(Columns.Objects[i]).GetType of
fftBoolean..fftDateTime : ;
fftShortString..{fftShortAnsiStr}fftWideString : ; {!!.12}
else
SQLError('Field ' + Columns[i] + ' has a type, which is incompatible with DISTINCT');
end;
end;
end;
{!!.11 end}
Bound := True;
end;
{--------}
function TffSqlSELECT.BindField(const TableName,
FieldName: string): TFFSqlFieldProxy;
var
T: TFFSqlTableProxy;
j : Integer;
begin
Result := nil;
if TableName <> '' then begin
Assert(Assigned(TablesReferencedByOrder));
j := TablesReferencedByOrder.IndexOf(TableName);
if (j = -1)
{can't refer to aliased table with its actual name} {!!.12}
or (TffSqlTableProxy(TablesReferencedByOrder.Objects[j]).Alias <> '') {!!.12}
then begin
//may be an alias
Assert(Assigned(TableAliases));
with TableAliases do begin
j := IndexOf(TableName);
if j <> -1 then begin
j := Integer(Objects[j]);
T := TffSqlTableProxy(TablesReferencedByOrder.Objects[j]);
if T = nil then {!!.11}
SQLError('Invalid field reference:' + TableName + '.' + FieldName); {!!.11}
end else begin
//may be a field from an exclosed expression
if BindingDown then {!!.11}
Result := nil {!!.11}
else
try {!!.11}
BindingDown := True; {!!.11}
Result := TableRefList.BindFieldDown(TableName, FieldName); {!!.11}
finally {!!.11}
BindingDown := False; {!!.11}
end; {!!.11}
if Result = nil then
if IsSubQuery then begin
{may be field at outer level}
Result := Parent.BindField(TableName, FieldName);
IsDependent := True;
exit;
end;
{else
Result := TableRefList.BindFieldDown(TableName, FieldName);} {!!.11}
if Result = nil then
SQLError('Unknown field:' + TableName + '.' + FieldName);
exit;
end;
end;
end else begin
T := TffSqlTableProxy(TablesReferencedByOrder.Objects[j]);
Assert(T <> nil, 'Table not resolved:'
+ TffSqlTableProxy(TablesReferencedByOrder.Objects[j]).Name); {!!.11}
end;
Assert(T <> nil);
Result := T.FieldByName(FieldName);
if Result = nil then
SQLError('Unknown field:' + TableName + '.' + FieldName);
end else begin
Assert(Assigned(TablesReferencedByOrder));
for j := 0 to pred(TablesReferencedByOrder.Count) do begin
T := TffSqlTableProxy(TablesReferencedByOrder.Objects[j]);
Assert(T <> nil);
Assert(T is TffSqlTableProxy);
if T.FieldByName(FieldName) <> nil then begin
Result := T.FieldByName(FieldName);
Exit;
end;
end;
{ No binding found yet. See if this is an alias for a field in the
result table. }
if Joiner <> nil then
for j := 0 to Pred(Joiner.FT.Count) do begin
if AnsiCompareText(TFFSqlFieldProxy(Joiner.FT[j]).Name, FieldName) = 0 then begin
Result := Joiner.FT[j];
Exit;
end;
end;
SQLError('Unknown field:' + FieldName);
end;
end;
function TffSqlSELECT.BindTable(AOwner: TObject;
const TableName: string): TFFSqlTableProxy;
begin
Result := TableRefList.BindTable(AOwner, TableName);
end;
{--------}
function TffSqlSELECT.FindField(const FieldName: string): TFFSqlFieldProxy;
var
P : Integer;
begin
P := PosCh('.', FieldName);
if P = 0 then
Result := BindField('', FieldName)
else
Result := BindField(copy(FieldName, 1, P - 1), copy(FieldName, P + 1, MaxInt));
end;
{--------}
procedure TffSqlSELECT.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlSELECT then begin
Clear;
Distinct := TffSqlSELECT(Source).Distinct;
if TffSqlSELECT(Source).SelectionList <> nil then begin
SelectionList := TffSqlSelectionList.Create(Self);
SelectionList.Assign(TffSqlSELECT(Source).SelectionList);
end;
TableRefList := TffSqlTableRefList.Create(Self);
TableRefList.Assign(TffSqlSELECT(Source).TableRefList);
if TffSqlSELECT(Source).CondExpWhere <> nil then begin
CondExpWhere := TffSqlCondExp.Create(Self);
CondExpWhere.Assign(TffSqlSELECT(Source).CondExpWhere);
end;
if TffSqlSELECT(Source).GroupColumnList <> nil then begin
GroupColumnList := TffSqlGroupColumnList.Create(Self);
GroupColumnList.Assign(TffSqlSELECT(Source).GroupColumnList);
end;
if TffSqlSELECT(Source).CondExpHaving <> nil then begin
CondExpHaving := TffSqlCondExp.Create(Self);
CondExpHaving.Assign(TffSqlSELECT(Source).CondExpHaving);
end;
if TffSqlSELECT(Source).OrderList <> nil then begin
OrderList := TffSqlOrderList.Create(Self);
OrderList.Assign(TffSqlSELECT(Source).OrderList);
end;
end else
AssignError(Source);
end;
{--------}
constructor TffSqlSELECT.Create(AParent: TffSqlNode);
begin
inherited Create(AParent);
TablesReferencedByOrder := TStringList.Create;
TableAliases := TStringList.Create;
TableAliases.Sorted := True;
TableAliases.Duplicates := dupError;
AggQueryMode := aqmIdle;
end;
{--------}
procedure TffSqlSELECT.Clear;
begin
ClearTableList;
FSelectionList.Free;
FSelectionList:= nil;
FTableRefList.Free;
FTableRefList:= nil;
FCondExpWhere.Free;
FCondExpWhere:= nil;
FGroupColumnList.Free;
FGroupColumnList:= nil;
FCondExpHaving.Free;
FCondExpHaving:= nil;
FOrderList.Free;
FOrderList:= nil;
end;
{--------}
function TffSqlSELECT.DependsOn(Table: TFFSqlTableProxy): Boolean;
begin
if not Bound then
Bind;
Result :=
((CondExpWhere <> nil) and CondExpWhere.DependsOn(Table))
or ((CondExpHaving <> nil) and CondExpHaving.DependsOn(Table));
end;
{--------}
destructor TffSqlSELECT.Destroy;
begin
if FResultTable <> nil then begin
FResultTable.Owner := nil;
FResultTable.Free;
end;
Clear;
TableAliases.Free;
TablesReferencedByOrder.Free;
Joiner.Free;
inherited;
end;
{--------}
procedure TffSqlSELECT.FlagAggregates(Node: TffSqlNode);
begin
Node.FlagAggregate(Self);
end;
{--------}
procedure TffSqlSELECT.EnumAggregates(Node: TffSqlNode);
begin
Node.AddAggregate(AggList);
end;
{--------}
function TffSqlSELECT.TargetFieldFromSourceField(
const F: TffSqlFieldProxy): TffSqlFieldProxy;
var
i: Integer;
begin
for i := 0 to pred(Columns.Count) do
if Columns.Objects[i] = F then begin
Result := ResultTable.Field(i);
exit;
end;
Result := nil;
end;
{ TAggCounter }
function TAggCounter.GetAvg: Variant;
begin
if FCount <> 0 then
Result := FSum / FCount
else
Result := Null;
end;
function TAggCounter.GetMax: Variant;
begin
if FCount <> 0 then
Result := FMax
else
Result := Null;
end;
function TAggCounter.GetMin: Variant;
begin
if FCount <> 0 then
Result := FMin
else
Result := Null;
end;
function TAggCounter.GetSum: Variant;
begin
if FCount <> 0 then
Result := FSum
else
Result := Null;
end;
procedure TAggCounter.Reset;
begin
FCount := 0;
end;
const
NumericVarTypes : set of Byte =
[varSmallint, varInteger, varSingle,
{$IFDEF DCC6OrLater}
varShortInt,
{$ENDIF}
varDouble, varCurrency, varByte];
procedure TAggCounter.Add(const Value: Variant);
begin
if FCount = 0 then begin
FMin := Value;
FMax := Value;
if (VarType(Value) and VarTypeMask) in NumericVarTypes then
FSum := Value;
end else begin
if Value < FMin then
FMin := Value;
if Value > FMax then
FMax := Value;
if (VarType(Value) and VarTypeMask) in NumericVarTypes then
FSum := FSum + Value;
end;
FCount := FCount + 1;
end;
procedure TffSqlSELECT.EnsureResultTable(NeedData: Boolean);
begin
Assert(TObject(Self) is TffSqlSELECT);
if IsDependent or (NeedData and not HaveData) then begin
if FResultTable <> nil then begin
Assert(TObject(FResultTable) is TffSqlTableProxy);
Assert(FResultTable.Owner = Self);
FResultTable.Owner := nil;
FResultTable.Free;
FResultTable := nil;
end;
end;
if FResultTable = nil then begin
FResultTable := Execute2(NeedData);
HaveData := NeedData;
end;
end;
function TffSqlSELECT.CheckForValue(Value: Variant): Boolean;
begin
EnsureResultTable(True);
if VarIsNull(Value) then
Result := False
else begin
ResultTable.SetRange([Value], [Value], 1, 1, True, True, True);
Result := ResultTable.First;
end;
end;
function TffSqlSELECT.CheckAllValues(RelOp: TffSqlRelOp;
const Val: Variant): Boolean;
var
TestVal: Variant;
begin
EnsureResultTable(True);
Result := False;
if VarIsNull(Val) then exit;
if ResultTable.First then begin
repeat
TestVal := ResultTable.Field(0).GetValue;
if VarIsNull(TestVal) then exit;
case RelOp of
roEQ :
if TestVal <> Val then
exit;
roLE :
if Val > TestVal then
exit;
roL :
if Val >= TestVal then
exit;
roG :
if Val <= TestVal then
exit;
roGE :
if Val < TestVal then
exit;
roNE :
if TestVal = Val then
exit;
end;
until not ResultTable.Next;
Result := True;
end;
end;
function TffSqlSELECT.CheckAnyValue(RelOp: TffSqlRelOp;
const Val: Variant): Boolean;
begin
EnsureResultTable(True);
Result := True;
if ResultTable.First then
repeat
case RelOp of
roEQ :
if ResultTable.Field(0).GetValue = Val then
exit;
roLE :
if Val <= ResultTable.Field(0).GetValue then
exit;
roL :
if Val < ResultTable.Field(0).GetValue then
exit;
roG :
if Val > ResultTable.Field(0).GetValue then
exit;
roGE :
if Val >= ResultTable.Field(0).GetValue then
exit;
roNE :
if ResultTable.Field(0).GetValue <> Val then
exit;
end;
until not ResultTable.Next;
Result := False;
end;
function TffSqlSELECT.CheckNonEmpty: Boolean;
begin
EnsureResultTable(True);
Result := FResultTable.First;
end;
function TffSqlSELECT.GetDecimals: Integer;
begin
if not TypeKnown then begin
EnsureResultTable(False);
FDecimals := FResultTable.Field(0).GetDecimals;
FType := FResultTable.Field(0).GetType;
FSize := FResultTable.Field(0).GetSize; {!!.13}
TypeKnown := True;
end;
Result := FDecimals;
end;
{!!.13 new}
function TffSqlSELECT.GetSize: Integer;
begin
if not TypeKnown then begin
EnsureResultTable(False);
FDecimals := FResultTable.Field(0).GetDecimals;
FType := FResultTable.Field(0).GetType;
FSize := FResultTable.Field(0).GetSize;
TypeKnown := True;
end;
Result := FSize;
end;
function TffSqlSELECT.GetType: TffFieldType;
begin
if not TypeKnown then begin
EnsureResultTable(False);
FDecimals := FResultTable.Field(0).GetDecimals;
FType := FResultTable.Field(0).GetType;
FSize := FResultTable.Field(0).GetSize; {!!.13}
TypeKnown := True;
end;
Result := FType;
end;
function TffSqlSELECT.GetValue: Variant;
begin
EnsureResultTable(True);
if ResultTable.First then
Result := ResultTable.Field(0).GetValue
else
Result := Null;
end;
procedure TffSqlSELECT.BuildSortList(Table: TffSqlTableProxy; var SortList: TffSqlSortArray);
{-logic extracted from DoOrderBy}
var
i, z, k: Integer;
IX : Integer;
s: string;
FR : TffSqlFieldRef;
AliasName: string;
begin
for i := 0 to pred(OrderList.OrderCount) do begin
if OrderList.OrderItem[i].Column <> nil then begin
s := OrderList.OrderItem[i].Column.QualColumnName;
Assert(Assigned(Columns));
z := Columns.IndexOf(S);
if z = -1 then begin
z := PosCh('.', S);
if z = 0 then begin
S := '.' + S;
// may be unqualified field but qualified columns
z := -1;
for k := 0 to pred(Columns.Count) do
if posI(S, Columns[k]) <> 0 then begin
z := k;
break;
end;
if z = -1 then begin
SQLError('Unknown column specified in ORDER BY clause: ' +
Copy(S, 2, Length(S) - 1));
end;
end else begin
// Try to find qualified column
z := -1;
{S := Uppercase(S);} {!!.10}
Assert(Assigned(Columns));
for k := 0 to pred(Columns.Count) do begin
FR := (Columns.Objects[k] as TffSQLSimpleExpression).Term[0].Factor[0].FieldRef;
if Assigned(FR) and
SameText(S, Trim(FR.SQLText)) then begin
z := k;
break;
end;
end;
if z = -1 then begin
//Table might be aliased. Replace alias with corresponding name.
z := PosCh('.', S);
AliasName := UpperCase(Copy(s, 1, z-1));
Assert(Assigned(TableAliases));
IX := TableAliases.IndexOf(AliasName);
if IX <> -1 then begin
IX := Integer(TableAliases.Objects[IX]);
Assert(Assigned(TablesReferencedByOrder));
S := TablesReferencedByOrder[IX] + '.' +
UpperCase(Copy(S, Z+1, MaxInt));
//Repeat search for field
z := -1;
Assert(Assigned(Columns));
for k := 0 to Pred(Columns.Count) do begin
FR := (Columns.Objects[K] as TffSQLSimpleExpression).Term[0].Factor[0].FieldRef;
if Assigned(FR) and
SameText(S, Trim(FR.SQLText))
then begin
z := k;
break;
end;
end;
end else
z := -1;
end;
if z = -1 then begin
// may be qualified field but unqualified columns
z := PosCh('.', S);
S := copy(S, z + 1, MaxInt);
z := -1;
Assert(Assigned(Columns));
for k := 0 to pred(Columns.Count) do
if posI(S, Columns[k]) <> 0 then begin
z := k;
break;
end;
if z = -1 then
SQLError('Unknown column specified in ORDER BY clause:'+S);
end;
end;
end;
Assert(Assigned(Columns));
SortList[i] := Table.FieldByName(Columns[z]).Index + 1;
end else begin
z := StrToInt(OrderList.OrderItem[i].Index);
SortList[i] := Table.FieldByName(Columns[z - 1]).Index + 1;
end;
if OrderList.OrderItem[i].Descending then
SortList[i] := -SortList[i];
end;
end;
procedure TffSqlSELECT.DoOrderBy;
var
SortList: TffSqlSortArray;
Status : TffResult;
begin
if (OrderList <> nil) and NeedData then begin
BuildSortList(Table, SortList); {!!.11}
Status := Table.Sort(OrderList.OrderCount, SortList, False); {!!.13}
if Status <> DBIERR_NONE then
raise EffException.CreateNoData(ffStrResServer, Status);
end;
end;
function TffSqlSELECT.NormalQueryResult(NeedData: Boolean): TffSqlTableProxy;
var
i : Integer;
N : TffSqlNode;
T2 : TffSqlTableProxy;
F : TffSqlFieldProxy;
FieldDefList: TffSqlFieldDefList;
begin
{build a normal answer table}
{build field definition for answer table}
FieldDefList := TffSqlFieldDefList.Create;
try
Assert(Assigned(Columns));
for i := 0 to pred(Columns.Count) do begin
N := TffSqlNode(Columns.Objects[i]);
FieldDefList.AddField(Columns[i], N.GetType, N.GetSize, N.GetDecimals);
end;
Result := Owner.FDatabase.CreateTemporaryTableWithoutIndex(Self,
FieldDefList);
finally
FieldDefList.Free;
end;
try
if Joiner = nil then begin
Joiner := TffSqlJoiner.Create(Owner, CondExpWhere);
Assert(Assigned(TablesReferencedByOrder));
for i := 0 to pred(TablesReferencedByOrder.Count) do
Joiner.Sources.Add(
TFFSqlTableProxySubset.Create(
TFFSqlTableProxy(TablesReferencedByOrder.Objects[i])));
end;
Joiner.ClearColumnList;
Assert(Assigned(Columns));
for i := 0 to pred(Columns.Count) do begin
if TffSqlSimpleExpression(Columns.Objects[i]).IsField(F) then begin
Joiner.AddColumn(
nil,
F,
Result.Field(i));
end else begin
Joiner.AddColumn(
TffSqlSimpleExpression(Columns.Objects[i]),
nil,
Result.Field(i));
end;
end;
if NeedData then begin
Joiner.Target := Result;
Owner.FDatabase.StartTransaction([nil]);
try
Joiner.Execute(Owner.UseIndex, nil, jmNone);
except
Owner.FDatabase.AbortTransaction;
raise;
end;
Owner.FDatabase.Commit;
end;
for i := 0 to Result.FieldCount - 1 do
Result.Field(i).IsTarget := False;
{At this point we have a table with all records that meet the
WHERE criteria.}
{if DISTINCT was specifed, we now need to remove any duplicates}
if Distinct and NeedData then begin
T2 := Result.CopyUnique(Self, True); {!!.13}
Result.Owner := nil;
Result.Free;
Result := T2;
end;
if (Parent is TffSqlInClause) or (Parent is TffSqlMatchClause) then begin
{need an index to allow the IN and MATCH clauses to be evaluated}
T2 := Result.CopySortedOnAllFields(Self);
Result.Owner := nil;
Result.Free;
Result := T2;
end else begin
//do ORDER BY
DoOrderBy(NeedData, Result);
end;
except
Result.Owner := nil;
Result.Free;
raise;
end;
end;
function TffSqlSELECT.CheckHaving: Boolean;
begin
Result := CondExpHaving.AsBoolean;
end;
procedure TffSqlSELECT.DoAggOrderBy;
{-utility method for AggregateQueryResult}
var
i, j, z, k, IX: Integer;
S: string;
FR : TffSQLFieldRef;
AliasName : string;
SortList: TffSqlSortArray;
Status : TffResult;
begin
//do ORDER BY
if OrderList <> nil then begin
j := pred(OrderList.OrderCount);
for i := 0 to j do begin
if OrderList.OrderItem[i].Column <> nil then begin
s := OrderList.OrderItem[i].Column.QualColumnName;
z := Columns.IndexOf(S);
if z = -1 then begin
z := PosCh('.', S);
if z = 0 then begin
S := '.' + S;
// may be unqualified field but qualified columns
z := -1;
for k := 0 to pred(Columns.Count) do
if posI(S, Columns[k]) <> 0 then begin
z := k;
break;
end;
if z = -1 then begin
SQLError('Unknown column specified in ORDER BY clause: ' +
Copy(S, 2, Length(S) - 1));
end;
end else begin
// This is a qualified column. Try to find qualified column
z := -1;
for k := 0 to pred(Columns.Count) do begin
FR := (Columns.Objects[k] as TffSQLSimpleExpression).
Term[0].Factor[0].FieldRef;
if Assigned(FR) and (posI(S, FR.SQLText) <> 0) then begin
z := k;
break;
end;
end;
if z = -1 then begin
//Table might be aliased. Replace alias with corresponding table name
z := PosCh('.', S);
AliasName := UpperCase(Copy(s, 1, z-1));
Assert(Assigned(TableAliases));
IX := TableAliases.IndexOf(AliasName);
if IX <> -1 then begin
IX := Integer(TableAliases.Objects[IX]);
Assert(Assigned(TablesReferencedByOrder));
S := TablesReferencedByOrder[IX] + '.' +
UpperCase(Copy(S, Z+1, MaxInt));
//Repeat search for field
z := -1;
for k := 0 to Pred(Columns.Count) do begin
FR := (Columns.Objects[K] as TffSQLSimpleExpression).Term[0].Factor[0].FieldRef;
if Assigned(FR) and (posI(S, FR.SQLText) <> 0) then begin
z := k;
break;
end;
end;
end else
z := -1;
end;
if z = -1 then begin
// may be qualified field but unqualified columns
Z := PosCh('.', S);
S := copy(S, z + 1, MaxInt);
Z := -1;
for k := 0 to pred(Columns.Count) do
if posI(S, Columns[k]) <> 0 then begin
z := k;
break;
end;
if z = -1 then
SQLError('Unknown column specified in ORDER BY clause:'+S);
end;
end;
end;
SortList[i] := FGrpTable.Field(z).Index + 1;
end else begin
z := StrToInt(OrderList.OrderItem[i].Index);
SortList[i] := FGrpTable.Field(z - 1).Index + 1;
end;
if OrderList.OrderItem[i].Descending then
SortList[i] := -SortList[i];
end;
Status := FGrpTable.Sort(j + 1, SortList, False); {!!.13}
if Status <> DBIERR_NONE then
raise EffException.CreateNoData(ffStrResServer, Status);
end;
end;
procedure TffSqlSELECT.DoGroupCopy;
var
GroupColumnsOut : Integer;
FieldDefList: TffSqlFieldDefList;
i: Integer;
N : TffSqlNode;
Se : TffSqlSelection;
T2 : TffSqlTableProxy;
procedure CopyGrouped(const Source, Target: TFFSqlTableProxy;
GroupColumnsIn, GroupColumnsOut, NonGroupColumns: Integer;
const GroupColumnTargetField,
AggExpList: TList);
var
i : Integer;
IsFirst, HaveGroup, NewGroup : Boolean;
LastValues : TffVariantList;
procedure WriteGroup;
var
TgtInfo : TffGroupColumnTargetInfo;
i : Integer;
begin
Target.Insert;
for i := 0 to pred(GroupColumnsOut) do begin
TgtInfo := TffGroupColumnTargetInfo(GroupColumnTargetField[i]);
if TgtInfo <> nil then
Target.Field(TgtInfo.SelFldIndex).SetValue
(LastValues.GetValue(TgtInfo.LastValueIndex));
end;
for i := 0 to pred(NonGroupColumns) do
Target.Field(GroupColumnsOut + i).SetValue(
TffSqlSimpleExpression(AggExpList[i]).GetValue);
for i := 0 to pred(AggList.Count) do
TffSqlAggregate(AggList[i]).ResetCounters;
Target.Post;
end;
begin
Owner.FDatabase.StartTransaction([nil]);
try
IsFirst := True;
HaveGroup := False;
LastValues := TffVariantList.Create(GroupColumnsIn);
{we know that the source table has grouping columns first}
for i := 0 to pred(AggList.Count) do
TffSqlAggregate(AggList[i]).CreateCounter(Source.Field(i + GroupColumnsIn));
Source.First;
while not Source.EOF do begin
if IsFirst then begin
IsFirst := False;
NewGroup := True;
end else begin
NewGroup := False;
for i := 0 to pred(GroupColumnsIn) do
if Source.Field(i).GetValue <> LastValues.GetValue(i) then begin
NewGroup := True;
break;
end;
end;
if NewGroup then begin
if HaveGroup then begin
Source.Prior;
WriteGroup;
Source.Next;
end;
for i := 0 to pred(GroupColumnsIn) do
LastValues.SetValue(i, Source.Field(i).GetValue);
HaveGroup := True;
end;
for i := 0 to pred(AggList.Count) do
TffSqlAggregate(AggList[i]).Update;
Source.Next;
end;
{If we happen to have an empty set AND if we don't have grouping
columns, an 'empty' record should be added to hold the
count value of zero as well as null for any aggregates}
if HaveGroup or (GroupColumnsIn = 0) then
WriteGroup;
for i := 0 to pred(AggList.Count) do
with TffSqlAggregate(AggList[i]) do
DeleteCounter;
Owner.FDatabase.Commit;
finally
LastValues.Free;
end;
end;
begin
{build a normal answer table}
GroupColumnsOut := 0;
{build field definition for answer table}
FieldDefList := TffSqlFieldDefList.Create;
try
Assert(Assigned(Columns));
for i := 0 to pred(Columns.Count) do begin
N := TffSqlNode(Columns.Objects[i]);
if i < GroupColumnsIn then {!!.11}
FieldDefList.AddField(Columns[i],
N.GetType, N.GetSize, N.GetDecimals)
else {!!.11}
{Begin !!.12}
{ Aggregate fields that reference date, time, & currency fields
should be of the same type in the result set. Other field
types should be changed to fftDouble in order to avoid clipping
of the value. }
case N.GetType of
fftCurrency..fftDateTime:
FieldDefList.AddField(Columns[i],
N.GetType, N.GetSize, N.GetDecimals);
else
FieldDefList.AddField(Columns[i],
fftDouble, 8, N.GetDecimals);
end;
{End !!.12}
Se := SelectionList.Selection[i];
if (GroupColumnList <> nil) and
GroupColumnList.Contains(Columns[i], Se) then
inc(GroupColumnsOut)
else
AggExpList.Add(N);
end;
T2 := Owner.FDatabase.CreateTemporaryTableWithoutIndex(Self, FieldDefList);
finally
FieldDefList.Free;
end;
AggQueryMode := aqmGrouping;
try
CopyGrouped(
FGrpTable,
T2,
GroupColumnsIn,
GroupColumnsOut,
AggExpList.Count,
GroupColumnTargetField,
AggExpList);
finally
AggQueryMode := aqmIdle;
end;
FGrpTable.Owner := nil;
FGrpTable.Free;
FGrpTable := T2;
end;
procedure TffSqlSELECT.DoHaving;
var
T2 : TffSqlTableProxy;
begin
if CondExpHaving <> nil then begin
AggQueryMode := aqmHaving;
try
HavingTable := FGrpTable;
CondExpHaving.BindHaving;
CondExpHaving.EnumNodes(ResetIsConstant, False);
T2 := FGrpTable.CopyValidated(Self, CheckHaving);
FGrpTable.Owner := nil;
FGrpTable.Free;
FGrpTable := T2;
finally
AggQueryMode := aqmIdle;
end;
end;
end;
procedure TffSqlSELECT.DoSortOnAll;
var
T2 : TffSqlTableProxy;
begin
T2 := FGrpTable.CopySortedOnAllFields(Self);
FGrpTable.Owner := nil; {!!.11}
FGrpTable.Free;
FGrpTable := T2;
end;
procedure TffSqlSELECT.DoRemoveDups(NeedData: Boolean);
var
i: Integer;
LDistinct: Boolean;
T2 : TffSqlTableProxy;
begin
if not Distinct then begin
LDistinct := False;
for i := 0 to pred(AggList.Count) do
if TffSqlAggregate(AggList[i]).Distinct then begin
LDistinct := True;
break;
end;
end else
LDistinct := True;
if LDistinct and NeedData then begin
T2 := FGrpTable.CopyUnique(Self, True); {!!.13}
FGrpTable.Owner := nil;
FGrpTable.Free;
FGrpTable := T2;
end;
end;
procedure TffSqlSELECT.DoBuildGroupingTable;
var
FieldDefList: TffSqlFieldDefList;
i: Integer;
Co : TffSqlGroupColumn;
Se : TffSqlSelection;
F : TffSqlFieldProxy;
GrpTgtInfo : TffGroupColumnTargetInfo;
Ag : TffSqlAggregate;
FldType : TffFieldType;
begin
FieldDefList := TffSqlFieldDefList.Create;
try
{build field definition for grouping table}
for i := 0 to pred(GroupColumnsIn) do begin
Co := GroupColumnList.Column[i];
Se := SelectionList.FindSelection(Co);
if Se <> nil then begin
if Se.SimpleExpression.IsField(F) then begin
FSF.Add(F);
FSX.Add(nil);
end else begin
FSF.Add(nil);
FSX.Add(Se.SimpleExpression);
end;
GrpTgtInfo := TffGroupColumnTargetInfo.Create;
GrpTgtInfo.SelFldIndex := Se.Index;
GrpTgtInfo.LastValueIndex := i;
GroupColumnTargetField.Add(GrpTgtInfo);
FieldDefList.AddField(
Co.QualColumnName,
Se.SimpleExpression.GetType,
Se.SimpleExpression.GetSize,
Se.SimpleExpression.GetDecimals);
end else begin
{grouping field is not in selection list}
{must be plain field in source table}
F := FindField(Co.QualColumnName);
FSF.Add(F);
FSX.Add(nil);
FieldDefList.AddField(
Co.QualColumnName,
F.GetType,
F.GetSize,
F.GetDecimals);
end;
end;
SelectionList.EnumNodes(EnumAggregates, False);
for i := 0 to pred(AggList.Count) do begin
Ag := TffSqlAggregate(AggList[i]);
if Ag.SimpleExpression <> nil then begin
FldType := Ag.SimpleExpression.GetType;
if not Ag.ValidType(FldType) then
raise Exception.CreateFmt('The %s aggregate function requires a numeric field.',
[AgString[Ag.AgFunction]]);
{AVG() needs float field even for integer expressions}
if Ag.AgFunction = agAvg then
FieldDefList.AddField(
Ag.GetTitle(True) + '$' + IntToStr(i), {!!.11}
fftDouble,
0,
2)
else
FieldDefList.AddField(
Ag.GetTitle(True) + '$' + IntToStr(i), {!!.11}
FldType,
Ag.SimpleExpression.GetSize,
Ag.SimpleExpression.GetDecimals)
end
else // COUNT(* )
FieldDefList.AddField(
Ag.GetTitle(True) + '$' + IntToStr(i), {!!.11}
fftDouble,
0,
0);
end;
FGrpTable := Owner.FDatabase.CreateTemporaryTableWithoutIndex(Self,
FieldDefList);
finally
FieldDefList.Free;
end;
end;
procedure TffSqlSELECT.DoCheckAggregates;
var
i: Integer;
Se : TffSqlSelection;
F : TffSqlFieldProxy;
LDistinct: Boolean;
begin
LDistinct := False;
{ LDistinct is being used to check for situation where a non-aggregate
column is listed after an aggregate column. }
for i := 0 to pred(SelectionList.SelectionCount) do begin
se := SelectionList.Selection[i];
if se.IsAggregateExpression then
LDistinct := True
else if LDistinct then
SQLError('Non-aggregate column "' + Trim(se.SQLText) +
'" must appear before aggregate columns in the selection list.')
else if se.SimpleExpression.IsField(F) and
((GroupColumnList = nil) or
(not GroupColumnList.Contains(Columns[i], se))) then
SQLError('Non-aggregate column "' + trim(se.SQLText) +
'" must appear in GROUP BY');
end;
end;
{!!.11 new}
function TffSqlSELECT.TableWithCount(const ColumnName: string): TffSqlTableProxy; {!!.12}
var
FieldDefList: TffSqlFieldDefList;
begin
FieldDefList := TffSqlFieldDefList.Create;
try
FieldDefList.AddField(ColumnName, fftDouble, 8, 0); {!!.12}
Result := Owner.FDatabase.CreateTemporaryTableWithoutIndex(Self, FieldDefList);
finally
FieldDefList.Free;
end;
Owner.FDatabase.StartTransaction([nil]);
try
Result.Insert;
Result.Field(0).SetValue(TFFSqlTableProxy(TablesReferencedByOrder.Objects[0]).GetRecordCount);
Result.Post;
Owner.FDatabase.Commit;
except
Owner.FDatabase.AbortTransaction;
raise;
end;
end;
function TffSqlSELECT.AggregateQueryResult(NeedData: Boolean): TffSqlTableProxy;
var
i : Integer;
T2 : TffSqlTableProxy;
GroupColumnsIn : Integer;
SortList: TffSqlSortArray;
GroupColumnTargetField,
AggExpList,
FSX : TList;
FSF : TList;
j : Integer;
Status : TffResult;
ColumnName: string; {!!.12}
begin
{!!.11 begin}
if (GroupColumnList = nil)
and (CondExpWhere = nil) {!!.12}
and (TablesReferencedByOrder.Count = 1)
and (CondExpHaving = nil)
and (SelectionList.SelectionCount = 1)
and (SelectionList.Selection[0].SimpleExpression <> nil)
and (SelectionList.Selection[0].SimpleExpression.TermCount = 1)
and (SelectionList.Selection[0].SimpleExpression.Term[0].FactorCount = 1)
and (SelectionList.Selection[0].SimpleExpression.Term[0].Factor[0].Aggregate <> nil)
and (SelectionList.Selection[0].SimpleExpression.Term[0].Factor[0].Aggregate.AgFunction = agCount)
and (SelectionList.Selection[0].SimpleExpression.Term[0].Factor[0].Aggregate.SimpleExpression = nil) then begin
{special case, plain "COUNT(*)" - use record count reported by low-level code}
if SelectionList.Selection[0].Column <> nil then {!!.12}
ColumnName := SelectionList.Selection[0].Column.ColumnName {!!.12}
else {!!.12}
ColumnName := 'COUNT(*)'; {!!.12}
Result := TableWithCount(ColumnName); {!!.12}
exit;
end;
{!!.11 end}
FGrpTable := nil;
T2 := nil;
{Columns contain the columns that will be in the result table.
However, we may still group on other fields from the selection result -
in particular if this is a sub-query}
{field list for grouping table creation}
FSX := nil;
FSF := nil;
GroupColumnTargetField := nil;
AggExpList := nil;
try
{field lists for joiner - one for expressions, another for fields}
FSX := TList.Create;
FSF := TList.Create;
{where the groups should appear in the final result}
GroupColumnTargetField := TList.Create;
AggExpList := TList.Create;
if GroupColumnList = nil then
GroupColumnsIn := 0
else
GroupColumnsIn := GroupColumnList.ColumnCount;
{make sure all non-grouped columns are aggregate expressions}
DoCheckAggregates;
AggList := TList.Create;
try
DoBuildGroupingTable(GroupColumnsIn, FSF, FSX,
GroupColumnTargetField);
try
if Joiner = nil then begin
Joiner := TffSqlJoiner.Create(Owner, CondExpWhere);
Assert(Assigned(TablesReferencedByOrder));
for i := 0 to pred(TablesReferencedByOrder.Count) do
Joiner.Sources.Add(
TFFSqlTableProxySubset.Create(
TFFSqlTableProxy(TablesReferencedByOrder.Objects[i])));
end;
Joiner.ClearColumnList;
if GroupColumnList <> nil then begin
for i := 0 to pred(GroupColumnsIn) do begin
Joiner.AddColumn(
FSX[i],
FSF[i],
FGrpTable.Field(i));
end;
end;
for i := 0 to pred(AggList.Count) do begin
Joiner.AddColumn(
TffSqlAggregate(AggList[i]).SimpleExpression,
nil,
FGrpTable.Field(i + GroupColumnsIn));
end;
if NeedData then begin
Joiner.Target := FGrpTable;
Owner.FDatabase.StartTransaction([nil]);
try
Joiner.Execute(Owner.UseIndex, nil, jmNone);
Owner.FDatabase.Commit;
except
Owner.FDatabase.AbortTransaction;
raise;
end;
end;
{turn off special aggregation flags so that the table result
may be queried}
for i := 0 to FGrpTable.FieldCount - 1 do
FGrpTable.Field(i).IsTarget := False;
{At this point we have a table with all records that meet the
WHERE criteria.}
{if DISTINCT was specifed, we now need to remove any duplicates}
DoRemoveDups(NeedData);
if GroupColumnList <> nil then begin
{ we need to group FGrpTable }
{ First, sort the data on groups }
for i := 0 to pred(GroupColumnsIn) do
SortList[i] := FGrpTable.Field(i).Index + 1;
Status := FGrpTable.Sort(GroupColumnsIn, SortList, True); {!!.13}
if Status <> DBIERR_NONE then
raise EffException.CreateNoData(ffStrResServer, Status);
end;
{we now have the data sorted on the grouping fields}
{we then copy to another table with a slightly different
layout to hold aggregate counters rather than data values
for the non-grouped columns}
DoGroupCopy(GroupColumnsIn, AggExpList,
GroupColumnTargetField);
DoHaving;
if (Parent is TffSqlInClause) or (Parent is TffSqlMatchClause) then begin
{need an index to allow the IN and MATCH clauses to be evaluated}
DoSortOnAll;
end else
DoAggOrderBy;
except
if FGrpTable <> T2 then
T2.Free;
FGrpTable.Owner := nil;
FGrpTable.Free;
raise;
end;
finally
AggList.Free;
end;
for j := 0 to Pred(GroupColumnTargetField.Count) do
TffGroupColumnTargetInfo(GroupColumnTargetField[j]).Free;
finally
GroupColumnTargetField.Free;
FSF.Free;
FSX.Free;
AggExpList.Free;
end;
Result := FGrpTable;
end;
{--------}
function TffSqlSELECT.Execute2(NeedData: Boolean): TffSqlTableProxy;
begin
{check that all referenced tables and fields exist}
if not Bound then
Bind;
if HaveAggregates or (GroupColumnList <> nil) then begin
Result := AggregateQueryResult(NeedData);
RequestLive := False;
end else begin
Result := NormalQueryResult(NeedData);
RequestLive := False; {!!! for now}
end;
end;
{--------}
procedure TffSqlSELECT.Execute(var aLiveResult: Boolean;
var aCursorID: TffCursorID; var RecordsRead: Integer);
var
T : TffSqlTableProxy;
begin
Assert(Owner <> nil);
RequestLive := aLiveResult;
T := Execute2(True);
aCursorID := T.CursorID;
aLiveResult := RequestLive;
T.LeaveCursorOpen := True;
if T.Owner = Self then begin
T.Owner := nil;
T.Free;
end;
end;
{--------}
function TffSqlSELECT.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlSELECT)
and (Distinct = TffSqlSELECT(Other).Distinct)
and (BothNil(SelectionList, TffSqlSELECT(Other).SelectionList)
or (BothNonNil(SelectionList, TffSqlSELECT(Other).SelectionList)
and SelectionList.Equals(TffSqlSELECT(Other).SelectionList))
or ( ((SelectionList = nil) and TffSqlSELECT(Other).WasStar)
or (WasStar and (TffSqlSELECT(Other).SelectionList = nil)) )
)
and TableRefList.Equals(TffSqlSELECT(Other).TableRefList)
and (BothNil(CondExpWhere, TffSqlSELECT(Other).CondExpWhere)
or (BothNonNil(CondExpWhere, TffSqlSELECT(Other).CondExpWhere)
and CondExpWhere.Equals(TffSqlSELECT(Other).CondExpWhere))
)
and (BothNil(GroupColumnList, TffSqlSELECT(Other).GroupColumnList)
or (BothNonNil(GroupColumnList, TffSqlSELECT(Other).GroupColumnList)
and GroupColumnList.Equals(TffSqlSELECT(Other).GroupColumnList))
)
and (BothNil(CondExpHaving, TffSqlSELECT(Other).CondExpHaving)
or (BothNonNil(CondExpHaving, TffSqlSELECT(Other).CondExpHaving)
and CondExpHaving.Equals(TffSqlSELECT(Other).CondExpHaving))
)
and
(BothNil(OrderList, TffSqlSELECT(Other).OrderList)
or (BothNonNil(OrderList, TffSqlSELECT(Other).OrderList)
and OrderList.Equals(TffSqlSELECT(Other).OrderList)));
end;
{--------}
function TffSqlSELECT.GetResultTable: TFFSqlTableProxy;
begin
EnsureResultTable(True);
Result := FResultTable;
end;
function TffSqlSELECT.IsSubQuery: Boolean;
var
P: TffSqlNode;
begin
P := Parent;
while P <> nil do begin
if (P is TffSqlSELECT)
or (P is TffSqlUPDATE)
or (P is TffSqlDELETE)
or (P is TffSqlINSERT) then begin
Result := True;
exit;
end;
P := P.Parent;
end;
Result := False;
end;
{--------}
function TffSqlSELECT.Match(Value: Variant; Unique: Boolean;
MatchOption: TffSqlMatchOption): Boolean;
function RangeIsOne(const Table: TffSqlTableProxy): Boolean;
begin
Result := Table.First and not Table.Next;
end;
begin
EnsureResultTable(True);
if not Unique then
case MatchOption of
moUnspec :
if VarIsNull(Value) then
Result := True
else begin
ResultTable.SetRange([Value], [Value], 1, 1, True, True, True);
Result := ResultTable.First;
end;
moPartial :
if VarIsNull(Value) then
Result := True
else begin
ResultTable.SetRange([Value], [Value], 1, 1, True, True, True);
Result := ResultTable.First;
end;
else//moFull :
if VarIsNull(Value) then
Result := True
else begin
ResultTable.SetRange([Value], [Value], 1, 1, True, True, True);
Result := ResultTable.First;
end;
end
else
case MatchOption of
moUnspec :
if VarIsNull(Value) then
Result := True
else begin
ResultTable.SetRange([Value], [Value], 1, 1, True, True, True);
Result := RangeIsOne(ResultTable);
end;
moPartial :
if VarIsNull(Value) then
Result := True
else begin
ResultTable.SetRange([Value], [Value], 1, 1, True, True, True);
Result := RangeIsOne(ResultTable);
end;
else//moFull :
if VarIsNull(Value) then
Result := True
else begin
ResultTable.SetRange([Value], [Value], 1, 1, True, True, True);
Result := RangeIsOne(ResultTable);
end;
end;
end;
{--------}
procedure TffSqlSELECT.MatchType(ExpectedType: TffFieldType; AllowMultiple: Boolean);
begin
//this will only be called when the current SELECT statement
//functions as a sub-query
if not AllowMultiple and (SelectionList.SelectionCount <> 1) then
SQLError('Sub-query was expected to have exactly one column');
EnsureResultTable(False);
end;
{====================================================================}
{===TffSqlFieldRef===================================================}
procedure TffSqlFieldRef.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlFieldRef then begin
TableName := TffSqlFieldRef(Source).TableName;
FieldName := TffSqlFieldRef(Source).FieldName;
end else
AssignError(Source);
end;
procedure TffSqlFieldRef.CheckType;
{ Rewritten !!.06}
var
Found : Boolean;
Inx : Integer;
Select : TffSQLSelect;
Selection : TffSQLSelection;
begin
Found := False;
{ The field reference may be an alias or a direct reference to a field. }
if (TableName = '') then begin
{ See if it is an alias. }
Select := OwnerSelect;
if Select <> nil then begin
for Inx := 0 to Pred(Select.SelectionList.SelectionCount) do begin
Selection := Select.SelectionList.Selection[Inx];
if (not IsAncestor(Selection)) and
(Selection.Column <> nil) and
(AnsiCompareText(Selection.Column.ColumnName, FieldName) = 0) then begin
FType := Selection.SimpleExpression.GetType;
Found := True;
Break;
end;
end;
end else begin
end;
end;
{ If this isn't an alias then see if it is a direct reference. }
if not Found then begin
Assert(Field <> nil);
FType := Field.GetType;
end;
TypeKnown := True;
end;
{--------}
procedure TffSqlFieldRef.ClearBinding;
begin
FField := nil;
end;
{--------}
function TffSqlFieldRef.DependsOn(Table: TFFSqlTableProxy): Boolean;
begin
{!!.12 begin}
if Field.IsTarget then begin
Assert(OwnerSelect <> nil);
if Field.SrcIndex > -1 then
Result := TffSQLSimpleExpression(OwnerSelect.Joiner.FSX[
Field.SrcIndex]).DependsOn(Table)
else
Result := Field.SrcField.OwnerTable = Table;
end else
{!!.12 end}
Result := Field.OwnerTable = Table;
end;
{--------}
procedure TffSqlFieldRef.EmitSQL(Stream: TStream);
begin
WriteStr(Stream,' ');
if WasWildcard then begin
WriteStr(Stream, TableName);
WriteStr(Stream, '.*');
end else
WriteStr(Stream, GetTitle(True)); {!!.11}
end;
{--------}
procedure TffSqlFieldRef.EnumNodes(EnumMethod: TffSqlEnumMethod;
const Deep: Boolean);
begin
EnumMethod(Self);
end;
{--------}
function TffSqlFieldRef.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlFieldRef)
and (AnsiCompareText(TableName, TffSqlFieldRef(Other).TableName) = 0)
and
( (AnsiCompareText(FieldName, TffSqlFieldRef(Other).FieldName) = 0)
or (WasWildcard and (TffSqlFieldRef(Other).FieldName = '')
or (((FieldName = '') and TffSqlFieldRef(Other).WasWildcard))));
end;
{--------}
function TffSqlFieldRef.GetDecimals: Integer;
begin
Result := Field.GetDecimals;
end;
{--------}
function TffSqlFieldRef.GetField: TFFSqlFieldProxy;
begin
if FField = nil then
FField := Parent.BindField(TableName, FieldName);
Result := FField;
end;
{--------}
function TffSqlFieldRef.GetGroupField: TFFSqlFieldProxy;
begin
if OwnerSelect = nil then
SQLError('Field references may not occur in this context');
if FGroupField = nil then begin
FGroupField := OwnerSelect.FGrpTable.FieldByName(QualName);
if FGroupField = nil then begin
FGroupField := OwnerSelect.FGrpTable.FieldByName(FieldName);
if FGroupField = nil then
SQLError('Unknown field:' + FieldName);
end;
end;
Result := FGroupField;
end;
{--------}
function TffSqlFieldRef.GetSize: Integer;
begin
Result := Field.GetSize;
end;
{--------}
function TffSqlFieldRef.GetTitle(const Qualified : Boolean): string; {!!.11}
begin
if Qualified and (TableName <> '') then {!!.11}
if FieldName <> '' then
Result := TableName + '.' + FieldName
else
Result := TableName + '.*'
else
Result := FieldName;
end;
{--------}
function TffSqlFieldRef.GetType: TffFieldType;
begin
if not TypeKnown then
CheckType;
Result := FType;
end;
{--------}
function TffSqlFieldRef.GetValue: Variant;
begin
if (OwnerSelect <> nil) and
(OwnerSelect.AggQueryMode = aqmGrouping) then
Result := GroupField.GetValue
else if Field.IsTarget then begin
Assert(OwnerSelect <> nil);
if Field.SrcIndex > -1 then
Result := TffSQLSimpleExpression(OwnerSelect.Joiner.FSX[
Field.SrcIndex]).GetValue
else
Result := Field.SrcField.GetValue;
end else
Result := Field.GetValue;
end;
{--------}
function TffSqlFieldRef.IsNull: Boolean;
begin
if (OwnerSelect <> nil) and
(OwnerSelect.AggQueryMode = aqmGrouping) then
Result := VarIsNull(GroupField.GetValue)
else if Field.IsTarget then begin
Assert(OwnerSelect <> nil);
if Field.SrcIndex > -1 then
Result := TffSQLSimpleExpression(OwnerSelect.Joiner.
FSX[Field.SrcIndex]).IsNull
else
Result := Field.SrcField.IsNull;
end else
Result := Field.IsNull;
end;
{--------}
procedure TffSqlFieldRef.MatchType(ExpectedType: TffFieldType);
begin
if GetType <> ExpectedType then
case GetType of
fftByte..fftCurrency :
case ExpectedType of
fftByte..fftCurrency :
{ OK };
else
TypeMismatch;
end;
fftStDate,
fftStTime,
fftDateTime :
case ExpectedType of
fftStDate..fftDateTime :
{ OK };
else
TypeMismatch;
end; { case }
fftChar,
fftWideChar,
fftShortString..fftWideString :
case ExpectedType of
fftChar, fftWideChar, fftShortString..fftWideString :
{ OK };
else
TypeMismatch;
end; { case }
{Begin !!.13}
fftBLOB..fftBLOBTypedBin :
case ExpectedType of
fftChar, fftWideChar,
fftShortString..fftWideString,
fftBLOB..fftBLOBTypedBin :
{ OK };
else
TypeMismatch;
end; { case }
{End !!.13}
else
TypeMismatch;
end; { case }
end;
{--------}
function TffSQLFieldRef.QualName : string;
var
Name : string;
begin
Result := FFieldName;
{ If no tablename specified then obtain table name of source table. }
if FTableName = '' then begin
if assigned(FField) then
Result := FField.OwnerTable.Name + '.' + FFieldName
else
Result := FFieldName;
end
else begin
if OwnerSelect = nil then
SQLError('Field references may not occur in this context');
{ Has a table name. Is it really an alias? }
Name := OwnerSelect.TableRefList.GetNameForAlias(FTableName);
if Name <> '' then
Result := Name + '.' + FFieldName
else
Result := TableName + '.' + FFieldName;
end;
end;
{====================================================================}
{===TffSqlAggregate==================================================}
{--------}
procedure TffSqlAggregate.AddAggregate(Target: TList);
begin
Target.Add(Self);
end;
{--------}
procedure TffSqlAggregate.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlAggregate then begin
AgFunction := TffSqlAggregate(Source).AgFunction;
SimpleExpression.Free;
SimpleExpression := nil;
if assigned(TffSqlAggregate(Source).SimpleExpression) then begin
SimpleExpression := TffSqlSimpleExpression.Create(Self);
SimpleExpression.Assign(TffSqlAggregate(Source).SimpleExpression);
end;
Distinct := TffSqlAggregate(Source).Distinct;
end else
AssignError(Source);
end;
{--------}
procedure TffSqlAggregate.CreateCounter(SourceField: TFFSqlFieldProxy);
begin
FCounter := TAggCounter.Create;
FSourceField := SourceField;
end;
{--------}
procedure TffSqlAggregate.DeleteCounter;
begin
FCounter.Free;
FCounter := nil;
FSourceField := nil;
end;
{--------}
function TffSqlAggregate.DependsOn(Table: TFFSqlTableProxy): Boolean;
begin
Result := SimpleExpression.DependsOn(Table);
end;
{--------}
destructor TffSqlAggregate.Destroy;
begin
SimpleExpression.Free;
inherited;
end;
{--------}
procedure TffSqlAggregate.ResetCounters;
begin
FCounter.Reset;
end;
{--------}
procedure TffSqlAggregate.Update;
begin
case AgFunction of
agCount :
if (FSourceField = nil) or not VarIsNull(FSourceField.GetValue) then {!!.13}
FCounter.Add(1);
else
if not VarIsNull(FSourceField.GetValue) then
FCounter.Add(FSourceField.GetValue);
end;
end;
{--------}
procedure TffSqlAggregate.EmitSQL(Stream: TStream);
begin
WriteStr(Stream,' ');
WriteStr(Stream, AgString[AgFunction]);
WriteStr(Stream,'(');
if SimpleExpression <> nil then begin
if Distinct then
WriteStr(Stream,' DISTINCT')
else
WriteStr(Stream,' ALL');
SimpleExpression.EmitSQL(Stream);
end else
WriteStr(Stream, '*');
WriteStr(Stream,')');
end;
{--------}
procedure TffSqlAggregate.EnumNodes(EnumMethod: TffSqlEnumMethod;
const Deep: Boolean);
begin
EnumMethod(Self);
if SimpleExpression <> nil then
SimpleExpression.EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlAggregate.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlAggregate)
and (AgFunction = TffSqlAggregate(Other).AgFunction)
and (Distinct = TffSqlAggregate(Other).Distinct)
and (
BothNil(SimpleExpression, TffSqlAggregate(Other).SimpleExpression)
or (
BothNonNil(SimpleExpression, TffSqlAggregate(Other).SimpleExpression)
and SimpleExpression.Equals(TffSqlAggregate(Other).SimpleExpression)
)
);
end;
{--------}
function TffSqlAggregate.GetAggregateValue: Variant;
begin
if FCounter = nil then
Result := 0
else begin
case AgFunction of
agCount :
Result := FCounter.Count;
agMin :
Result := FCounter.Min;
agMax :
Result := FCounter.Max;
agSum :
Result := FCounter.Sum;
else //agAvg :
Result := FCounter.Avg;
end;
end;
end;
{--------}
procedure TffSqlAggregate.FlagAggregate(Select: TffSqlSELECT);
begin
Select.HaveAggregates := True;
end;
{--------}
function TffSqlAggregate.GetDecimals: Integer;
begin
case AgFunction of
agCount :
Result := 0;
else
Result := 2;
end;
end;
{--------}
function TffSqlAggregate.GetSize: Integer;
begin
if SimpleExpression <> nil then
Result := SimpleExpression.GetSize
else
Result := 0;
end;
{--------}
function TffSqlAggregate.GetTitle(const Qualified : Boolean): string; {!!.11}
begin
Result := AgString[AgFunction] + '(';
if Distinct then
Result := Result + 'DISTINCT ';
if SimpleExpression = nil then
Result := Result + '*'
else
Result := Result + SimpleExpression.GetTitle(Qualified); {!!.11}
Result := Result + ')';
end;
{--------}
function TffSqlAggregate.GetType: TffFieldType;
begin
if SimpleExpression = nil then
Result := fftDouble
else
case SimpleExpression.GetType of
fftExtended :
Result := fftExtended;
fftCurrency :
case AgFunction of
agCount :
Result := fftDouble;
else
Result := fftCurrency;
end;
else
case AgFunction of
agCount,
agAvg:
Result := fftDouble;
else
Result := SimpleExpression.GetType;
end;
end;
end;
{--------}
procedure TffSqlAggregate.MatchType(ExpectedType: TffFieldType);
begin
case ExpectedType of
fftByte..fftCurrency :
;
else
TypeMismatch;
end;
end;
{--------}
function TffSqlAggregate.Reduce: Boolean;
begin
if SimpleExpression <> nil then
Result := SimpleExpression.Reduce
else
Result := False;
end;
{--------}
function TffSqlAggregate.ValidType(aType : TffFieldType) : Boolean;
begin
case agFunction of
agSum, agAvg :
Result := (aType in [fftByte..fftCurrency]);
else
Result := True;
end;
end;
{====================================================================}
{===TffSqlColumn=====================================================}
procedure TffSqlColumn.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlColumn then begin
ColumnName := TffSqlColumn(Source).ColumnName;
end else
AssignError(Source);
end;
procedure TffSqlColumn.EmitSQL(Stream: TStream);
begin
WriteStr(Stream,' ');
WriteStr(Stream, ColumnName);
end;
{--------}
procedure TffSqlColumn.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
EnumMethod(Self);
end;
{--------}
function TffSqlColumn.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlColumn)
and (AnsiCompareText(ColumnName, TffSqlColumn(Other).ColumnName) = 0);
end;
{====================================================================}
{===TffSqlIsTest=====================================================}
function TffSqlIsTest.AsBoolean(const TestValue: Variant): Boolean;
begin
case IsOp of
ioNull :
Result := VarIsNull(TestValue) xor UnaryNot;
ioTrue :
if UnaryNot then
Result := not TestValue
else
Result := TestValue;
ioFalse :
if UnaryNot then
Result := TestValue
else
Result := not TestValue;
else
//ioUnknown :
Result := VarIsNull(TestValue) xor UnaryNot;
end;
end;
{--------}
procedure TffSqlIsTest.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlIsTest then begin
UnaryNot := TffSqlIsTest(Source).UnaryNot;
IsOp := TffSqlIsTest(Source).IsOp;
end else
AssignError(Source);
end;
procedure TffSqlIsTest.EmitSQL(Stream: TStream);
const
IsOpStr : array[TffSqlIsOp] of string =
('NULL', 'TRUE', 'FALSE', 'UNKNOWN');
begin
WriteStr(Stream,' IS');
if UnaryNot then
WriteStr(Stream,' NOT');
WriteStr(Stream,' ');
WriteStr(Stream, IsOpStr[IsOp]);
end;
{--------}
procedure TffSqlIsTest.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
EnumMethod(Self);
end;
{--------}
function TffSqlIsTest.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlIsTest)
and (UnaryNot = TffSqlIsTest(Other).UnaryNot)
and (IsOp = TffSqlIsTest(Other).IsOp);
end;
{--------}
function TffSqlIsTest.Evaluate(
Expression: TffSqlSimpleExpression): Boolean;
{- allow check against NULL for non-variant compatible fields}
begin
case IsOp of
ioNull, ioUnknown :
Result := Expression.IsNull xor UnaryNot;
else
Result := AsBoolean(Expression.GetValue);
end;
end;
procedure TffSqlIsTest.MatchType(ExpectedType: TffFieldType);
begin
end;
{====================================================================}
{===TffSqlBetweenClause==============================================}
function TffSqlBetweenClause.AsBoolean(const TestValue: Variant): Boolean;
begin
if VarIsNull(TestValue) then
Result := False
else
Result :=
(
(TestValue >= SimpleLow.GetValue)
and
(TestValue <= SimpleHigh.GetValue)
) xor Negated;
end;
{--------}
procedure TffSqlBetweenClause.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlBetweenClause then begin
Negated := TffSqlBetweenClause(Source).Negated;
SimpleLow.Free;
SimpleLow := TffSqlSimpleExpression.Create(Self);
SimpleLow.Assign(TffSqlBetweenClause(Source).SimpleLow);
SimpleHigh.Free;
SimpleHigh := TffSqlSimpleExpression.Create(Self);
SimpleHigh.Assign(TffSqlBetweenClause(Source).SimpleHigh);
end else
AssignError(Source);
end;
procedure TffSqlBetweenClause.CheckIsConstant;
begin
FIsConstantChecked := True;
FIsConstant :=
SimpleLow.IsConstant and SimpleHigh.IsConstant;
end;
{--------}
function TffSqlBetweenClause.DependsOn(Table: TFFSqlTableProxy): Boolean;
begin
Result := SimpleLow.DependsOn(Table) or SimpleHigh.DependsOn(Table);
end;
destructor TffSqlBetweenClause.Destroy;
begin
SimpleLow.Free;
SimpleHigh.Free;
inherited;
end;
{--------}
procedure TffSqlBetweenClause.EmitSQL(Stream: TStream);
begin
if Negated then
WriteStr(Stream,' NOT');
WriteStr(Stream, ' BETWEEN ');
SimpleLow.EmitSQL(Stream);
WriteStr(Stream,' AND ');
SimpleHigh.EmitSQL(Stream);
end;
{--------}
procedure TffSqlBetweenClause.EnumNodes(EnumMethod: TffSqlEnumMethod;
const Deep: Boolean);
begin
EnumMethod(Self);
SimpleLow.EnumNodes(EnumMethod, Deep);
SimpleHigh.EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlBetweenClause.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlBetweenClause)
and (Negated = TffSqlBetweenClause(Other).Negated)
and (SimpleLow.Equals(TffSqlBetweenClause(Other).SimpleLow))
and (SimpleHigh.Equals(TffSqlBetweenClause(Other).SimpleHigh));
end;
{--------}
function TffSqlBetweenClause.IsConstant: Boolean;
begin
if not FIsConstantChecked then
CheckIsConstant;
Result := FIsConstant;
end;
{--------}
procedure TffSqlBetweenClause.MatchType(ExpectedType: TffFieldType);
begin
SimpleLow.MatchType(ExpectedType);
SimpleHigh.MatchType(ExpectedType);
end;
{--------}
function TffSqlBetweenClause.Reduce: Boolean;
begin
Result := SimpleLow.Reduce or SimpleHigh.Reduce;
end;
procedure TffSqlBetweenClause.ResetConstant;
begin
FIsConstantChecked := False;
FIsConstant := False;
end;
{====================================================================}
{ TffSqlLikePattern }
constructor TffsqlLikePattern.Create(SearchPattern: string; const Escape: string);
var
i: Integer;
Mask : string;
Esc: Char;
begin
FloatPatterns := TStringList.Create;
FloatMasks := TStringList.Create;
{
Search pattern is made up of
0 or 1 lead pattern
0-N floating patterns, and
0 or 1 trail pattern.
Patterns are separated by '%'.
If search pattern starts with '%', it does not have a lead pattern.
If search pattern ends with '%', it does not have a trail pattern.
Place holders, '_', are not considered here but in Find.
}
{build a separate mask string for place holders so that we can use
the same logic for escaped and non-escaped search patterns}
Mask := SearchPattern;
if Escape <> '' then begin
i := length(SearchPattern);
Esc := Escape[1];
while i >= 2 do begin
if SearchPattern[i - 1] = Esc then begin
Mask[i] := ' '; // blank out the mask character
//remove the escape
Delete(Mask, i - 1, 1);
Delete(SearchPattern, i - 1, 1);
end;
dec(i);
end;
end;
if (SearchPattern = '') then
exit;
if Mask[1] <> '%' then begin
{we have a lead pattern}
i := PosCh('%', Mask);
if i = 0 then begin
{entire search pattern is a lead pattern}
LeadPattern := SearchPattern;
LeadMask := Mask;
exit;
end;
LeadPattern := copy(SearchPattern, 1, i - 1);
LeadMask := copy(Mask, 1, i - 1);
Delete(SearchPattern, 1, i - 1);
Delete(Mask, 1, i - 1);
end;
if (SearchPattern = '') then
exit;
i := length(Mask);
if Mask[i] <> '%' then begin
{we have a trail pattern}
while (i > 0) and (Mask[i] <> '%') do
dec(i);
if i = 0 then begin
{entire remaining pattern is a trail pattern}
TrailPattern := SearchPattern;
TrailMask := Mask;
exit;
end;
TrailPattern := copy(SearchPattern, i + 1, MaxInt);
TrailMask := copy(Mask, i + 1, MaxInt);
Delete(SearchPattern, i + 1, MaxInt);
Delete(Mask, i + 1, MaxInt);
end;
{we now have one or more floating patterns separated by '%'}
if Mask = '' then
exit;
if Mask[1] <> '%' then
exit;
Delete(Mask, 1, 1);
Delete(SearchPattern, 1, 1);
repeat
i := PosCh('%', Mask);
if i = 0 then begin
{entire remaining search pattern is one pattern}
FloatPatterns.Add(SearchPattern);
FloatMasks.Add(Mask);
exit;
end;
FloatPatterns.Add(copy(SearchPattern, 1, i - 1));
FloatMasks.Add(copy(Mask, 1, i - 1));
Delete(SearchPattern, 1, i);
Delete(Mask, 1, i);
until SearchPattern = '';
end;
destructor TffSqlLikePattern.Destroy;
begin
FloatPatterns.Free;
FloatMasks.Free;
inherited;
end;
{!!.13 new}
function CharsDiffer(IgnoreCase: Boolean; C1, C2: Char): Boolean;
begin
if IgnoreCase then
Result := CharUpper(Pointer(C1)) <> CharUpper(Pointer(C2))
else
Result := C1 <> C2;
end;
function Match(const Pattern, Mask : string;
PatternLength : Integer;
const PTextToSearch : PAnsiChar;
const TextLen : Integer;
StartIndex : Integer;
IgnoreCase : Boolean {!!.13}
): Boolean;
{Modified !!.13}
{ Look for an exact match of the pattern at StartIndex, disregarding
locations with '_' in the mask.
Note: StartIndex is base zero. }
var
i : Integer;
begin
Result := True;
if TextLen < PatternLength then
Result := False
else
for i := 1 to PatternLength do
if (Mask[i] <> '_') and
{(PTextToSearch[StartIndex + i - 1] <> Pattern[i]) then begin} {!!.13}
CharsDiffer(IgnoreCase, PTextToSearch[StartIndex + i - 1], Pattern[i]) then begin {!!.13}
Result := False;
Break;
end; { if }
end;
function Scan(const Pattern, Mask : string;
PatternLength : Integer;
const PTextToSearch : PAnsiChar;
const TextLen : Integer;
StartIndex: Integer;
IgnoreCase: Boolean {!!.13}
) : Integer;
{Modified !!.13}
{ Scan for a match of the pattern starting at StartIndex, disregarding
locations with '_' in the mask. Return -1 if not found, otherwise
return the position immediately following the matched phrase. }
var
L, i : Integer;
Found : Boolean;
begin
L := TextLen - StartIndex;
repeat
if L < PatternLength then begin
Result := -1;
Exit;
end;
Found := True;
for i := 1 to PatternLength do
if (i - 1 > L) or (Mask[i] <> '_') and
{(PTextToSearch[i + StartIndex - 1] <> Pattern[i]) then begin} {!!.13}
CharsDiffer(IgnoreCase, PTextToSearch[i + StartIndex - 1], Pattern[i]) then begin {!!.13}
Found := False;
Break;
end;
if Found then begin
Result := StartIndex + PatternLength;
Exit;
end;
inc(StartIndex);
dec(L);
until False;
end;
function TffSqlLikePattern.Find(const TextToSearch: Variant;
IgnoreCase: Boolean {!!.13}
): Boolean;
{Rewritten !!.13}
{Search the TextToSearch. Return true if the search pattern was found}
var
TextLen,
LeadLen,
TrailLen,
i,
l,
StartPos,
EndPos: Integer;
VStr, P : string;
VPtr : PAnsiChar;
begin
Result := False;
try
if TVarData(TextToSearch).VType and VarTypeMask = varByte then begin
TextLen := VarArrayHighBound(TextToSearch, 1);
if TextLen = 0 then
Exit;
VStr := '';
VPtr := VarArrayLock(TextToSearch);
end
else begin
TextLen := Length(TextToSearch);
if TextLen = 0 then
Exit;
VStr := VarToStr(TextToSearch);
VPtr := PAnsiChar(VStr);
end;
LeadLen := Length(LeadPattern);
TrailLen := Length(TrailPattern);
if LeadLen > 0 then begin
{ If there is a lead pattern then see if there is a match. }
if not Match(LeadPattern, LeadMask, LeadLen, VPtr, TextLen, 0,
IgnoreCase) then begin {!!.13}
{ No match so exit. }
Result := False;
Exit;
end;
{ There was a match so set the starting position for the next match. }
StartPos := LeadLen;
end else
{ No lead pattern. Next match starts at beginning of string. }
StartPos := 0;
if TrailLen > 0 then begin
{ There is a trail pattern. Does it overlap with the lead pattern? }
i := TextLen - TrailLen;
if i < StartPos then begin
{ Yes it overlaps. A match is not possible so exit. }
Result := False;
Exit;
end;
if not Match(TrailPattern, TrailMask, TrailLen, VPtr, TextLen, i,
IgnoreCase) then begin {!!.13}
Result := False;
Exit;
end;
EndPos := i - 1;
end else
EndPos := TextLen - 1;
if FloatPatterns.Count = 0 then
if TextLen <> LeadLen + TrailLen then begin
Result := False;
Exit;
end;
for i := 0 to pred(FloatPatterns.Count) do begin
P := FloatPatterns[i];
l := Length(P);
{ If the length of the float pattern is greater than the number of
characters left in the string then a match is not possible. }
if l > EndPos - StartPos + 1 then begin
Result := False;
Exit;
end;
StartPos := Scan(P, FloatMasks[i], l, VPtr, TextLen, StartPos, IgnoreCase); {!!.13}
if StartPos = -1 then begin
Result := False;
Exit;
end;
end;
Result := True;
finally
if VStr = '' then
VarArrayUnlock(TextToSearch);
end;
end;
{===TffSqlLikeClause=================================================}
function TffSqlLikeClause.AsBoolean(const TestValue: Variant): Boolean;
begin
if VarIsNull(TestValue) then begin
Result := Negated;
exit;
end;
if LikePattern = nil then
if EscapeExp <> nil then
LikePattern := TffSqlLikePattern.Create(SimpleExp.GetValue, EscapeExp.GetValue)
else
LikePattern := TffSqlLikePattern.Create(SimpleExp.GetValue, '');
Result := LikePattern.Find(TestValue, IgnoreCase) xor Negated; {!!.13}
if not IsConstant then begin
LikePattern.Free;
LikePattern := nil;
end;
end;
{--------}
procedure TffSqlLikeClause.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlLikeClause then begin
if SimpleExp = nil then
SimpleExp := TffSqlSimpleExpression.Create(Self);
SimpleExp.Assign(TffSqlLikeClause(Source).SimpleExp);
if (EscapeExp = nil) and (TffSqlLikeClause(Source).EscapeExp <> nil) then begin
EscapeExp := TffSqlSimpleExpression.Create(Self);
EscapeExp.Assign(TffSqlLikeClause(Source).EscapeExp);
end;
Negated := TffSqlLikeClause(Source).Negated;
end else
AssignError(Source);
end;
function TffSqlLikeClause.CanLimit: Boolean;
var
S: string;
begin
Result := False;
if not Limited
and not IgnoreCase {!!.13}
and SimpleExp.IsConstant
and ((EscapeExp = nil) {or EscapeExp.IsConstant}) then begin {!!.11}
S := SimpleExp.GetValue;
if not (S[1] in ['%', '_']) then
Result := (GetHighLimit <> '');
end;
end;
function TffSqlLikeClause.CanReplaceWithCompare: Boolean;
var
S: string;
begin
Result := False;
if not Limited
and not IgnoreCase {!!.13}
and SimpleExp.IsConstant
and ((EscapeExp = nil) {or EscapeExp.IsConstant}) then begin {!!.11}
S := SimpleExp.GetValue;
Result := (PosCh('_', S) = 0)
and (length(S) > 1)
and (PosCh('%', S) = length(S));
end;
end;
procedure TffSqlLikeClause.CheckIsConstant;
begin
FIsConstantChecked := True;
FIsConstant := SimpleExp.IsConstant and ((EscapeExp = nil) or EscapeExp.IsConstant);
end;
{--------}
function TffSqlLikeClause.DependsOn(Table: TFFSqlTableProxy): Boolean;
begin
Result := SimpleExp.DependsOn(Table);
end;
destructor TffSqlLikeClause.Destroy;
begin
SimpleExp.Free;
EscapeExp.Free;
LikePattern.Free;
if FBmTable <> nil then {!!.11}
Dispose(FBmTable); {!!.11}
inherited;
end;
{--------}
procedure TffSqlLikeClause.EmitSQL(Stream: TStream);
begin
if Negated then
WriteStr(Stream,' NOT');
WriteStr(Stream, ' LIKE ');
SimpleExp.EmitSQL(Stream);
if EscapeExp <> nil then begin
WriteStr(Stream,' ESCAPE');
EscapeExp.EmitSQL(Stream);
end;
end;
{--------}
procedure TffSqlLikeClause.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
EnumMethod(Self);
SimpleExp.EnumNodes(EnumMethod, Deep);
if EscapeExp <> nil then
EscapeExp.EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlLikeClause.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlLikeClause)
and (Negated = TffSqlLikeClause(Other).Negated)
and (SimpleExp.Equals(TffSqlLikeClause(Other).SimpleExp))
and (BothNil(EscapeExp, TffSqlLikeClause(Other).EscapeExp)
or (BothNonNil(EscapeExp, TffSqlLikeClause(Other).EscapeExp)
and EscapeExp.Equals(TffSqlLikeClause(Other).EscapeExp)));
end;
{--------}
{!!.11 new}
function TffSqlLikeClause.GetBmTable: PBTable;
var
S: string;
begin
if FBmTable = nil then begin
Assert(IsBMCompatible);
if IgnoreCase then {!!.13}
S := AnsiUpperCase(SimpleExp.GetValue) {!!.13}
else {!!.13}
S := SimpleExp.GetValue;
New(FBmTable);
FBMPhrase := copy(S, 2, length(S) - 2);
BMMakeTableS(FBmPhrase, FBmTable^);
end;
Result := FBmTable;
end;
function TffSqlLikeClause.GetHighLimit: string;
var
i: Integer;
begin
Result := GetLowLimit;
i := length(Result);
if Result[i] in [' '..'~'] then
inc(Result[i])
else
Result := '';
end;
function TffSqlLikeClause.GetLowLimit: string;
var
P : Integer;
begin
Result := SimpleExp.GetValue;
P := 1;
while (P <= length(Result))
and not (Result[P] in ['%', '_']) do
inc(P);
dec(P);
if P < length(Result) then
Result := copy(Result, 1 , P);
end;
{!!.11 new}
procedure TffSqlLikeClause.CheckBMCompat;
var
S: string;
Len,
Inx : Integer;
begin
FBMCompat := False;
if SimpleExp.IsConstant and (EscapeExp = nil) then begin
S := SimpleExp.GetValue;
Len := Length(S);
FBMCompat := (Len >= 3) and
(S[1] = '%') and
(S[Len] = '%');
{ Verify there is not another wildcard character in the middle of the
string. }
for Inx := 2 to Pred(Len) do
if S[Inx] = '%' then begin
FBMCompat := False;
Break;
end;
end;
BMCompatChecked := True;
end;
{!!.11 new}
function TffSqlLikeClause.IsBMCompatible: Boolean;
begin
if not BMCompatChecked then
CheckBMCompat;
Result := FBMCompat;
end;
function TffSqlLikeClause.IsConstant: Boolean;
begin
if not FIsConstantChecked then
CheckIsConstant;
Result := FIsConstant;
end;
{--------}
procedure TffSqlLikeClause.MatchType(ExpectedType: TffFieldType);
begin
case ExpectedType of
fftChar, fftWideChar,
fftShortString..fftWideString :
SimpleExp.MatchType(ExpectedType);
fftBLOB..fftBLOBTypedBin : {!!.11}
SimpleExp.MatchType(fftNullAnsiStr); {!!.11}
else
SQLError(Format('The LIKE operator may not be applied to %s fields', {!!.11}
[FieldDataTypes[ExpectedType]])); {!!.11}
end;
end;
{--------}
function TffSqlLikeClause.Reduce: Boolean;
begin
Result := SimpleExp.Reduce or ((EscapeExp <> nil) and EscapeExp.Reduce);
end;
procedure TffSqlLikeClause.ResetConstant;
begin
FIsConstantChecked := False;
FIsConstant := False;
end;
{====================================================================}
{===TffSqlInClause===================================================}
function TffSqlInClause.AsBoolean(const TestValue: Variant): Boolean;
begin
if SubQuery <> nil then
Result := SubQuery.CheckForValue(TestValue)
else
Result := SimpleExpList.Contains(TestValue);
Result := Result xor Negated;
end;
{--------}
procedure TffSqlInClause.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlInClause then begin
SimpleExpList.Free;
SimpleExpList := nil; {!!.12}
SubQuery.Free;
SubQuery := nil; {!!.12}
if TffSqlInClause(Source).SubQuery <> nil then begin
SubQuery := TffSqlSELECT.Create(Self);
SubQuery.Assign(TffSqlInClause(Source).SubQuery);
end else begin
SimpleExpList := TffSqlSimpleExpressionList.Create(Self);
SimpleExpList.Assign(TffSqlInClause(Source).SimpleExpList);
end;
Negated := TffSqlInClause(Source).Negated;
end else
AssignError(Source);
end;
procedure TffSqlInClause.CheckIsConstant;
begin
FIsConstantChecked := True;
if SubQuery <> nil then
FIsConstant := False
else
FIsConstant := SimpleExpList.IsConstant;
end;
{--------}
function TffSqlInClause.DependsOn(Table: TFFSqlTableProxy): Boolean;
begin
if SubQuery <> nil then
Result := SubQuery.DependsOn(Table)
else
Result := SimpleExpList.DependsOn(Table);
end;
destructor TffSqlInClause.Destroy;
begin
SubQuery.Free;
SimpleExpList.Free;
inherited;
end;
{--------}
procedure TffSqlInClause.EmitSQL(Stream: TStream);
begin
if Negated then
WriteStr(Stream,' NOT');
WriteStr(Stream, ' IN (');
if SubQuery <> nil then
SubQuery.EmitSQL(Stream)
else
SimpleExpList.EmitSQL(Stream);
WriteStr(Stream, ') ');
end;
{--------}
procedure TffSqlInClause.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
EnumMethod(Self);
if SubQuery <> nil then
SubQuery.EnumNodes(EnumMethod, Deep)
else
SimpleExpList.EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlInClause.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlInClause)
and (Negated = TffSqlInClause(Other).Negated);
if Result then
if SubQuery <> nil then
if TffSqlInClause(Other).SubQuery = nil then
Result := False
else
Result := SubQuery.Equals(TffSqlInClause(Other).SubQuery)
else
if TffSqlInClause(Other).SimpleExpList = nil then
Result := False
else
Result := SimpleExpList.Equals(TffSqlInClause(Other).SimpleExpList);
end;
{--------}
function TffSqlInClause.IsConstant: Boolean;
begin
if not FIsConstantChecked then
CheckIsConstant;
Result := FIsConstant;
end;
procedure TffSqlInClause.MatchType(ExpectedType: TffFieldType);
begin
if SubQuery <> nil then
SubQuery.MatchType(ExpectedType, True)
else
SimpleExpList.MatchType(ExpectedType);
end;
{--------}
function TffSqlInClause.Reduce: Boolean;
begin
if SubQuery <> nil then
Result := SubQuery.Reduce
else
Result := SimpleExpList.Reduce;
end;
procedure TffSqlInClause.ResetConstant;
begin
FIsConstantChecked := False;
FIsConstant := False;
end;
{====================================================================}
function SimpleCompare(RelOp: TffSqlRelOp; const Val1, Val2: Variant): Boolean;
const
ValIsBLOBArray : array[boolean, boolean] of Byte =
( (1, { false, false }
2), { false, true }
(3, { true, false }
4) { true, true }
);
var
VStr : string;
VPtr1, VPtr2 : PAnsiChar;
Inx, VPtr1Len, VPtr2Len : Integer;
VPtr1Locked, VPtr2Locked : Boolean;
ValIsBLOBCase : Byte;
begin
if VarIsNull(Val1) or
VarIsNull(Val2) then begin
Result := False;
Exit;
end;
Assert(RelOp <> roNone);
ValIsBLOBCase := ValIsBLOBArray[VarIsArray(Val1) and
(TVarData(Val1).VType and VarTypeMask = varByte),
VarIsArray(Val2) and
(TVarData(Val2).VType and VarTypeMask = varByte)];
if ValIsBLOBCase = 1 then
case RelOp of
roEQ :
if (VarType(Val1) and VarTypeMask = VarDate)
and (VarType(Val2) and VarTypeMask = VarDate) then
Result := abs(double(Val1) - double(Val2)) < TimeDelta
else
Result := Val1 = Val2;
roLE :
Result := Val1 <= Val2;
roL :
Result := Val1 < Val2;
roG :
Result := Val1 > Val2;
roGE :
Result := Val1 >= Val2;
else//roNE :
if (VarType(Val1) and VarTypeMask = VarDate)
and (VarType(Val2) and VarTypeMask = VarDate) then
Result := abs(double(Val1) - double(Val2)) >= TimeDelta
else
Result := Val1 <> Val2;
end { case }
else begin
{ One of the parameters is a BLOB. It must be converted to a string.
This code is kind of flaky in that it is a duplicate of the preceding
section. However, this approach should give us optimal performance for
cases where neither parameter is a BLOB. }
VPtr1 := nil;
VPtr2 := nil;
VPtr1Locked := False;
VPtr2Locked := False;
try
case ValIsBLOBCase of
2 : begin
VStr := VarToStr(Val1);
VPtr1 := PAnsiChar(VStr);
VPtr1Len := Length(VStr);
VPtr2 := VarArrayLock(Val2);
VPtr2Locked := True;
VPtr2Len := VarArrayHighBound(Val2, 1);
end;
3 : begin
VPtr1 := VarArrayLock(Val1);
VPtr1Locked := True;
VPtr1Len := VarArrayHighBound(Val1, 1);
VStr := VarToStr(Val2);
VPtr2 := PAnsiChar(VStr);
VPtr2Len := Length(VStr);
end;
4 : begin
VPtr1 := VarArrayLock(Val1);
VPtr1Locked := True;
VPtr1Len := VarArrayHighBound(Val1, 1);
VPtr2 := VarArrayLock(Val2);
VPtr2Locked := True;
VPtr2Len := VarArrayHighBound(Val2, 1);
end;
else begin
VPtr1Len := 0;
VPtr2Len := 0;
end;
end; { case }
Inx := Windows.CompareStringA(LOCALE_USER_DEFAULT, 0,
VPtr1, VPtr1Len, VPtr2, VPtr2Len) - 2;
case RelOp of
roEQ : Result := (Inx = 0);
roLE : Result := (Inx <= 0);
roL : Result := (Inx < 0);
roG : Result := (Inx > 0);
roGE : Result := (Inx >= 0);
else
{ roNE }
Result := (Inx <> 0);
end; { case }
finally
if VPtr1Locked then
VarArrayUnlock(Val1);
if VPtr2Locked then
VarArrayUnlock(Val2);
end;
end; { if..else }
end;
{===TffSqlCondPrimary================================================}
function TffSqlCondPrimary.AsBoolean: Boolean;
var
F: TffSqlFieldProxy; {!!.11}
BMTable: PBTable; {!!.13}
begin
Result := False;
if IsConstant then begin
Result := ConstantValue;
exit;
end;
if not TypeChecked then
CheckType;
if RelOp = roNone then
if BetweenClause <> nil then
Result := BetweenClause.AsBoolean(SimpleExp1.GetValue)
else
if LikeClause <> nil then
if SimpleExp1.IsField(F) and LikeClause.IsBMCompatible then begin {!!.11}{!!.13}
{Need to call BMTable before method call - otherwise BMPhrase doesn't get initialized in time}
BMTable := LikeClause.BMTable;
Result := F.BMMatch(BMTable^, LikeClause.BMPhrase, LikeClause.IgnoreCase) {!!.11}{!!.13}
end else {!!.11}{!!.13}
Result := LikeClause.AsBoolean(SimpleExp1.GetValue)
else
if InClause <> nil then
Result := InClause.AsBoolean(SimpleExp1.GetValue)
else
if IsTest <> nil then
Result := IsTest.Evaluate(SimpleExp1)
else
if ExistsClause <> nil then
Result := ExistsClause.AsBoolean
else
if UniqueClause <> nil then
Result := UniqueClause.AsBoolean
else
if MatchClause <> nil then
Result := MatchClause.AsBoolean(SimpleExp1.GetValue)
else
Result := SimpleExp1.GetValue
else
if SimpleExp2 <> nil then
Result := SimpleCompare(RelOp, SimpleExp1.GetValue, SimpleExp2.GetValue)
else
if AllOrAnyClause <> nil then
Result := AllOrAnyClause.Compare(RelOp, SimpleExp1.GetValue)
else
SQLError('Simple expression or ANY/ALL clause expected');
end;
{--------}
procedure TffSqlCondPrimary.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlCondPrimary then begin
Clear;
if assigned(TffSqlCondPrimary(Source).SimpleExp1) then begin
SimpleExp1 := TffSqlSimpleExpression.Create(Self);
SimpleExp1.Assign(TffSqlCondPrimary(Source).SimpleExp1);
end;
RelOp := TffSqlCondPrimary(Source).RelOp;
if assigned(TffSqlCondPrimary(Source).SimpleExp2) then begin
SimpleExp2 := TffSqlSimpleExpression.Create(Self);
SimpleExp2.Assign(TffSqlCondPrimary(Source).SimpleExp2);
end;
if assigned(TffSqlCondPrimary(Source).BetweenClause) then begin
BetweenClause := TffSqlBetweenClause.Create(Self);
BetweenClause.Assign(TffSqlCondPrimary(Source).BetweenClause);
end;
if assigned(TffSqlCondPrimary(Source).LikeClause) then begin
LikeClause := TffSqlLikeClause.Create(Self);
LikeClause.Assign(TffSqlCondPrimary(Source).LikeClause);
end;
if assigned(TffSqlCondPrimary(Source).InClause) then begin
InClause := TffSqlInClause.Create(Self);
InClause.Assign(TffSqlCondPrimary(Source).InClause);
end;
if assigned(TffSqlCondPrimary(Source).IsTest) then begin
IsTest := TffSqlIsTest.Create(Self);
IsTest.Assign(TffSqlCondPrimary(Source).IsTest);
end;
if assigned(TffSqlCondPrimary(Source).AllOrAnyClause) then begin
AllOrAnyClause := TffSqlAllOrAnyClause.Create(Self);
AllOrAnyClause.Assign(TffSqlCondPrimary(Source).AllOrAnyClause);
end;
if assigned(TffSqlCondPrimary(Source).ExistsClause) then begin
ExistsClause := TffSqlExistsClause.Create(Self);
ExistsClause.Assign(TffSqlCondPrimary(Source).ExistsClause);
end;
if assigned(TffSqlCondPrimary(Source).UniqueClause) then begin
UniqueClause := TffSqlUniqueClause.Create(Self);
UniqueClause.Assign(TffSqlCondPrimary(Source).UniqueClause);
end;
if assigned(TffSqlCondPrimary(Source).MatchClause) then begin
MatchClause := TffSqlMatchClause.Create(Self);
MatchClause.Assign(TffSqlCondPrimary(Source).MatchClause);
end;
end else
AssignError(Source);
end;
{--------}
procedure TffSqlCondPrimary.BindHaving;
begin
if SimpleExp1 <> nil then
SimpleExp1.BindHaving;
case RelOp of
roNone :
if BetweenClause <> nil then
SQLError('BETWEEN not supported in a HAVING clause')
else
if LikeClause <> nil then
SQLError('LIKE not supported in a HAVING clause')
else
if InClause <> nil then
SQLError('IN not supported in a HAVING clause')
else
{if IsTest <> nil then
SQLError('IS not supported in a HAVING clause')
else} {!!.11}
if ExistsClause <> nil then
SQLError('EXISTS not supported in a HAVING clause')
else
if UniqueClause <> nil then
SQLError('UNIQUE not supported in a HAVING clause')
else
if MatchClause <> nil then
SQLError('MATCH not supported in a HAVING clause');
else
if AllOrAnyClause <> nil then
//SQLError('ANY or ALL conditions not supported in a HAVING clause')
else begin
Assert(SimpleExp2 <> nil);
SimpleExp2.BindHaving;
end;
end;
end;
procedure TffSqlCondPrimary.CheckIsConstant;
begin
FIsConstantChecked := True;
FIsConstant := False;
if SimpleExp1 <> nil then
if not SimpleExp1.IsConstant then
exit;
case RelOp of
roNone :
if BetweenClause <> nil then
if not BetweenClause.IsConstant then
exit
else
else
if LikeClause <> nil then
if not LikeClause.IsConstant then
exit
else
else
if InClause <> nil then
if not InClause.IsConstant then
exit
else
else
if IsTest <> nil then
// constant by definition
else
if ExistsClause <> nil then
exit
else
if UniqueClause <> nil then
exit
else
if MatchClause <> nil then
exit;
else
if AllOrAnyClause <> nil then
exit
else begin
Assert(SimpleExp2 <> nil);
if not SimpleExp2.IsConstant then
exit;
end;
end;
ConstantValue := GetValue;
FIsConstant := True;
end;
procedure TffSqlCondPrimary.CheckType;
var
T1 : TffFieldType;
begin
if SimpleExp1 <> nil then
T1 := SimpleExp1.GetType
else
T1 := fftBLOB; {anything that doesn't match a valid SQL type}
case RelOp of
roNone :
if BetweenClause <> nil then
BetweenClause.MatchType(T1)
else
if LikeClause <> nil then
LikeClause.MatchType(T1)
else
if InClause <> nil then
InClause.MatchType(T1)
else
if IsTest <> nil then
IsTest.MatchType(T1)
else
if ExistsClause <> nil then
//T1 := ExistsClause.GetType
else
if UniqueClause <> nil then
//T1 := UniqueClause.GetType
else
if MatchClause <> nil then
MatchClause.MatchType(T1);
//else
// if T1 <> fftBoolean then
// TypeMismatch;
else
if AllOrAnyClause <> nil then
AllOrAnyClause.MatchType(T1)
else begin
Assert(SimpleExp2 <> nil);
SimpleExp2.MatchType(T1);
end;
end;
TypeChecked := True;
end;
{--------}
procedure TffSqlCondPrimary.Clear;
begin
SimpleExp1.Free;
SimpleExp1 := nil;
BetweenClause.Free;
BetweenClause := nil;
LikeClause.Free;
LikeClause := nil;
InClause.Free;
InClause := nil;
IsTest.Free;
IsTest := nil;
ExistsClause.Free;
ExistsClause := nil;
UniqueClause.Free;
UniqueClause := nil;
MatchClause.Free;
MatchClause := nil;
AllOrAnyClause.Free;
AllOrAnyClause := nil;
SimpleExp2.Free;
SimpleExp2 := nil;
inherited;
end;
{--------}
function TffSqlCondPrimary.DependsOn(Table: TFFSqlTableProxy): Boolean;
begin
Result := False;
case RelOp of
roNone :
if BetweenClause <> nil then
Result := SimpleExp1.DependsOn(Table) or BetweenClause.DependsOn(Table)
else
if LikeClause <> nil then
Result := SimpleExp1.DependsOn(Table) or LikeClause.DependsOn(Table)
else
if InClause <> nil then
Result := SimpleExp1.DependsOn(Table) or InClause.DependsOn(Table)
else
if IsTest <> nil then
Result := SimpleExp1.DependsOn(Table)
else
if ExistsClause <> nil then
Result := ExistsClause.DependsOn(Table)
else
if UniqueClause <> nil then
Result := UniqueClause.DependsOn(Table)
else
if MatchClause <> nil then
Result := SimpleExp1.DependsOn(Table) or MatchClause.DependsOn(Table)
else
Result := SimpleExp1.DependsOn(Table);
else //roEQ, roLE, roL, roG, roGE, roNE :
if SimpleExp2 <> nil then
Result := SimpleExp1.DependsOn(Table) or SimpleExp2.DependsOn(Table)
else
if AllOrAnyClause <> nil then
Result := SimpleExp1.DependsOn(Table) or AllOrAnyClause.DependsOn(Table)
else
SQLError('Simple expression or ANY/ALL clause expected');
end;
if AllOrAnyClause <> nil then
Result := Result or AllOrAnyClause.DependsOn(Table);
end;
destructor TffSqlCondPrimary.Destroy;
begin
Clear;
inherited;
end;
procedure TffSqlCondPrimary.EmitSQL(Stream: TStream);
begin
if SimpleExp1 <> nil then
SimpleExp1.EmitSQL(Stream);
case RelOp of
roNone :
if BetweenClause <> nil then
BetweenClause.EmitSQL(Stream)
else
if LikeClause <> nil then
LikeClause.EmitSQL(Stream)
else
if InClause <> nil then
InClause.EmitSQL(Stream)
else
if IsTest <> nil then
IsTest.EmitSQL(Stream)
else
if ExistsClause <> nil then
ExistsClause.EmitSQL(Stream)
else
if UniqueClause <> nil then
UniqueClause.EmitSQL(Stream)
else
if MatchClause <> nil then
MatchClause.EmitSQL(Stream);
else
WriteStr(Stream,' ');
WriteStr(Stream, RelOpStr[RelOp]);
WriteStr(Stream,' ');
if AllOrAnyClause <> nil then
AllOrAnyClause.EmitSQL(Stream)
else
SimpleExp2.EmitSQL(Stream);
end;
end;
{--------}
procedure TffSqlCondPrimary.EnumNodes(EnumMethod: TffSqlEnumMethod;
const Deep: Boolean);
begin
EnumMethod(Self);
if SimpleExp1 <> nil then
SimpleExp1.EnumNodes(EnumMethod, Deep);
case RelOp of
roNone :
if BetweenClause <> nil then
BetweenClause.EnumNodes(EnumMethod, Deep)
else
if LikeClause <> nil then
LikeClause.EnumNodes(EnumMethod, Deep)
else
if InClause <> nil then
InClause.EnumNodes(EnumMethod, Deep)
else
if IsTest <> nil then
IsTest.EnumNodes(EnumMethod, Deep)
else
if MatchClause <> nil then
MatchClause.EnumNodes(EnumMethod, Deep)
else
if ExistsClause <> nil then
ExistsClause.EnumNodes(EnumMethod, Deep)
else
if UniqueClause <> nil then
UniqueClause.EnumNodes(EnumMethod, Deep);
else
if SimpleExp2 <> nil then
SimpleExp2.EnumNodes(EnumMethod, Deep)
else
if AllOrAnyClause <> nil then
AllOrAnyClause.EnumNodes(EnumMethod, Deep);
end;
end;
{--------}
function TffSqlCondPrimary.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlCondPrimary)
and (RelOp = TffSqlCondPrimary(Other).RelOp)
and (
BothNil(SimpleExp1, TffSqlCondPrimary(Other).SimpleExp1)
or (
BothNonNil(SimpleExp1, TffSqlCondPrimary(Other).SimpleExp1)
and SimpleExp1.Equals(TffSqlCondPrimary(Other).SimpleExp1)
)
)
and (
BothNil(SimpleExp2, TffSqlCondPrimary(Other).SimpleExp2)
or (
BothNonNil(SimpleExp2, TffSqlCondPrimary(Other).SimpleExp2)
and SimpleExp2.Equals(TffSqlCondPrimary(Other).SimpleExp2)
)
)
and (
BothNil(BetweenClause, TffSqlCondPrimary(Other).BetweenClause)
or (
BothNonNil(BetweenClause, TffSqlCondPrimary(Other).BetweenClause)
and BetweenClause.Equals(TffSqlCondPrimary(Other).BetweenClause)
)
)
and (
BothNil(LikeClause, TffSqlCondPrimary(Other).LikeClause)
or (
BothNonNil(LikeClause, TffSqlCondPrimary(Other).LikeClause)
and LikeClause.Equals(TffSqlCondPrimary(Other).LikeClause)
)
)
and (
BothNil(InClause, TffSqlCondPrimary(Other).InClause)
or (
BothNonNil(InClause, TffSqlCondPrimary(Other).InClause)
and InClause.Equals(TffSqlCondPrimary(Other).InClause)
)
)
and (
BothNil(IsTest, TffSqlCondPrimary(Other).IsTest)
or (
BothNonNil(IsTest, TffSqlCondPrimary(Other).IsTest)
and IsTest.Equals(TffSqlCondPrimary(Other).IsTest)
)
)
and (
BothNil(AllOrAnyClause, TffSqlCondPrimary(Other).AllOrAnyClause)
or (
BothNonNil(AllOrAnyClause, TffSqlCondPrimary(Other).AllOrAnyClause)
and AllOrAnyClause.Equals(TffSqlCondPrimary(Other).AllOrAnyClause)
)
)
and (
BothNil(ExistsClause, TffSqlCondPrimary(Other).ExistsClause)
or (
BothNonNil(ExistsClause, TffSqlCondPrimary(Other).ExistsClause)
and ExistsClause.Equals(TffSqlCondPrimary(Other).ExistsClause)
)
)
and (
BothNil(MatchClause, TffSqlCondPrimary(Other).MatchClause)
or (
BothNonNil(MatchClause, TffSqlCondPrimary(Other).MatchClause)
and MatchClause.Equals(TffSqlCondPrimary(Other).MatchClause)
)
)
and (
BothNil(UniqueClause, TffSqlCondPrimary(Other).UniqueClause)
or (
BothNonNil(UniqueClause, TffSqlCondPrimary(Other).UniqueClause)
and UniqueClause.Equals(TffSqlCondPrimary(Other).UniqueClause)
)
);
end;
{--------}
function TffSqlCondPrimary.GetDecimals: Integer;
begin
if SimpleExp1 <> nil then
Result := SimpleExp1.GetDecimals
else
Result := 0;
end;
{--------}
function TffSqlCondPrimary.GetSize: Integer;
begin
case RelOp of
roNone :
Result := SimpleExp1.GetSize
else
Result := 1;
end;
end;
{--------}
function TffSqlCondPrimary.GetTitle(const Qualified : Boolean): string; {!!.11}
begin
case GetType of
fftBoolean:
Result := 'COND'
else
Result := SimpleExp1.GetTitle(Qualified); {!!.11}
end;
end;
{--------}
function TffSqlCondPrimary.GetType: TffFieldType;
begin
if SimpleExp1 <> nil then
Result := SimpleExp1.GetType
else
Result := fftBoolean; {should never happen}
case RelOp of
roNone :
if (BetweenClause <> nil)
or (LikeClause <> nil)
or (InClause <> nil)
or (IsTest <> nil)
or (MatchClause <> nil) then
Result := fftBoolean;
else
if SimpleExp2 <> nil then
SimpleExp2.MatchType(Result);
Result := fftBoolean;
end;
end;
{--------}
function TffSqlCondPrimary.GetValue: Variant;
begin
if IsConstant then begin
Result := ConstantValue;
exit;
end;
case GetType of
fftBoolean:
Result := AsBoolean
else
Result := SimpleExp1.GetValue;
end;
end;
{--------}
function TffSqlCondPrimary.IsConstant: Boolean;
begin
if not FIsConstantChecked then
CheckIsConstant;
Result := FIsConstant;
end;
{--------}
function TffSqlCondPrimary.IsRelationTo(Table: TFFSqlTableProxy;
var FieldReferenced: TFFSqlFieldProxy;
var Operator: TffSqlRelOp;
var ArgExpression: TffSqlSimpleExpression;
var SameCase: Boolean): Boolean; {!!.10}
begin
ArgExpression := nil;
case RelOp of
roEQ, roLE, roL, roG, roGE, roNE :
begin
if SimpleExp2 <> nil then
if SimpleExp1.IsFieldFrom(Table, FieldReferenced, SameCase) then begin
Result := True;
ArgExpression := SimpleExp2;
end else
if SimpleExp2.IsFieldFrom(Table, FieldReferenced, SameCase) then begin
Result := True;
ArgExpression := SimpleExp1;
end else
Result := False
else {typically ANY or ALL relation}
Result := False;
end;
else
Result := False;
end;
if AllOrAnyClause <> nil then
Result := False;
Operator := RelOp;
end;
{--------}
function TffSqlCondPrimary.JustSimpleExpression: Boolean;
begin
Result := (RelOp = roNone)
and (BetweenClause = nil)
and (LikeClause = nil)
and (InClause = nil)
and (IsTest = nil)
and (ExistsClause = nil)
and (UniqueClause = nil)
and (MatchClause = nil);
end;
{!!.11 new}
procedure TffSqlCondPrimary.MatchType(ExpectedType: TffFieldType);
begin
case RelOp of
roNone :
if (BetweenClause <> nil)
or (LikeClause <> nil)
or (InClause <> nil)
or (IsTest <> nil)
or (ExistsClause <> nil) {!!.11}
or (MatchClause <> nil) then
if ExpectedType <> fftBoolean then
TypeMismatch
else
else
SimpleExp1.MatchType(ExpectedType);
else
if SimpleExp2 <> nil then begin
SimpleExp2.MatchType(SimpleExp1.GetType);
if ExpectedType <> fftBoolean then
TypeMismatch;
end;
end;
end;
function TffSqlCondPrimary.Reduce: Boolean;
begin
Result := True;
if (SimpleExp1 <> nil) and SimpleExp1.Reduce then
exit;
if (SimpleExp2 <> nil) and SimpleExp2.Reduce then
exit;
if (BetweenClause <> nil) and BetweenClause.Reduce then
exit;
if (LikeClause <> nil) and LikeClause.Reduce then
exit;
if (InClause <> nil) and InClause.Reduce then
exit;
if (ExistsClause <> nil) and ExistsClause.Reduce then
exit;
if (UniqueClause <> nil) and UniqueClause.Reduce then
exit;
if (MatchClause <> nil) and MatchClause.Reduce then
exit;
if (AllOrAnyClause <> nil) and AllOrAnyClause.Reduce then
exit;
Result := False;
end;
procedure TffSqlCondPrimary.ResetConstant;
begin
FIsConstantChecked := False;
FIsConstant := False;
end;
{====================================================================}
{===TffSqlCondFactor=================================================}
function TffSqlCondFactor.AsBoolean: Boolean;
begin
if TmpKnown then begin
Result := TmpValue;
exit;
end;
if IsConstant then begin
Result := ConstantValue;
exit;
end;
Result := CondPrimary.AsBoolean;
if UnaryNot then
Result := not Result;
end;
{--------}
procedure TffSqlCondFactor.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlCondFactor then begin
if CondPrimary = nil then
CondPrimary := TffSqlCondPrimary.Create(Self);
CondPrimary.Assign(TffSqlCondFactor(Source).CondPrimary);
UnaryNot := TffSqlCondFactor(Source).UnaryNot;
end else
AssignError(Source);
end;
procedure TffSqlCondFactor.BindHaving;
begin
CondPrimary.BindHaving;
end;
procedure TffSqlCondFactor.CheckIsConstant;
begin
FIsConstantChecked := True;
if CondPrimary.IsConstant then begin
ConstantValue := GetValue;
FIsConstant := True;
end;
end;
procedure TffSqlCondFactor.Clear;
begin
if CondPrimary <> nil then
CondPrimary.Clear;
end;
function TffSqlCondFactor.DependsOn(Table: TFFSqlTableProxy): Boolean;
begin
Result := CondPrimary.DependsOn(Table);
end;
destructor TffSqlCondFactor.Destroy;
begin
CondPrimary.Free;
inherited;
end;
procedure TffSqlCondFactor.EmitSQL(Stream: TStream);
begin
if UnaryNot then
WriteStr(Stream,' NOT');
CondPrimary.EmitSQL(Stream);
end;
{--------}
procedure TffSqlCondFactor.EnumNodes(EnumMethod: TffSqlEnumMethod;
const Deep: Boolean);
begin
EnumMethod(Self);
CondPrimary.EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlCondFactor.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlCondFactor)
and (UnaryNot = TffSqlCondFactor(Other).UnaryNot)
and (CondPrimary.Equals(TffSqlCondFactor(Other).CondPrimary));
end;
{--------}
function TffSqlCondFactor.GetDecimals: Integer;
begin
Result := CondPrimary.GetDecimals;
end;
{--------}
{!!.10}
function TffSqlCondFactor.GetSize: Integer;
begin
if UnaryNot then
Result := 1
else
Result := CondPrimary.GetSize;
end;
{--------}
function TffSqlCondFactor.GetTitle(const Qualified : Boolean): string; {!!.11}
begin
Result := CondPrimary.GetTitle(Qualified); {!!.11}
end;
{--------}
function TffSqlCondFactor.GetType: TffFieldType;
begin
if UnaryNot then
Result := fftBoolean
else
Result := CondPrimary.GetType;
end;
{--------}
function TffSqlCondFactor.GetValue: Variant;
begin
if TmpKnown then begin
Result := TmpValue;
exit;
end;
if IsConstant then begin
Result := ConstantValue;
exit;
end;
if UnaryNot then
Result := AsBoolean
else
Result := CondPrimary.GetValue;
end;
{--------}
function TffSqlCondFactor.IsConstant: Boolean;
begin
if not FIsConstantChecked then
CheckIsConstant;
Result := FIsConstant;
end;
{--------}
function TffSqlCondFactor.IsRelationTo(Table: TFFSqlTableProxy;
var FieldReferenced: TFFSqlFieldProxy;
var Operator: TffSqlRelOp;
var ArgExpression: TffSqlSimpleExpression;
var SameCase: Boolean): Boolean;
begin
ArgExpression := nil;
Result := CondPrimary.IsRelationTo(Table, FieldReferenced,
Operator, ArgExpression, SameCase)
and not ArgExpression.DependsOn(Table);
if Result and UnaryNot then
case Operator of
roNone : ;
roEQ : Operator := roNE;
roLE : Operator := roG;
roL : Operator := roGE;
roG : Operator := roLE;
roGE : Operator := roL;
roNE : Operator := roEQ;
end;
end;
{--------}
procedure TffSqlCondFactor.MarkTrue;
begin
TmpKnown := True;
TmpValue := True;
end;
{--------}
procedure TffSqlCondFactor.MarkUnknown;
begin
TmpKnown := False;
end;
{--------}
{!!.11 - new}
procedure TffSqlCondFactor.MatchType(ExpectedType: TffFieldType);
begin
if UnaryNot then
if ExpectedType <> fftBoolean then
TypeMismatch
else
else
CondPrimary.MatchType(ExpectedType);
end;
{--------}
function TffSqlCondFactor.Reduce: Boolean;
var
LiftPrimary : TffSqlCondPrimary;
NewExp: TffSqlSimpleExpression;
NewTerm: TffSqlTerm;
NewFactor: TffSqlFactor;
NewCondExp : TffSqlCondExp;
NewCondTerm: TffSqlCondTerm;
NewCondFactor : TffSqlCondFactor;
NewCondPrimary : TffSqlCondPrimary;
begin
{look for a conditional primary nested inside redundant parens}
{eliminate parens when found}
Result := False;
LiftPrimary := nil;
if (CondPrimary.RelOp = roNone) then
with CondPrimary do begin
//if SimpleExp1 <> nil then begin
if JustSimpleExpression then begin
with SimpleExp1 do
if TermCount = 1 then
with Term[0] do
if FactorCount = 1 then
with Factor[0] do
if CondExp <> nil then
with CondExp do
if CondTermCount = 1 then
with CondTerm[0] do
if CondFactorCount = 1 then
with CondFactor[0] do begin
LiftPrimary := TffSqlCondPrimary.Create(Self);
LiftPrimary.Assign(CondPrimary);
end;
if LiftPrimary <> nil then begin
Clear;
Assign(LiftPrimary);
LiftPrimary.Free;
Result := True;
end else
if Reduce then begin
{expression itself was reduced}
Result := True;
end;
end;
if not Result then
Result := Reduce;
end;
if not Result then begin {otherwise we'll be called again}
{see if this a negated simple expression which can be reversed}
if UnaryNot and (CondPrimary.RelOp <> roNone) then begin
{it is, reverse condition and remove NOT}
case CondPrimary.RelOp of
roEQ : CondPrimary.RelOp := roNE;
roLE : CondPrimary.RelOp := roG;
roL : CondPrimary.RelOp := roGE;
roG : CondPrimary.RelOp := roLE;
roGE: CondPrimary.RelOp := roL;
roNE : CondPrimary.RelOp := roEQ;
end;
UnaryNot := False;
Result := True;
end;
end;
if not Result then {otherwise we'll be called again}
if (CondPrimary.RelOp = roNE) { "<>" operator }
{can't optimize ALL/ANY clauses this way}
and (CondPrimary.AllOrAnyClause = nil) then {!!.11}
if CondPrimary.SimpleExp1.HasFieldRef
or CondPrimary.SimpleExp2.HasFieldRef then begin
{convert expressions of the form
Simple Exp1 <> Simple Exp2
where at least one expression contains a field reference
to
(Simple Exp1 < Simple Exp2 OR Simple Exp1 > Simple Exp2)
to allow for index optimization later on}
NewExp := TffSqlSimpleExpression.Create(CondPrimary);
NewTerm := TffSqlTerm.Create(NewExp);
NewFactor := TffSqlFactor.Create(NewTerm);
NewCondExp := TffSqlCondExp.Create(NewFactor);
NewCondTerm := TffSqlCondTerm.Create(NewCondExp);
NewCondFactor := TffSqlCondFactor.Create(NewCondTerm);
NewCondPrimary := TffSqlCondPrimary.Create(NewCondFactor);
NewCondPrimary.Assign(CondPrimary);
NewCondPrimary.RelOp := roL;
NewCondFactor.CondPrimary := NewCondPrimary;
NewCondTerm.AddCondFactor(NewCondFactor);
NewCondExp.AddCondTerm(NewCondTerm);
NewCondTerm := TffSqlCondTerm.Create(NewCondExp);
NewCondFactor := TffSqlCondFactor.Create(NewCondTerm);
NewCondPrimary := TffSqlCondPrimary.Create(NewCondFactor);
NewCondPrimary.Assign(CondPrimary);
NewCondPrimary.RelOp := roG;
NewCondFactor.CondPrimary := NewCondPrimary;
NewCondTerm.AddCondFactor(NewCondFactor);
NewCondExp.AddCondTerm(NewCondTerm);
NewFactor.CondExp := NewCondExp;
NewTerm.AddFactor(NewFactor);
NewExp.AddTerm(NewTerm);
CondPrimary.SimpleExp2.Free;
CondPrimary.SimpleExp2 := nil;
CondPrimary.RelOp := roNone;
CondPrimary.SimpleExp1.Assign(NewExp);
NewExp.Free;
Result := True;
end;
if not Result then {!!.11}
Result := CondPrimary.Reduce; {!!.11}
end;
{--------}
procedure TffSqlCondFactor.ResetConstant;
begin
FIsConstantChecked := False;
FIsConstant := False;
end;
{====================================================================}
{===TffSqlFloatLiteral===============================================}
procedure TffSqlFloatLiteral.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlFloatLiteral then begin
Value := TffSqlFloatLiteral(Source).Value;
end else
AssignError(Source);
end;
procedure TffSqlFloatLiteral.ConvertToNative;
var
Code : Integer;
begin
case GetType of
fftSingle :
Val(Value, SingleValue, Code);
fftDouble :
Val(Value, DoubleValue, Code);
fftExtended :
Val(Value, ExtendedValue, Code);
fftComp :
Val(Value, Comp(CompValue), Code);
fftCurrency :
begin
FFValCurr(Value, CurrencyValue, Code);
end;
end;
Converted := Code = 0;
end;
procedure TffSqlFloatLiteral.EmitSQL(Stream: TStream);
begin
WriteStr(Stream, Value);
end;
{--------}
procedure TffSqlFloatLiteral.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
EnumMethod(Self);
end;
{--------}
function TffSqlFloatLiteral.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlFloatLiteral)
and (AnsiCompareText(Value, TffSqlFloatLiteral(Other).Value) = 0);
end;
{--------}
function TffSqlFloatLiteral.GetDecimals: Integer;
begin
Result := 2;
end;
{--------}
function TffSqlFloatLiteral.GetType: TffFieldType;
begin
Result := fftDouble;
end;
{--------}
function TffSqlFloatLiteral.GetValue: Variant;
begin
if not Converted then
ConvertToNative;
case GetType of
fftSingle :
Result := SingleValue;
fftDouble :
Result := DoubleValue;
fftExtended :
Result := ExtendedValue;
fftComp :
Result := Comp(CompValue);
fftCurrency :
Result := CurrencyValue;
end;
end;
{--------}
procedure TffSqlFloatLiteral.MatchType(ExpectedType: TffFieldType);
begin
case ExpectedType of
fftByte..fftAutoInc :
;
fftSingle..fftCurrency :
;
else
TypeMismatch;
end;
end;
{====================================================================}
{===TffSqlIntegerLiteral=============================================}
procedure TffSqlIntegerLiteral.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlIntegerLiteral then begin
Value := TffSqlIntegerLiteral(Source).Value;
end else
AssignError(Source);
end;
procedure TffSqlIntegerLiteral.EmitSQL(Stream: TStream);
begin
WriteStr(Stream, Value);
end;
{--------}
procedure TffSqlIntegerLiteral.EnumNodes(EnumMethod: TffSqlEnumMethod;
const Deep: Boolean);
begin
EnumMethod(Self);
end;
{--------}
function TffSqlIntegerLiteral.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlIntegerLiteral)
and (AnsiCompareText(Value, TffSqlFloatLiteral(Other).Value) = 0);
end;
{--------}
function TffSqlIntegerLiteral.GetType: TffFieldType;
begin
Result := fftInt32;
end;
procedure TffSqlIntegerLiteral.ConvertToNative;
begin
Int32Value := StrToInt(Value);
Converted := True;
end;
function TffSqlIntegerLiteral.GetValue: Variant;
begin
if not Converted then
ConvertToNative;
Result := Int32Value;
end;
{--------}
procedure TffSqlIntegerLiteral.MatchType(ExpectedType: TffFieldType);
begin
case ExpectedType of
fftByte..fftCurrency :
;
fftShortString..fftWideString :
;
else
TypeMismatch;
end;
end;
{====================================================================}
{===TffSqlStringLiteral==============================================}
procedure TffSqlStringLiteral.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlStringLiteral then begin
Value := TffSqlStringLiteral(Source).Value;
end else
AssignError(Source);
end;
procedure TffSqlStringLiteral.ConvertToNative;
var
S : string;
P : Integer;
begin
S := copy(Value, 2, length(Value) - 2); //strip quotes
{convert internal double-quotes to single quotes}
P := pos('''''', S);
while P <> 0 do begin
Delete(S, P, 1);
P := pos('''''', S);
end;
Assert(GetType in [fftChar, fftWideChar,
fftShortString..fftWideString]);
case GetType of
fftChar :
CharValue := S[1];
fftWideChar :
WideCharValue := WideChar(S[1]);
fftShortString :
ShortStringValue := S;
fftShortAnsiStr :
ShortAnsiStringValue := S;
fftNullString :
NullStringValue := PChar(S);
fftNullAnsiStr :
NullAnsiStrValue := PChar(S);
fftWideString :
WideStringValue := S;
end;
Converted := True;
end;
{--------}
constructor TffSqlStringLiteral.Create(AParent: TffSqlNode);
begin
inherited Create(AParent);
FType := fftNullAnsiStr; {!!.11}
end;
{--------}
procedure TffSqlStringLiteral.EmitSQL(Stream: TStream);
begin
WriteStr(Stream, Value);
end;
{--------}
procedure TffSqlStringLiteral.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
EnumMethod(Self);
end;
{--------}
function TffSqlStringLiteral.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlStringLiteral)
and (AnsiCompareText(Value, TffSqlStringLiteral(Other).Value) = 0);
end;
{--------}
function TffSqlStringLiteral.GetSize: Integer;
begin
if not Converted then
ConvertToNative;
Assert(GetType in [fftChar..fftWideString]);
case GetType of
fftChar :
Result := 1;
fftWideChar :
Result := 2;
fftShortString :
Result := length(ShortStringValue);
fftShortAnsiStr :
Result := length(ShortAnsiStringValue);
fftNullString :
Result := length(NullStringValue{^});
fftNullAnsiStr :
Result := length(NullAnsiStrValue);
else //fftWideString :
Result := length(WideStringValue);
end;
end;
{--------}
function TffSqlStringLiteral.GetType: TffFieldType;
begin
Result := FType;
end;
{--------}
function TffSqlStringLiteral.GetValue: Variant;
begin
if not Converted then
ConvertToNative;
Assert(GetType in [fftChar..fftWideString]);
case GetType of
fftChar :
Result := CharValue;
fftWideChar :
Result := WideCharValue;
fftShortString :
Result := ShortStringValue;
fftShortAnsiStr :
Result := ShortAnsiStringValue;
fftNullString :
Result := NullStringValue{^};
fftNullAnsiStr :
Result := NullAnsiStrValue;
fftWideString :
Result := WideStringValue;
end;
end;
{--------}
procedure TffSqlStringLiteral.MatchType(ExpectedType: TffFieldType);
begin
case ExpectedType of
fftChar,
fftWideChar,
fftShortString..fftWideString :
begin
FType := ExpectedType;
Converted := False;
end;
{Begin !!.11}
fftBLOB..fftBLOBTypedBin :
begin
FType := fftNullAnsiStr;
Converted := False;
end;
{End !!.11}
else
TypeMismatch;
end;
end;
{====================================================================}
{===TffSqlLiteral====================================================}
procedure TffSqlLiteral.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlLiteral then begin
Clear;
if assigned(TffSqlLiteral(Source).FloatLiteral) then begin
FloatLiteral := TffSqlFloatLiteral.Create(Self);
FloatLiteral.Assign(TffSqlLiteral(Source).FloatLiteral);
end;
if assigned(TffSqlLiteral(Source).IntegerLiteral) then begin
IntegerLiteral := TffSqlIntegerLiteral.Create(Self);
IntegerLiteral.Assign(TffSqlLiteral(Source).IntegerLiteral);
end;
if assigned(TffSqlLiteral(Source).StringLiteral) then begin
StringLiteral := TffSqlStringLiteral.Create(Self);
StringLiteral.Assign(TffSqlLiteral(Source).StringLiteral);
end;
if assigned(TffSqlLiteral(Source).DateLiteral) then begin
DateLiteral := TffSqlDateLiteral.Create(Self);
DateLiteral.Assign(TffSqlLiteral(Source).DateLiteral);
end;
if assigned(TffSqlLiteral(Source).TimeLiteral) then begin
TimeLiteral := TffSqlTimeLiteral.Create(Self);
TimeLiteral.Assign(TffSqlLiteral(Source).TimeLiteral);
end;
if assigned(TffSqlLiteral(Source).TimeStampLiteral) then begin
TimeStampLiteral := TffSqlTimeStampLiteral.Create(Self);
TimeStampLiteral.Assign(TffSqlLiteral(Source).TimeStampLiteral);
end;
if assigned(TffSqlLiteral(Source).IntervalLiteral) then begin
IntervalLiteral := TffSqlIntervalLiteral.Create(Self);
IntervalLiteral.Assign(TffSqlLiteral(Source).IntervalLiteral);
end;
if assigned(TffSqlLiteral(Source).BooleanLiteral) then begin
BooleanLiteral := TffSqlBooleanLiteral.Create(Self);
BooleanLiteral.Assign(TffSqlLiteral(Source).BooleanLiteral);
end;
end else
AssignError(Source);
end;
procedure TffSqlLiteral.Clear;
begin
FloatLiteral.Free;
IntegerLiteral.Free;
StringLiteral.Free;
DateLiteral.Free;
TimeLiteral.Free;
TimeStampLiteral.Free;
IntervalLiteral.Free;
BooleanLiteral.Free;
FloatLiteral:= nil;
IntegerLiteral:= nil;
StringLiteral:= nil;
DateLiteral:= nil;
TimeLiteral:= nil;
TimeStampLiteral:= nil;
IntervalLiteral:= nil;
BooleanLiteral := nil;
end;
destructor TffSqlLiteral.Destroy;
begin
Clear;
inherited;
end;
{--------}
procedure TffSqlLiteral.EmitSQL(Stream: TStream);
begin
if FloatLiteral <> nil then
FloatLiteral.EmitSQL(Stream)
else
if IntegerLiteral <> nil then
IntegerLiteral.EmitSQL(Stream)
else
if StringLiteral <> nil then
StringLiteral.EmitSQL(Stream)
else
if DateLiteral <> nil then
DateLiteral.EmitSQL(Stream)
else
if TimeLiteral <> nil then
TimeLiteral.EmitSQL(Stream)
else
if TimestampLiteral <> nil then
TimestampLiteral.EmitSQL(Stream)
else
if IntervalLiteral <> nil then
IntervalLiteral.EmitSQL(Stream)
else
if BooleanLiteral <> nil then
BooleanLiteral.EmitSQL(Stream)
else
Assert(False);
end;
{--------}
function TffSqlLiteral.AddIntervalTo(Target: TDateTime): TDateTime;
begin
if IntervalLiteral <> nil then
Result := IntervalLiteral.AddIntervalTo(Target)
else begin
SQLError('Internal error: Type Mismatch');
Result := Null;
end;
end;
{--------}
function TffSqlLiteral.SubtractIntervalFrom(Target: TDateTime): TDateTime;
begin
if IntervalLiteral <> nil then
Result := IntervalLiteral.SubtractIntervalFrom(Target)
else begin
SQLError('Internal error: Type Mismatch');
Result := Null;
end;
end;
{--------}
procedure TffSqlLiteral.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
EnumMethod(Self);
if FloatLiteral <> nil then
FloatLiteral.EnumNodes(EnumMethod, Deep)
else
if IntegerLiteral <> nil then
IntegerLiteral.EnumNodes(EnumMethod, Deep)
else
if StringLiteral <> nil then
StringLiteral.EnumNodes(EnumMethod, Deep)
else
if DateLiteral <> nil then
DateLiteral.EnumNodes(EnumMethod, Deep)
else
if TimeLiteral <> nil then
TimeLiteral.EnumNodes(EnumMethod, Deep)
else
if TimestampLiteral <> nil then
TimestampLiteral.EnumNodes(EnumMethod, Deep)
else
if IntervalLiteral <> nil then
IntervalLiteral.EnumNodes(EnumMethod, Deep)
else
if BooleanLiteral <> nil then
BooleanLiteral.EnumNodes(EnumMethod, Deep)
else
Assert(False);
end;
{--------}
function TffSqlLiteral.GetValue: Variant;
begin
if FloatLiteral <> nil then
Result := FloatLiteral.GetValue
else
if IntegerLiteral <> nil then
Result := IntegerLiteral.GetValue
else
if StringLiteral <> nil then
Result := StringLiteral.GetValue
else
if DateLiteral <> nil then
Result := DateLiteral.GetValue
else
if TimeLiteral <> nil then
Result := TimeLiteral.GetValue
else
if TimestampLiteral <> nil then
Result := TimestampLiteral.GetValue
else
if IntervalLiteral <> nil then
Result := IntervalLiteral.GetValue
else
if BooleanLiteral <> nil then
Result := BooleanLiteral.GetValue
else
Assert(False);
end;
{--------}
function TffSqlLiteral.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlLiteral)
and
(BothNil(FloatLiteral, TffSqlLiteral(Other).FloatLiteral)
or (BothNonNil(FloatLiteral, TffSqlLiteral(Other).FloatLiteral)
and FloatLiteral.Equals(TffSqlLiteral(Other).FloatLiteral)
)
)
and
(BothNil(IntegerLiteral, TffSqlLiteral(Other).IntegerLiteral)
or (BothNonNil(IntegerLiteral, TffSqlLiteral(Other).IntegerLiteral)
and IntegerLiteral.Equals(TffSqlLiteral(Other).IntegerLiteral)
)
)
and
(BothNil(StringLiteral, TffSqlLiteral(Other).StringLiteral)
or (BothNonNil(StringLiteral, TffSqlLiteral(Other).StringLiteral)
and StringLiteral.Equals(TffSqlLiteral(Other).StringLiteral)
)
)
and
(BothNil(DateLiteral, TffSqlLiteral(Other).DateLiteral)
or (BothNonNil(DateLiteral, TffSqlLiteral(Other).DateLiteral)
and DateLiteral.Equals(TffSqlLiteral(Other).DateLiteral)
)
)
and
(BothNil(TimeLiteral, TffSqlLiteral(Other).TimeLiteral)
or (BothNonNil(TimeLiteral, TffSqlLiteral(Other).TimeLiteral)
and TimeLiteral.Equals(TffSqlLiteral(Other).TimeLiteral)
)
)
and
(BothNil(TimestampLiteral, TffSqlLiteral(Other).TimestampLiteral)
or (BothNonNil(TimestampLiteral, TffSqlLiteral(Other).TimestampLiteral)
and TimestampLiteral.Equals(TffSqlLiteral(Other).TimestampLiteral)
)
)
and
(BothNil(IntervalLiteral, TffSqlLiteral(Other).IntervalLiteral)
or (BothNonNil(IntervalLiteral, TffSqlLiteral(Other).IntervalLiteral)
and IntervalLiteral.Equals(TffSqlLiteral(Other).IntervalLiteral)
)
)
and
(BothNil(BooleanLiteral, TffSqlLiteral(Other).BooleanLiteral)
or (BothNonNil(BooleanLiteral, TffSqlLiteral(Other).BooleanLiteral)
and BooleanLiteral.Equals(TffSqlLiteral(Other).BooleanLiteral)
)
);
end;
{--------}
function TffSqlLiteral.GetDecimals: Integer;
begin
if FloatLiteral <> nil then
Result := FloatLiteral.GetDecimals
else
Result := 0;
end;
{--------}
function TffSqlLiteral.GetSize: Integer;
begin
Result := 0;
if FloatLiteral <> nil then
Result := FloatLiteral.GetSize
else
if IntegerLiteral <> nil then
Result := IntegerLiteral.GetSize
else
if StringLiteral <> nil then
Result := StringLiteral.GetSize
else
if DateLiteral <> nil then
Result := DateLiteral.GetSize
else
if TimeLiteral <> nil then
Result := TimeLiteral.GetSize
else
if TimestampLiteral <> nil then
Result := TimestampLiteral.GetSize
else
if IntervalLiteral <> nil then
Result := IntervalLiteral.GetSize
else
if BooleanLiteral <> nil then
Result := BooleanLiteral.GetSize
else
Assert(False);
end;
{--------}
function TffSqlLiteral.GetType: TffFieldType;
begin
Result := fftInterval; {dummy to suppress compiler warning}
if FloatLiteral <> nil then
Result := FloatLiteral.GetType
else
if IntegerLiteral <> nil then
Result := IntegerLiteral.GetType
else
if StringLiteral <> nil then
Result := StringLiteral.GetType
else
if DateLiteral <> nil then
Result := DateLiteral.GetType
else
if TimeLiteral <> nil then
Result := TimeLiteral.GetType
else
if TimestampLiteral <> nil then
Result := TimestampLiteral.GetType
else
if IntervalLiteral <> nil then
Result := IntervalLiteral.GetType
else
if BooleanLiteral <> nil then
Result := BooleanLiteral.GetType
else
Assert(False);
end;
{--------}
function IsValidDate(const S: ShortString): Boolean;
begin
if (length(S) <> 12)
or (S[6] <> '-')
or (S[9] <> '-') then
Result := False
else
try
EncodeDate(
StrToInt(copy(S, 2, 4)),
StrToInt(copy(S, 7, 2)),
StrToInt(copy(S, 10, 2)));
Result := True;
except
Result := False;
end;
end;
function IsValidTime(const S: ShortString): Boolean;
begin
if (length(S) <> 10)
or (S[4] <> ':')
or (S[7] <> ':') then
Result := False
else
try
EncodeTime(
StrToInt(copy(S, 2, 2)),
StrToInt(copy(S, 5, 2)),
StrToInt(copy(S, 8, 2)),
0);
Result := True;
except
Result := False;
end;
end;
function IsValidTimestamp(const S: ShortString): Boolean;
begin
if (length(S) < 21)
or (S[6] <> '-')
or (S[9] <> '-')
or (S[12] <> ' ')
or (S[15] <> ':')
or (S[18] <> ':') then
Result := False
else
try
EncodeDate(
StrToInt(copy(S, 2, 4)),
StrToInt(copy(S, 7, 2)),
StrToInt(copy(S, 10, 2)));
EncodeTime(
StrToInt(copy(S, 13, 2)),
StrToInt(copy(S, 16, 2)),
StrToInt(copy(S, 19, 2)),
0);
Result := True;
except
Result := False;
end;
end;
procedure TffSqlLiteral.MatchType(ExpectedType: TffFieldType);
begin
if FloatLiteral <> nil then
FloatLiteral.MatchType(ExpectedType)
else
if IntegerLiteral <> nil then
IntegerLiteral.MatchType(ExpectedType)
else
if StringLiteral <> nil then
case ExpectedType of
fftStDate, fftStTime, fftDateTime:
begin
{String literal, but caller was expecting a Date-type.}
{See if the string literal represents a valid date.}
{If it does, convert.}
if IsValidDate(StringLiteral.Value) then begin
DateLiteral := TffSqlDateLiteral.Create(Self);
DateLiteral.Value := StringLiteral.Value;
StringLiteral.Free;
StringLiteral := nil;
end else
{See if the string literal represents a valid time.}
{If it does, convert.}
if IsValidTime(StringLiteral.Value) then begin
TimeLiteral := TffSqlTimeLiteral.Create(Self);
TimeLiteral.Value := StringLiteral.Value;
StringLiteral.Free;
StringLiteral := nil;
end else
{See if the string literal represents a valid time stamp}
{If it does, convert.}
if IsValidTimestamp(StringLiteral.Value) then begin
TimeStampLiteral := TffSqlTimestampLiteral.Create(Self);
TimeStampLiteral.Value := StringLiteral.Value;
StringLiteral.Free;
StringLiteral := nil;
end else
TypeMismatch;
end;
else
StringLiteral.MatchType(ExpectedType);
end
else
if DateLiteral <> nil then
DateLiteral.MatchType(ExpectedType)
else
if TimeLiteral <> nil then
TimeLiteral.MatchType(ExpectedType)
else
if TimestampLiteral <> nil then
TimestampLiteral.MatchType(ExpectedType)
else
if IntervalLiteral <> nil then
IntervalLiteral.MatchType(ExpectedType)
else
if BooleanLiteral <> nil then
BooleanLiteral.MatchType(ExpectedType)
else
Assert(False);
end;
{====================================================================}
{===TffSqlParam======================================================}
procedure TffSqlParam.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlParam then begin
FParmIndex := TffSqlParam(Source).FParmIndex;
end else
AssignError(Source);
end;
constructor TffSqlParam.Create(AParent: TffSqlNode);
begin
inherited Create(AParent);
FParmIndex := Owner.ParmCount;
inc(Owner.ParmCount);
end;
{--------}
function TffSqlParam.GetDecimals: Integer;
begin
Result := 0;
end;
{--------}
function TffSqlParam.GetSize: Integer;
begin
case GetType of
fftWideString : Result := length(GetValue);
fftShortAnsiStr : Result := length(GetValue);
fftBLOB : Result := VarArrayHighBound(GetValue, 1); {!!.13}
else
Result := 0;
end;
end;
{--------}
function TffSqlParam.GetTitle(const Qualified : Boolean): string; {!!.11}
begin
Result := '?';
end;
{--------}
function TffSqlParam.GetType: TffFieldType;
var
V : Variant;
begin
Result := fftInterval; {dummy to suppress compiler warning}
V := Owner.ParmList.GetValue(ParmIndex);
case VarType(V) and VarTypeMask of
varSmallint : Result := fftInt32;
varInteger : Result := fftInt32;
varSingle : Result := fftSingle;
varDouble : Result := fftDouble;
varCurrency : Result := fftCurrency;
varDate : Result := fftDateTime;
varOleStr : Result := fftWideString;
varBoolean : Result := fftBoolean;
varString : Result := fftShortAnsiStr;
varByte : Result := fftBLOB; {!!.13}
else
SQLError('Unsupported parameter type:'+IntToHex(VarType(V),0));
end;
end;
{--------}
procedure TffSqlParam.EmitSQL(Stream: TStream);
begin
WriteStr(Stream,' ?');
end;
{--------}
procedure TffSqlParam.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
EnumMethod(Self);
end;
{--------}
function TffSqlParam.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlParam) {
and (AnsiCompareText(Name, TffSqlParam(Other).Name) = 0)};
end;
{--------}
function TffSqlParam.GetValue: Variant;
begin
if Owner.ParmList = nil then
raise Exception.Create('No parameter values specified for query. ' +
'Verify the parameters listed in the ' +
'TffQuery.Params property matches the ' +
'parameters specified in the TffQuery.SQL ' +
'property.');
Result := Owner.ParmList.GetValue(ParmIndex);
end;
{--------}
procedure TffSqlParam.MatchType(ExpectedType: TffFieldType);
begin
end;
{====================================================================}
{===TffSqlFactor=====================================================}
function TffSqlFactor.AddIntervalTo(Target: TDateTime): TDateTime;
begin
if Literal <> nil then
Result := Literal.AddIntervalTo(Target)
else begin
SQLError('Not implemented');
Result := Null;
end;
end;
{--------}
function TffSqlFactor.SubtractIntervalFrom(Target: TDateTime): TDateTime;
begin
if Literal <> nil then
Result := Literal.SubtractIntervalFrom(Target)
else begin
SQLError('Not implemented');
Result := Null;
end;
end;
{--------}
procedure TffSqlFactor.CheckIsConstant;
begin
FIsConstantChecked := True;
if SubQuery <> nil then
FIsConstant := False
else
if CondExp <> nil then
FIsConstant := CondExp.IsConstant
else
if FieldRef <> nil then
FIsConstant := False
else
if Literal <> nil then
FIsConstant := {True} Literal.IntervalLiteral = nil
{can't store interval values, so we can't handle those
as constant values even if they are in fact constant}
else
if Param <> nil then
FIsConstant := False
else
if Aggregate <> nil then
FIsConstant := False
else
if ScalarFunc <> nil then
FIsConstant := ScalarFunc.IsConstant
else
Assert(False);
if FIsConstant then begin
FIsConstant := False;
ConstantValue := GetValue;
FIsConstant := True;
end;
end;
{--------}
procedure TffSqlFactor.CheckType;
begin
if SubQuery <> nil then
FType := SubQuery.GetType
else
if CondExp <> nil then
FType:= CondExp.GetType
else
if FieldRef <> nil then
FType := FieldRef.GetType
else
if Literal <> nil then
FType := Literal.GetType
else
if Param <> nil then
FType := Param.GetType
else
if Aggregate <> nil then
FType := Aggregate.GetType
else
if ScalarFunc <> nil then
FType := ScalarFunc.GetType
else
Assert(False);
if UnaryMinus then
case FType of
fftByte,
fftWord16,
fftWord32,
fftInt8,
fftInt16,
fftInt32,
fftAutoInc,
fftSingle,
fftDouble,
fftExtended,
fftComp,
fftCurrency :
;
else
SQLError('Operator/operand mismatch');
end;
TypeKnown := True;
end;
{--------}
procedure TffSqlFactor.Clear;
begin
SubQuery.Free;
CondExp.Free;
FieldRef.Free;
Literal.Free;
Param.Free;
Aggregate.Free;
ScalarFunc.Free;
SubQuery:= nil;
CondExp:= nil;
FieldRef:= nil;
Literal:= nil;
Param:= nil;
Aggregate:= nil;
ScalarFunc:= nil;
end;
{--------}
function TffSqlFactor.DependsOn(Table: TFFSqlTableProxy): Boolean;
begin
if SubQuery <> nil then
Result := SubQuery.DependsOn(Table)
else
if CondExp <> nil then
Result := CondExp.DependsOn(Table)
else
if FieldRef <> nil then
Result := FieldRef.DependsOn(Table)
else
if Literal <> nil then
Result := False
else
if Param <> nil then
Result := False
else
if Aggregate <> nil then
Result := Aggregate.DependsOn(Table)
else
if ScalarFunc <> nil then
Result := ScalarFunc.DependsOn(Table)
else begin
Assert(False);
Result := False;
end;
end;
{--------}
destructor TffSqlFactor.Destroy;
begin
Clear;
inherited;
end;
{--------}
procedure TffSqlFactor.EmitSQL(Stream: TStream);
begin
if UnaryMinus then
WriteStr(Stream,' - ');
if SubQuery <> nil then begin
WriteStr(Stream,' (');
SubQuery.EmitSQL(Stream);
WriteStr(Stream,')');
end else
if CondExp <> nil then begin
WriteStr(Stream,' (');
CondExp.EmitSQL(Stream);
WRiteStr(Stream,')');
end else
if FieldRef <> nil then
FieldRef.EmitSQL(Stream)
else
if Literal <> nil then
Literal.EmitSQL(Stream)
else
if Param <> nil then
Param.EmitSQL(Stream)
else
if Aggregate <> nil then
Aggregate.EmitSQL(Stream)
else
if ScalarFunc <> nil then
ScalarFunc.EmitSQL(Stream)
else
Assert(False);
end;
{--------}
procedure TffSqlFactor.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
EnumMethod(Self);
if SubQuery <> nil then
SubQuery.EnumNodes(EnumMethod, Deep)
else
if CondExp <> nil then
CondExp.EnumNodes(EnumMethod, Deep)
else
if FieldRef <> nil then
FieldRef.EnumNodes(EnumMethod, Deep)
else
if Literal <> nil then
Literal.EnumNodes(EnumMethod, Deep)
else
if Param <> nil then
Param.EnumNodes(EnumMethod, Deep)
else
if ScalarFunc <> nil then
ScalarFunc.EnumNodes(EnumMethod, Deep)
else
if Aggregate <> nil then
Aggregate.EnumNodes(EnumMethod, Deep)
else
Assert(False);
end;
{--------}
function TffSqlFactor.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlFactor)
and (MulOp = TffSqlFactor(Other).MulOp)
and (UnaryMinus = TffSqlFactor(Other).UnaryMinus)
and
(BothNil(CondExp, TffSqlFactor(Other).CondExp)
or (
BothNonNil(CondExp, TffSqlFactor(Other).CondExp)
and CondExp.Equals(TffSqlFactor(Other).CondExp)
)
)
and
(BothNil(FieldRef, TffSqlFactor(Other).FieldRef)
or (
BothNonNil(FieldRef, TffSqlFactor(Other).FieldRef)
and FieldRef.Equals(TffSqlFactor(Other).FieldRef)
)
)
and
(BothNil(Literal, TffSqlFactor(Other).Literal)
or (
BothNonNil(Literal, TffSqlFactor(Other).Literal)
and Literal.Equals(TffSqlFactor(Other).Literal)
)
)
and
(BothNil(Param, TffSqlFactor(Other).Param)
or (
BothNonNil(Param, TffSqlFactor(Other).Param)
and Param.Equals(TffSqlFactor(Other).Param)
)
)
and
(BothNil(Aggregate, TffSqlFactor(Other).Aggregate)
or (
BothNonNil(Aggregate, TffSqlFactor(Other).Aggregate)
and Aggregate.Equals(TffSqlFactor(Other).Aggregate)
)
)
and
(BothNil(SubQuery, TffSqlFactor(Other).SubQuery)
or (
BothNonNil(SubQuery, TffSqlFactor(Other).SubQuery)
and SubQuery.Equals(TffSqlFactor(Other).SubQuery)
)
)
and
(BothNil(ScalarFunc, TffSqlFactor(Other).ScalarFunc)
or (
BothNonNil(ScalarFunc, TffSqlFactor(Other).ScalarFunc)
and ScalarFunc.Equals(TffSqlFactor(Other).ScalarFunc)
)
);
end;
{--------}
function TffSqlFactor.GetDecimals: Integer;
begin
if SubQuery <> nil then
Result := SubQuery.GetDecimals
else
if CondExp <> nil then
Result := CondExp.GetDecimals
else
if FieldRef <> nil then
Result := FieldRef.GetDecimals
else
if Literal <> nil then
Result := Literal.GetDecimals
else
if Param <> nil then
Result := Param.GetDecimals
else
if Aggregate <> nil then
Result := Aggregate.GetDecimals
else
if ScalarFunc <> nil then
Result := ScalarFunc.GetDecimals
else begin
Assert(False);
Result := 0;
end;
end;
{--------}
function TffSqlFactor.GetSize: Integer;
begin
if SubQuery <> nil then
Result := SubQuery.GetSize
else
if CondExp <> nil then
Result := CondExp.GetSize
else
if FieldRef <> nil then
Result := FieldRef.GetSize
else
if Literal <> nil then
Result := Literal.GetSize
else
if Param <> nil then
Result := Param.GetSize
else
if Aggregate <> nil then
Result := Aggregate.GetSize
else
if ScalarFunc <> nil then
Result := ScalarFunc.GetSize
else begin
Assert(False);
Result := 0;
end;
end;
{--------}
function TffSqlFactor.GetTitle(const Qualified : Boolean): string; {!!.11}
begin
if SubQuery <> nil then
Result := 'SUB'
else
if CondExp <> nil then
Result := CondExp.GetTitle(Qualified) {!!.11}
else
if FieldRef <> nil then
Result := FieldRef.GetTitle(Qualified) {!!.11}
else
if Literal <> nil then
Result := 'LIT'
else
if Param <> nil then
Result := Param.GetTitle(Qualified) {!!.11}
else
if ScalarFunc <> nil then
Result := ScalarFunc.GetTitle(Qualified) {!!.11}
else
if Aggregate <> nil then
Result := Aggregate.GetTitle(Qualified) {!!.11}
else
Assert(False);
end;
{--------}
function TffSqlFactor.GetType: TffFieldType;
begin
if not TypeKnown then
CheckType;
Result := FType
end;
{--------}
procedure TffSqlFactor.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlFactor then begin
Clear;
MulOp := TffSqlFactor(Source).MulOp;
UnaryMinus := TffSqlFactor(Source).UnaryMinus;
if assigned(TffSqlFactor(Source).CondExp) then begin
CondExp := TffSqlCondExp.Create(Self);
CondExp.Assign(TffSqlFactor(Source).CondExp);
end;
if assigned(TffSqlFactor(Source).FieldRef) then begin
FieldRef := TffSqlFieldRef.Create(Self);
FieldRef.Assign(TffSqlFactor(Source).FieldRef);
end;
if assigned(TffSqlFactor(Source).Literal) then begin
Literal := TffSqlLiteral.Create(Self);
Literal.Assign(TffSqlFactor(Source).Literal);
end;
if assigned(TffSqlFactor(Source).Param) then begin
Param := TffSqlParam.Create(Self);
Param.Assign(TffSqlFactor(Source).Param);
end;
if assigned(TffSqlFactor(Source).Aggregate) then begin
Aggregate := TffSqlAggregate.Create(Self);
Aggregate.Assign(TffSqlFactor(Source).Aggregate);
end;
if assigned(TffSqlFactor(Source).SubQuery) then begin
SubQuery := TffSqlSELECT.Create(Self);
SubQuery.Assign(TffSqlFactor(Source).SubQuery);
end;
if assigned(TffSqlFactor(Source).ScalarFunc) then begin
ScalarFunc := TffSqlScalarFunc.Create(Self);
ScalarFunc.Assign(TffSqlFactor(Source).ScalarFunc);
end;
end else
AssignError(Source);
end;
{--------}
function TffSqlFactor.GetValue: Variant;
begin
if IsConstant then begin
Result := ConstantValue;
exit;
end;
if SubQuery <> nil then
Result := SubQuery.GetValue
else
if CondExp <> nil then
Result := CondExp.GetValue
else
if FieldRef <> nil then
Result := FieldRef.GetValue
else
if Literal <> nil then
Result := Literal.GetValue
else
if Param <> nil then
Result := Param.GetValue
else
if Aggregate <> nil then
Result := Aggregate.GetAggregateValue
else
if ScalarFunc <> nil then
Result := ScalarFunc.GetValue
else
Assert(False);
if UnaryMinus then
if not VarIsNull(Result) then
Result := - Result;
end;
{--------}
function TffSqlFactor.HasFieldRef: Boolean;
begin
Result := (FieldRef <> nil);
end;
{--------}
function TffSqlFactor.IsField(var FieldReferenced: TFFSqlFieldProxy): Boolean;
begin
Result := (FieldRef <> nil) and not UnaryMinus;
if Result then
FieldReferenced := FieldRef.Field;
end;
{--------}
function TffSqlFactor.IsFieldFrom(Table: TFFSqlTableProxy;
var FieldReferenced: TFFSqlFieldProxy; var SameCase: Boolean): Boolean;
begin
Result := (FieldRef <> nil) and
(FieldRef.Field <> nil) and
(FieldRef.Field.OwnerTable = Table);
if Result then begin
FieldReferenced := FieldRef.Field;
SameCase := True;
end else
if ScalarFunc <> nil then begin
Result := ScalarFunc.IsFieldFrom(Table, FieldReferenced);
SameCase := False;
end;
end;
{--------}
function TffSqlFactor.IsNull: Boolean;
begin
if FieldRef <> nil then
Result := FieldRef.IsNull
else
Result := VarIsNull(GetValue);
end;
{--------}
function TffSqlFactor.IsAggregate: Boolean;
begin
Result := Aggregate <> nil;
end;
{--------}
function TffSqlFactor.IsConstant: Boolean;
begin
if not FIsConstantChecked then
CheckIsConstant;
Result := FIsConstant;
end;
{--------}
procedure TffSqlFactor.MatchType(ExpectedType: TffFieldType);
begin
if SubQuery <> nil then
SubQuery.MatchType(ExpectedType, True)
else
if CondExp <> nil then
CondExp.MatchType(ExpectedType)
else
if FieldRef <> nil then
FieldRef.MatchType(ExpectedType)
else
if Literal <> nil then
Literal.MatchType(ExpectedType)
else
if Param <> nil then
Param.MatchType(ExpectedType)
else
if Aggregate <> nil then
Aggregate.MatchType(ExpectedType)
else
if ScalarFunc <> nil then
ScalarFunc.MatchType(ExpectedType)
else
Assert(False);
end;
{--------}
function TffSqlFactor.Reduce: Boolean;
var
LiftFactor: TffSqlFactor;
begin
if SubQuery <> nil then
Result := SubQuery.Reduce
else
if CondExp <> nil then begin
{!!.11 begin}
{if conditional expression is nothing but a parenthesized factor,
lift it to this level}
LiftFactor := nil;
if CondExp.CondTermCount = 1 then
with CondExp.CondTerm[0] do
if CondFactorCount = 1 then
with CondFactor[0] do
if not UnaryNot then
with CondPrimary do
if (RelOp = roNone) and (SimpleExp2 = nil) then
with SimpleExp1 do
if TermCount = 1 then
with Term[0] do
if FactorCount = 1 then begin
LiftFactor := TffSqlFactor.Create(Parent);
LiftFactor.Assign(Factor[0]);
LiftFactor.MulOp := MulOp; {!!.13}
end;
if LiftFactor <> nil then begin
CondExp.Free;
CondExp := nil;
Assign(LiftFactor);
LiftFactor.Free;
Result := True;
end else
{!!.11 end}
Result := CondExp.Reduce
end else
if FieldRef <> nil then
Result := False
else
if Literal <> nil then
Result := False
else
if Param <> nil then
Result := False
else
if Aggregate <> nil then
Result := Aggregate.Reduce
else
if ScalarFunc <> nil then
Result := ScalarFunc.Reduce
else
Result := False;
end;
{--------}
procedure TffSqlFactor.ResetConstant;
begin
FIsConstantChecked := False;
FIsConstant := False;
end;
{Begin !!.11}
{--------}
function TffSqlFactor.WasWildcard : Boolean;
begin
if FieldRef <> nil then
Result := FieldRef.WasWildcard
else
Result := False;
end;
{End !!.11}
{====================================================================}
{===TffSqlSelection==================================================}
procedure TffSqlSelection.AddColumnDef(Target: TffSqlColumnListOwner);
{Rewritten !!.11}
var
S, SQual : string;
F : TffSqlNode;
i : Integer;
begin
if Column <> nil then
S := Column.ColumnName
else
S := '';
F := SimpleExpression;
if S = '' then
S := SimpleExpression.GetTitle(False);
if Target.Columns.IndexOf(S) <> -1 then begin
{ See if we can use the qualified column name. This is done for the sake
of backwards compatibility with existing SQL statements in FF clients. }
SQual := SimpleExpression.GetTitle(True);
if Target.Columns.IndexOf(SQual) = -1 then
Target.Columns.AddObject(SQual, F)
else begin
i := 1;
repeat
inc(i);
until Target.Columns.IndexOf(S + '_' + IntToStr(i)) = -1;
Target.Columns.AddObject(S + '_' + IntToStr(i), F);
end;
end else
Target.Columns.AddObject(S, F);
end;
{--------}
procedure TffSqlSelection.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlSelection then begin
SimpleExpression.Free;
SimpleExpression := TffSqlSimpleExpression.Create(Self);
SimpleExpression.Assign(TffSqlSelection(Source).SimpleExpression);
Column.Free;
Column := nil;
if assigned(TffSqlSelection(Source).Column) then begin
Column := TffSqlColumn.Create(Self);
Column.Assign(TffSqlSelection(Source).Column);
end;
end else
AssignError(Source);
end;
destructor TffSqlSelection.Destroy;
begin
SimpleExpression.Free;
Column.Free;
inherited;
end;
procedure TffSqlSelection.EmitSQL(Stream: TStream);
begin
SimpleExpression.EmitSQL(Stream);
if Column <> nil then begin
WriteStr(Stream,' AS');
Column.EmitSQL(Stream);
end;
end;
{--------}
procedure TffSqlSelection.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
EnumMethod(Self);
SimpleExpression.EnumNodes(EnumMethod, Deep);
if Column <> nil then
Column.EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlSelection.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlSelection)
and (
BothNil(SimpleExpression, TffSqlSelection(Other).SimpleExpression)
or (BothNonNil(SimpleExpression, TffSqlSelection(Other).SimpleExpression)
and SimpleExpression.Equals(TffSqlSelection(Other).SimpleExpression)
)
)
and (
BothNil(Column, TffSqlSelection(Other).Column)
or (BothNonNil(Column, TffSqlSelection(Other).Column)
and Column.Equals(TffSqlSelection(Other).Column)
)
);
end;
{--------}
function TffSqlSelection.GetIndex: Integer;
begin
Result := TffSqlSelectionList(Parent).FSelections.IndexOf(Self);
end;
{--------}
function TffSqlSelection.IsAggregateExpression: Boolean;
begin
Result := SimpleExpression.IsAggregateExpression;
end;
function TffSqlSelection.Reduce: Boolean;
begin
Result := SimpleExpression.Reduce;
end;
{====================================================================}
{===TffSqlTableRef===================================================}
procedure TffSqlTableRef.AddTableReference(Select: TffSqlSELECT);
var
IX, I : Integer;
begin
IX := -1;
Assert(Assigned(Select.TablesReferencedByOrder));
if TableName <> '' then begin
if DatabaseName <> '' then
if not SameText(DatabaseName, Owner.FDatabase.Alias) then
SQLError(format('The referenced database name %s does not '+
'match the current database, %s.',
[DatabaseName, Owner.FDatabase.Alias]));
IX := Select.TablesReferencedByOrder.Add(TableName)
end else begin
Assert(Assigned(TableExp));
TableExp.EnsureResultTable(True);
if Select.TablesReferencedByOrder.IndexOf('$$UNNAMED') = -1 then
IX := Select.TablesReferencedByOrder.AddObject('$$UNNAMED',
TableExp.ResultTable)
else begin
I := 2;
repeat
if Select.TablesReferencedByOrder.IndexOf('$$UNNAMED_' + IntToStr(I)) =
-1 then begin
IX := Select.TablesReferencedByOrder.AddObject('$$UNNAMED_' +
IntToStr(I), TableExp.ResultTable);
break;
end;
inc(I);
until False;
end;
end;
if Alias <> '' then begin
Assert(Assigned(Select.TableAliases));
if Select.TableAliases.IndexOf(Alias) <> -1 then
SQLError('Duplicate alias definition:' + Alias);
Select.TableAliases.AddObject(Alias, TObject(IX));
end;
end;
{--------}
procedure TffSqlTableRef.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlTableRef then begin
Clear;
TableName := TffSqlTableRef(Source).TableName;
Alias := TffSqlTableRef(Source).Alias;
if TffSqlTableRef(Source).TableExp <> nil then begin
TableExp := TffSqlTableExp.Create(Self);
TableExp.Assign(TffSqlTableRef(Source).TableExp);
end;
if TffSqlTableRef(Source).ColumnList <> nil then begin
ColumnList := TFFSqlInsertColumnList.Create(Self);
ColumnList.Assign(TffSqlTableRef(Source).ColumnList);
end;
end else
AssignError(Source);
end;
function TffSqlTableRef.BindFieldDown(const TableName,
FieldName: string): TFFSqlFieldProxy;
{- not used for binding directly from SELECT - only for
binding to contained sub-expressions}
begin
if TableExp <> nil then
Result := TableExp.BindFieldDown(TableName, FieldName)
else
if SameText(TableName, Self.TableName)
and (Alias = '') {can't bind to table name if alias present} {!!.12}
or SameText(TableName, Alias) then
Result := ResultTable.FieldByName(FieldName)
else
Result := nil;
end;
function TffSqlTableRef.BindTable(AOwner: TObject;
const TableName: string): TFFSqlTableProxy;
begin
if SameText(TableName, Alias) or SameText(TableName, Self.TableName) then
Result := GetTable(AOwner, False)
else
if TableExp <> nil then
Result := TableExp.BindTable(AOwner, TableName)
else
Result := nil;
end;
procedure TffSqlTableRef.Clear;
begin
TableName := '';
Alias := '';
TableExp.Free;
TableExp := nil;
ColumnList.Free;
ColumnList := nil;
end;
function TffSqlTableRef.DependsOn(Table: TFFSqlTableProxy): Boolean;
begin
if TableExp <> nil then
Result := TableExp.DependsOn(Table)
else
Result := False;
end;
destructor TffSqlTableRef.Destroy;
begin
Clear;
inherited;
end;
procedure TffSqlTableRef.EmitSQL(Stream: TStream);
begin
if TableName <> '' then begin
WriteStr(Stream, ' ');
WriteStr(Stream, TableName);
if Alias <> '' then begin
WriteStr(Stream,' AS ');
WriteStr(Stream, Alias);
end;
end else
if TableExp <> nil then begin
WriteStr(Stream, ' (');
TableExp.EmitSQL(Stream);
WriteStr(Stream,')');
if Alias <> '' then begin
WriteStr(Stream,' AS ');
WriteStr(Stream, Alias);
end;
if ColumnList <> nil then begin
WriteStr(Stream, ' (');
ColumnList.EmitSQL(Stream);
WriteStr(Stream, ')');
end;
end;
end;
{--------}
procedure TffSqlTableRef.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
EnumMethod(Self);
if Deep and assigned(TableExp) then
TableExp.EnumNodes(EnumMethod, Deep);
if assigned(ColumnList) then
ColumnList.EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlTableRef.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlTableRef)
and (AnsiCompareText(TableName, TffSqlTableRef(Other).TableName) = 0)
and (AnsiCompareText(Alias, TffSqlTableRef(Other).Alias) = 0)
and (BothNil(TableExp, TffSqlTableRef(Other).TableExp)
or (BothNonNil(TableExp, TffSqlTableRef(Other).TableExp)
and TableExp.Equals(TffSqlTableRef(Other).TableExp)
))
and (BothNil(ColumnList, TffSqlTableRef(Other).ColumnList)
or (BothNonNil(ColumnList, TffSqlTableRef(Other).ColumnList)
and ColumnList.Equals(TffSqlTableRef(Other).ColumnList)
));
end;
procedure TffSqlTableRef.Execute(
var aLiveResult: Boolean; var aCursorID: TffCursorID;
var RecordsRead: Integer);
var
T : TffSqlTableProxy;
begin
Assert(Owner <> nil);
T := GetTable(Self, False);
aCursorID := T.CursorID;
T.LeaveCursorOpen := True;
if T.Owner = Self then begin
T.Owner := nil;
T.Free;
end;
end;
function TffSqlTableRef.GetResultTable: TFFSqlTableProxy;
begin
Result := GetTable(Self, False);
end;
function TffSqlTableRef.GetSQLName: string;
begin
if Alias <> '' then
Result := Alias
else
if TableName <> '' then
Result := TableName
else
Result := 'UNNAMED';
end;
function TffSqlTableRef.GetTable(AOwner: TObject;
const ExclContLock : Boolean): TffSqlTableProxy;
begin
if DatabaseName <> '' then
if not SameText(DatabaseName, Owner.FDatabase.Alias) then
SQLError(format('The referenced database name %s does not '+
'match the current database, %s.',
[DatabaseName, Owner.FDatabase.Alias]));
if TableName <> '' then begin
if FTable = nil then begin
FTable := Owner.FDatabase.TableByName(AOwner, TableName,
ExclContLock, Alias); {!!.11}
if FTable = nil then
SQLError('Unable to open table: ' + TableName +
'. Ensure the table exists and is not in use by ' +
'another process.');
FTable.SetIndex(-1);
end;
Result := FTable;
end else
Result := TableExp.ResultTable;
end;
{!!.11 new}
function TffSqlTableRef.Reduce: Boolean;
begin
if TableExp <> nil then
if TableExp.Reduce then begin
Result := True;
exit;
end;
Result := False;
end;
function TffSqlTableRef.TargetFieldFromSourceField(
const F: TffSqlFieldProxy): TffSqlFieldProxy;
begin
if TableExp <> nil then
Result := TableExp.TargetFieldFromSourceField(F)
else
Result := nil; {!!.13}
end;
{====================================================================}
{===TffSqlSimpleExpressionList=======================================}
function TffSqlSimpleExpressionList.AddExpression(
Expression: TffSqlSimpleExpression): TffSqlSimpleExpression;
begin
FExpressionList.Add(Expression);
Result := Expression;
end;
{--------}
procedure TffSqlSimpleExpressionList.Assign(const Source: TffSqlNode);
var
i: Integer;
begin
if Source is TffSqlSimpleExpressionList then begin
Clear;
for i := 0 to pred(TffSqlSimpleExpressionList(Source).ExpressionCount) do
AddExpression(TffSqlSimpleExpression.Create(Self)).Assign(
TffSqlSimpleExpressionList(Source).Expression[i]);
end else
AssignError(Source);
end;
procedure TffSqlSimpleExpressionList.CheckIsConstant;
var
i : Integer;
begin
FIsConstantChecked := True;
for i := 0 to pred(ExpressionCount) do
if not Expression[i].IsConstant then begin
FIsConstant := False;
exit;
end;
FIsConstant := True;
end;
function TffSqlSimpleExpressionList.Contains(const TestValue: Variant): Boolean;
var
i : Integer;
begin
for i := 0 to pred(ExpressionCount) do
if Expression[i].GetValue = TestValue then begin
Result := True;
exit;
end;
Result := False;
end;
{--------}
constructor TffSqlSimpleExpressionList.Create(
AParent: TffSqlNode);
begin
inherited Create(AParent);
FExpressionList := TList.Create;
end;
{--------}
procedure TffSqlSimpleExpressionList.Clear;
var
i : Integer;
begin
for i := 0 to pred(ExpressionCount) do
Expression[i].Free;
FExpressionList.Clear;
end;
{--------}
function TffSqlSimpleExpressionList.DependsOn(
Table: TFFSqlTableProxy): Boolean;
var
i : Integer;
begin
for i := 0 to pred(ExpressionCount) do
if Expression[i].DependsOn(Table) then begin
Result := True;
exit;
end;
Result := False;
end;
{--------}
destructor TffSqlSimpleExpressionList.Destroy;
begin
Clear;
FExpressionList.Free;
inherited;
end;
{--------}
procedure TffSqlSimpleExpressionList.EmitSQL(Stream: TStream);
var
i : Integer;
begin
Expression[0].EmitSQL(Stream);
for i := 1 to pred(ExpressionCount) do begin
WriteStr(Stream,', ');
Expression[i].EmitSQL(Stream);
end;
end;
{--------}
procedure TffSqlSimpleExpressionList.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
var
i : Integer;
begin
EnumMethod(Self);
for i := 0 to pred(ExpressionCount) do
Expression[i].EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlSimpleExpressionList.Equals(Other: TffSqlNode): Boolean;
var
i : Integer;
begin
Result := False;
if Other is TffSqlSimpleExpressionList then begin
if ExpressionCount <> TffSqlSimpleExpressionList(Other).ExpressionCount then
exit;
for i := 0 to pred(ExpressionCount) do
if not Expression[i].Equals(TffSqlSimpleExpressionList(Other).Expression[i]) then
exit;
Result := True;
end;
end;
{--------}
function TffSqlSimpleExpressionList.GetExpression(
Index: Integer): TffSqlSimpleExpression;
begin
Result := TffSqlSimpleExpression(FExpressionList[Index]);
end;
{--------}
function TffSqlSimpleExpressionList.GetExpressionCount: Integer;
begin
Result := FExpressionList.Count;
end;
{--------}
function TffSqlSimpleExpressionList.IsConstant: Boolean;
begin
if not FIsConstantChecked then
CheckIsConstant;
Result := FIsConstant;
end;
procedure TffSqlSimpleExpressionList.MatchType(ExpectedType: TffFieldType);
var
i : Integer;
begin
for i := 0 to pred(ExpressionCount) do
Expression[i].MatchType(ExpectedType);
end;
{--------}
function TffSqlSimpleExpressionList.Reduce: Boolean;
var
I : integer;
begin
for i := 0 to pred(ExpressionCount) do
if Expression[i].Reduce then begin
Result := True;
exit;
end;
Result := False;
end;
{--------}
procedure TffSqlSimpleExpressionList.ResetConstant;
begin
FIsConstantChecked := False;
FIsConstant := False;
end;
procedure TffSqlSimpleExpressionList.SetExpression(Index: Integer;
const Value: TffSqlSimpleExpression);
begin
FExpressionList[Index] := Value;
end;
{====================================================================}
{===TffSqlOrderColumn================================================}
procedure TffSqlOrderColumn.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlOrderColumn then begin
TableName := TffSqlOrderColumn(Source).TableName;
FieldName := TffSqlOrderColumn(Source).FieldName;
end else
AssignError(Source);
end;
{--------}
procedure TffSqlOrderColumn.EmitSQL(Stream: TStream);
begin
WriteStr(Stream, ' ');
if TableName <> '' then begin
WriteStr(Stream, TableName);
WriteStr(Stream, '.');
end;
WriteStr(Stream, FieldName);
end;
{--------}
procedure TffSqlOrderColumn.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
EnumMethod(Self);
end;
{--------}
function TffSqlOrderColumn.Equals(Other: TffSqlNode): Boolean;
begin
Result := Other is TffSqlOrderColumn
and (AnsiCompareText(TableName, TffSqlOrderColumn(Other).TableName) = 0)
and (AnsiCompareText(FieldName, TffSqlOrderColumn(Other).FieldName) = 0);
end;
{--------}
function TffSqlOrderColumn.QualColumnName : string;
begin
if TableName <> '' then
Result := TableName + '.' + FieldName
else
Result := FieldName;
end;
{====================================================================}
{===TffSqlGroupColumn================================================}
procedure TffSqlGroupColumn.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlGroupColumn then begin
TableName := TffSqlGroupColumn(Source).TableName;
FieldName := TffSqlGroupColumn(Source).FieldName;
end else
AssignError(Source);
end;
{--------}
procedure TffSqlGroupColumn.EmitSQL(Stream: TStream);
begin
WriteStr(Stream, ' ');
if TableName <> '' then begin
WriteStr(Stream, TableName);
WriteStr(Stream, '.');
end;
WriteStr(Stream, FieldName);
end;
{--------}
procedure TffSqlGroupColumn.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
EnumMethod(Self);
end;
{--------}
function TffSqlGroupColumn.Equals(Other: TffSqlNode): Boolean;
begin
Result := Other is TffSqlGroupColumn
and (AnsiCompareText(TableName, TffSqlGroupColumn(Other).TableName) = 0)
and (AnsiCompareText(FieldName, TffSqlGroupColumn(Other).FieldName) = 0);
end;
{--------}
function TffSqlGroupColumn.QualColumnName: string;
var
F : TffSqlFieldProxy;
Name : string;
begin
if OwnerSelect = nil then
SQLError('Field references may not occur in this context');
if TableName <> '' then begin
Name := OwnerSelect.TableRefList.GetNameForAlias(FTableName);
if Name <> '' then
Result := Name + '.' + FFieldName
else
Result := TableName + '.' + FFieldName;
end
else begin
{ If this is an alias for a field in the selection list then return
the name. }
if OwnerSelect.Columns.IndexOf(FieldName) > -1 then
Result := FieldName
else begin
{ Find the proxy for this field. }
F := OwnerSelect.FindField(FFieldName);
if F = nil then
Result := FFieldName
else
Result := F.OwnerTable.Name + '.' + FFieldName;
end;
end;
end;
{====================================================================}
{===TffSqlOrderItem==================================================}
procedure TffSqlOrderItem.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlOrderItem then begin
if TffSqlOrderItem(Source).Column <> nil then begin
if Column = nil then
Column := TffSqlOrderColumn.Create(Self);
Column.Assign(TffSqlOrderItem(Source).Column);
end;
Index := TffSqlOrderItem(Source).Index;
Descending := TffSqlOrderItem(Source).Descending;
end else
AssignError(Source);
end;
constructor TffSqlOrderItem.Create(AParent: TffSqlNode);
begin
inherited Create(AParent);
end;
destructor TffSqlOrderItem.Destroy;
begin
Column.Free;
inherited;
end;
procedure TffSqlOrderItem.EmitSQL(Stream: TStream);
begin
if Column <> nil then
Column.EmitSQL(Stream)
else begin
WriteStr(Stream, ' ');
WriteStr(Stream, Index);
end;
if Descending then
WriteStr(Stream,' DESC')
else
Writestr(Stream,' ASC');
end;
{--------}
procedure TffSqlOrderItem.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
EnumMethod(Self);
if Column <> nil then
Column.EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlOrderItem.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlOrderItem)
and (Descending = TffSqlOrderItem(Other).Descending)
and (Index = TffSqlOrderItem(Other).Index)
and (BothNil(Column, TffSqlOrderItem(Other).Column)
or (BothNonNil(Column, TffSqlOrderItem(Other).Column)
and Column.Equals(TffSqlOrderItem(Other).Column)
));
end;
{--------}
{====================================================================}
{===TffSqlOrderList==================================================}
function TffSqlOrderList.AddOrderItem(NewOrder: TffSqlOrderItem): TffSqlOrderItem;
begin
FOrderItemList.Add(NewOrder);
Result := NewOrder;
end;
{--------}
procedure TffSqlOrderList.Assign(const Source: TffSqlNode);
var
i: Integer;
begin
if Source is TffSqlOrderList then begin
Clear;
for i := 0 to pred(TffSqlOrderList(Source).OrderCount) do
AddOrderItem(TffSqlOrderItem.Create(Self)).Assign(
TffSqlOrderList(Source).OrderItem[i]);
end else
AssignError(Source);
end;
constructor TffSqlOrderList.Create(AParent: TffSqlNode);
begin
inherited Create(AParent);
FOrderItemList := TList.Create;
end;
{--------}
procedure TffSqlOrderList.Clear;
var
i : Integer;
begin
for i := 0 to pred(FOrderItemList.Count) do
OrderItem[i].Free;
FOrderItemList.Clear;
end;
{--------}
destructor TffSqlOrderList.Destroy;
begin
Clear;
FOrderItemList.Free;
inherited;
end;
{--------}
procedure TffSqlOrderList.EmitSQL(Stream: TStream);
var
i : Integer;
begin
WriteStr(Stream,' ORDER BY');
OrderItem[0].EmitSQL(Stream);
for i := 1 to pred(OrderCount) do begin
WriteStr(Stream,', ');
OrderItem[i].EmitSQL(Stream);
end;
end;
{--------}
procedure TffSqlOrderList.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
var
i : Integer;
begin
EnumMethod(Self);
for i := 0 to pred(OrderCount) do
OrderItem[i].EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlOrderList.Equals(Other: TffSqlNode): Boolean;
var
i : Integer;
begin
Result := False;
if Other is TffSqlOrderList then begin
if OrderCount <> TffSqlOrderList(Other).OrderCount then
exit;
for i := 0 to pred(OrderCount) do
if not OrderItem[i].Equals(TffSqlOrderList(Other).OrderItem[i]) then
exit;
Result := True;
end;
end;
{--------}
function TffSqlOrderList.GetOrderCount: Integer;
begin
Result := FOrderItemList.Count;
end;
{--------}
function TffSqlOrderList.GetOrderItem(
Index: Integer): TffSqlOrderItem;
begin
Result := TffSqlOrderItem(FOrderItemList[Index]);
end;
{--------}
function TffSqlOrderList.Reduce: Boolean;
begin
Result := False;
end;
procedure TffSqlOrderList.SetOrderItem(Index: Integer;
const Value: TffSqlOrderItem);
begin
FOrderItemList[Index] := Value;
end;
{====================================================================}
{===TffSqlAllOrAnyClause=============================================}
procedure TffSqlAllOrAnyClause.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlAllOrAnyClause then begin
All := TffSqlAllOrAnyClause(Source).All;
SubQuery.Free;
SubQuery := TffSqlSELECT.Create(Self);
SubQuery.Assign(TffSqlAllOrAnyClause(Source).SubQuery);
end else
AssignError(Source);
end;
function TffSqlAllOrAnyClause.Compare(RelOp: TffSqlRelOp;
const Val: Variant): Boolean;
begin
if All then
Result := SubQuery.CheckAllValues(RelOp, Val)
else
Result := SubQuery.CheckAnyValue(RelOp, Val);
end;
function TffSqlAllOrAnyClause.DependsOn(Table: TFFSqlTableProxy): Boolean;
begin
Result := SubQuery.DependsOn(Table);
end;
destructor TffSqlAllOrAnyClause.Destroy;
begin
SubQuery.Free;
inherited;
end;
{--------}
procedure TffSqlAllOrAnyClause.EmitSQL(Stream: TStream);
begin
if All then
WriteStr(Stream,' ALL ')
else
WriteStr(Stream,' ANY ');
WriteStr(Stream,'(');
SubQuery.EmitSQL(Stream);
WriteStr(Stream,')');
end;
{--------}
procedure TffSqlAllOrAnyClause.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
EnumMethod(Self);
SubQuery.EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlAllOrAnyClause.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlAllOrAnyClause)
and (All = TffSqlAllOrAnyClause(Other).All)
and (SubQuery.Equals(TffSqlAllOrAnyClause(Other).SubQuery));
end;
{--------}
procedure TffSqlAllOrAnyClause.MatchType(ExpectedType: TffFieldType);
begin
SubQuery.MatchType(ExpectedType, True);
end;
function TffSqlAllOrAnyClause.Reduce: Boolean;
begin
Result := SubQuery.Reduce;
end;
{====================================================================}
{===TffSqlExistsClause===============================================}
function TffSqlExistsClause.AsBoolean: Boolean;
begin
Result := SubQuery.CheckNonEmpty;
end;
{--------}
procedure TffSqlExistsClause.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlExistsClause then begin
SubQuery.Free;
SubQuery := TffSqlSELECT.Create(Self);
SubQuery.Assign(TffSqlExistsClause(Source).SubQuery);
end else
AssignError(Source);
end;
function TffSqlExistsClause.DependsOn(Table: TFFSqlTableProxy): Boolean;
begin
Result := SubQuery.DependsOn(Table);
end;
destructor TffSqlExistsClause.Destroy;
begin
SubQuery.Free;
inherited;
end;
{--------}
procedure TffSqlExistsClause.EmitSQL(Stream: TStream);
begin
WriteStr(Stream,' EXISTS (');
SubQuery.EmitSQL(Stream);
WriteStr(Stream,')');
end;
{--------}
procedure TffSqlExistsClause.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
EnumMethod(Self);
SubQuery.EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlExistsClause.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlExistsClause)
and (SubQuery.Equals(TffSqlExistsClause(Other).SubQuery));
end;
{--------}
function TffSqlExistsClause.Reduce: Boolean;
begin
Result := SubQuery.Reduce;
end;
{====================================================================}
{===TffSqlUniqueClause===============================================}
function TffSqlUniqueClause.AsBoolean: Boolean;
begin
Result := SubQuery.CheckNoDups;
end;
{--------}
procedure TffSqlUniqueClause.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlUniqueClause then begin
SubQuery.Free;
SubQuery := TffSqlTableExp.Create(Self);
SubQuery.Assign(TffSqlUniqueClause(Source).SubQuery);
end else
AssignError(Source);
end;
function TffSqlUniqueClause.DependsOn(Table: TFFSqlTableProxy): Boolean;
begin
Result := SubQuery.DependsOn(Table);
end;
destructor TffSqlUniqueClause.Destroy;
begin
SubQuery.Free;
inherited;
end;
{--------}
procedure TffSqlUniqueClause.EmitSQL(Stream: TStream);
begin
WriteStr(Stream,' UNIQUE (');
SubQuery.EmitSQL(Stream);
WriteStr(Stream,')');
end;
{--------}
procedure TffSqlUniqueClause.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
EnumMethod(Self);
SubQuery.EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlUniqueClause.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlUniqueClause)
and (SubQuery.Equals(TffSqlUniqueClause(Other).SubQuery));
end;
{--------}
function TffSqlUniqueClause.Reduce: Boolean;
begin
Result := SubQuery.Reduce;
end;
{====================================================================}
function OffsetTime(const DateTime: TDateTime; DeltaH, DeltaM, DeltaS: Integer): TDateTime;
var
Mi, H, S, MSec : Word;
Hs, Mis, Ss : Integer;
DeltaD : Integer;
begin
DecodeTime(DateTime, H, Mi, S, MSec);
Hs := H;
Mis := Mi;
Ss := S;
Ss := Ss + (DeltaS mod 60);
Mis := Mis + (DeltaS div 60);
if Ss < 0 then begin
dec(Mis);
inc(Ss, 60);
end else
if Ss >= 60 then begin
inc(Mis);
dec(Ss, 60);
end;
Mis := Mis + (DeltaM mod 60);
Hs := Hs + (DeltaM div 60);
if Mis < 0 then begin
dec(Hs);
inc(Mis, 60);
end else
if Mis >= 60 then begin
inc(Hs);
dec(Mis, 60);
end;
Hs := Hs + (DeltaH mod 24);
DeltaD := (DeltaH div 24);
if Hs < 0 then begin
dec(DeltaD);
inc(Hs, 24);
end else
if Hs >= 24 then begin
inc(DeltaD);
dec(Hs, 24);
end;
Result := Round(DateTime) + EncodeTime(Hs, Mis, Ss, MSec) + DeltaD;
end;
{===TffSqlIntervalLiteral============================================}
function TffSqlIntervalLiteral.AddIntervalTo(Target: TDateTime): TDateTime;
begin
if not Converted then
ConvertToNative;
case StartDef of
iYear :
case EndDef of
iUnspec :
Result := IncMonth(Target, Y1 * 12);
else //iMonth :
Result := IncMonth(Target, Y1 * 12 + M1);
end;
iMonth :
Result := IncMonth(Target, M1);
iDay :
case EndDef of
iUnspec :
Result := Target + D1;
iHour :
Result := OffsetTime(Target, H1, 0, 0) + D1;
iMinute :
Result := OffsetTime(Target, H1, M1, 0) + D1;
else//iSecond :
Result := OffsetTime(Target, H1, M1, S1) + D1;
end;
iHour :
case EndDef of
iUnspec :
Result := OffsetTime(Target, H1, 0, 0);
iMinute :
Result := OffsetTime(Target, H1, M1, 0);
else//iSecond :
Result := OffsetTime(Target, H1, M1, S1);
end;
iMinute :
case EndDef of
iUnspec :
Result := OffsetTime(Target, 0, M1, 0);
else//iSecond :
Result := OffsetTime(Target, 0, M1, S1);
end;
else //iSecond :
Result := OffsetTime(Target, 0, 0, S1);
end;
end;
{--------}
function TffSqlIntervalLiteral.SubtractIntervalFrom(Target: TDateTime): TDateTime;
begin
if not Converted then
ConvertToNative;
case StartDef of
iYear :
case EndDef of
iUnspec :
Result := IncMonth(Target, -Y1 * 12);
else//iMonth :
Result := IncMonth(Target, -(Y1 * 12 + M1));
end;
iMonth :
Result := IncMonth(Target, -M1);
iDay :
case EndDef of
iUnspec :
Result := Target - D1;
iHour :
Result := OffsetTime(Target, -H1, 0, 0) - D1;
iMinute :
Result := OffsetTime(Target, -H1, -M1, 0) - D1;
else//iSecond :
Result := OffsetTime(Target, -H1, -M1, -S1) - D1;
end;
iHour :
case EndDef of
iUnspec :
Result := OffsetTime(Target, -H1, 0, 0);
iMinute :
Result := OffsetTime(Target, -H1, -M1, 0);
else//iSecond :
Result := OffsetTime(Target, -H1, -M1, -S1);
end;
iMinute :
case EndDef of
iUnspec :
Result := OffsetTime(Target, 0, -M1, 0);
else//iSecond :
Result := OffsetTime(Target, 0, -M1, -S1);
end;
else//iSecond :
Result := OffsetTime(Target, 0, 0, -S1);
end;
end;
{--------}
procedure TffSqlIntervalLiteral.ConvertToNative;
var
S : string;
P : Integer;
begin
S := Value;
case StartDef of
iUnspec :
SQLError('Internal error in date/time interval literal');
iYear :
case EndDef of
iUnspec :
Y1 := StrToInt(copy(S, 2, length(S) - 2));
iYear :
SQLError('Syntax error in year-month interval literal');
iMonth :
begin
P := PosCh('-', S);
if P = 0 then
SQLError('Syntax error in year-month interval literal: "-" expected');
Y1 := StrToInt(copy(S, 2, P - 2));
M1 := StrToInt(copy(S, P + 1, length(S) - P - 1));
end;
else
SQLError('Syntax error in year-month interval literal');
end;
iMonth :
case EndDef of
iUnspec :
M1 := StrToInt(copy(S, 2, length(S) - 2));
else
SQLError('Syntax error in year-month interval literal');
end;
iDay :
case EndDef of
iUnspec :
D1 := StrToInt(copy(S, 2, length(S) - 2));
iHour :
begin
P := PosCh(' ', S);
if P = 0 then
SQLError('Syntax error in date-time interval literal: " " expected');
D1 := StrToInt(copy(S, 2, P - 2));
H1 := StrToInt(copy(S, P + 1, length(S) - P - 1));
end;
iMinute :
begin
P := PosCh(' ', S);
if P = 0 then
SQLError('Syntax error in date-time interval literal: " " expected');
D1 := StrToInt(copy(S, 2, P - 2));
Delete(S, 2, P - 2);
P := PosCh(':', S);
if P = 0 then
SQLError('Syntax error in date-time interval literal: ":" expected');
H1 := StrToInt(copy(S, 2, P - 2));
M1 := StrToInt(copy(S, P + 1, length(S) - P - 1));
end;
iSecond :
begin
P := PosCh(' ', S);
if P = 0 then
SQLError('Syntax error in date-time interval literal: " " expected');
D1 := StrToInt(copy(S, 2, P - 2));
Delete(S, 2, P - 1);
P := PosCh(':', S);
if P = 0 then
SQLError('Syntax error in date-time interval literal: ":" expected');
H1 := StrToInt(copy(S, 2, P - 2));
Delete(S, 2, P - 1);
P := PosCh(':', S);
if P = 0 then
SQLError('Syntax error in date-time interval literal: ":" expected');
M1 := StrToInt(copy(S, 2, P - 2));
S1 := StrToInt(copy(S, P + 1, length(S) - P - 1));
end;
else
SQLError('Syntax error in date-time interval literal');
end;
iHour :
case EndDef of
iUnspec :
H1 := StrToInt(copy(S, 2, length(S) - 2));
iMinute :
begin
P := PosCh(':', S);
if P = 0 then
SQLError('Syntax error in date-time interval literal: ":" expected');
H1 := StrToInt(copy(S, 2, P - 2));
M1 := StrToInt(copy(S, P + 1, length(S) - P - 1));
end;
iSecond :
begin
P := PosCh(':', S);
if P = 0 then
SQLError('Syntax error in date-time interval literal: ":" expected');
H1 := StrToInt(copy(S, 2, P - 2));
Delete(S, 2, P - 1);
P := PosCh(':', S);
if P = 0 then
SQLError('Syntax error in date-time interval literal: ":" expected');
M1 := StrToInt(copy(S, 2, P - 2));
S1 := StrToInt(copy(S, P + 1, length(S) - P - 1));
end;
else
SQLError('Syntax error in date-time interval literal');
end;
iMinute :
case EndDef of
iUnspec :
M1 := StrToInt(copy(S, 2, length(S) - 2));
iSecond :
begin;
P := PosCh(':', S);
if P = 0 then
SQLError('Syntax error in date-time interval literal: ":" expected');
M1 := StrToInt(copy(S, 2, P - 2));
S1 := StrToInt(copy(S, P + 1, length(S) - P - 1));
end;
else
SQLError('Syntax error in date-time interval literal');
end;
iSecond :
case EndDef of
iUnspec :
S1 := StrToInt(copy(S, 2, length(S) - 2));
else
SQLError('Syntax error in date-time interval literal');
end;
else
SQLError('Syntax error in date-time interval literal');
end;
Converted := True;
end;
{--------}
procedure TffSqlIntervalLiteral.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlIntervalLiteral then begin
Value := TffSqlIntervalLiteral(Source).Value;
StartDef := TffSqlIntervalLiteral(Source).StartDef;
EndDef := TffSqlIntervalLiteral(Source).EndDef;
end else
AssignError(Source);
end;
procedure TffSqlIntervalLiteral.EmitSQL(Stream: TStream);
begin
WriteStr(Stream,' INTERVAL ');
WriteStr(Stream, Value);
WriteStr(Stream,' ');
WriteStr(Stream, DefStr[StartDef]);
if EndDef <> iUnspec then begin
WriteStr(Stream,' TO ');
WriteStr(Stream, DefStr[EndDef]);
end;
end;
{--------}
procedure TffSqlIntervalLiteral.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
EnumMethod(Self);
end;
{--------}
function TffSqlIntervalLiteral.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlIntervalLiteral)
and (AnsiCompareText(Value, TffSqlIntervalLiteral(Other).Value) = 0)
and (StartDef = TffSqlIntervalLiteral(Other).StartDef)
and (EndDef = TffSqlIntervalLiteral(Other).EndDef);
end;
{--------}
function TffSqlIntervalLiteral.GetType: TffFieldType;
begin
Result := fftInterval;
end;
{--------}
function TffSqlIntervalLiteral.GetValue: Variant;
begin
Result := '';
{This value returned to allow tests for NULL to pass}
end;
{--------}
procedure TffSqlIntervalLiteral.MatchType(ExpectedType: TffFieldType);
begin
case ExpectedType of
fftStDate,
fftDateTime :
;
else
TypeMismatch;
end;
if not Converted then
ConvertToNative;
end;
{====================================================================}
{===TffSqlTimestampLiteral===========================================}
procedure TffSqlTimestampLiteral.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlTimeStampLiteral then begin
Value := TffSqlTimeStampLiteral(Source).Value;
end else
AssignError(Source);
end;
procedure TffSqlTimeStampLiteral.ConvertToNative;
begin
if (length(Value) < 21)
or not (Value[6] in ['-', '.', '/'])
or (Value[9] <> Value[6])
or (Value[12] <> ' ')
or (Value[15] <> ':')
or (Value[18] <> ':') then
SQLError('Syntax error in time stamp literal');
DateTimeValue :=
EncodeDate(
StrToInt(copy(Value, 2, 4)),
StrToInt(copy(Value, 7, 2)),
StrToInt(copy(Value, 10, 2)))
+
EncodeTime(
StrToInt(copy(Value, 13, 2)),
StrToInt(copy(Value, 16, 2)),
StrToInt(copy(Value, 19, 2)),
0);
Converted := True;
end;
procedure TffSqlTimestampLiteral.EmitSQL(Stream: TStream);
begin
WriteStr(Stream,' TIMESTAMP ');
WriteStr(Stream, Value);
end;
{--------}
procedure TffSqlTimestampLiteral.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
EnumMethod(Self);
end;
{--------}
function TffSqlTimestampLiteral.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlTimestampLiteral)
and (AnsiCompareText(Value, TffSqlTimestampLiteral(Other).Value) = 0);
end;
{--------}
function TffSqlTimestampLiteral.GetType: TffFieldType;
begin
Result := fftDateTime;
end;
function TffSqlTimestampLiteral.GetValue: Variant;
begin
if not Converted then
ConvertToNative;
Result := DateTimeValue;
end;
{--------}
procedure TffSqlTimestampLiteral.MatchType(ExpectedType: TffFieldType);
begin
case ExpectedType of
fftStTime,
fftDateTime :
;
else
TypeMismatch;
end;
if not Converted then
ConvertToNative;
end;
{====================================================================}
{===TffSqlTimeLiteral================================================}
procedure TffSqlTimeLiteral.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlTimeLiteral then begin
Value := TffSqlTimeLiteral(Source).Value;
end else
AssignError(Source);
end;
procedure TffSqlTimeLiteral.ConvertToNative;
begin
if (length(Value) <> 10)
or (Value[4] <> ':')
or (Value[7] <> ':') then
SQLError('Syntax error in time literal');
TimeValue := EncodeTime(
StrToInt(copy(Value, 2, 2)),
StrToInt(copy(Value, 5, 2)),
StrToInt(copy(Value, 8, 2)),
0);
Converted := True;
end;
{--------}
procedure TffSqlTimeLiteral.EmitSQL(Stream: TStream);
begin
WriteStr(Stream,' TIME ');
WriteStr(Stream, Value);
end;
{--------}
procedure TffSqlTimeLiteral.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
EnumMethod(Self);
end;
{--------}
function TffSqlTimeLiteral.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlTimeLiteral)
and (AnsiCompareText(Value, TffSqlTimeLiteral(Other).Value) = 0);
end;
{--------}
function TffSqlTimeLiteral.GetType: TffFieldType;
begin
Result := fftStTime;
end;
function TffSqlTimeLiteral.GetValue: Variant;
begin
if not Converted then
ConvertToNative;
Result := TimeValue;
end;
{--------}
procedure TffSqlTimeLiteral.MatchType(ExpectedType: TffFieldType);
begin
case ExpectedType of
fftStTime,
fftDateTime :
;
else
TypeMismatch;
end;
if not Converted then
ConvertToNative;
end;
{====================================================================}
{===TffSqlDateLiteral================================================}
{--------}
procedure TffSqlDateLiteral.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlDateLiteral then begin
Value := TffSqlDateLiteral(Source).Value;
end else
AssignError(Source);
end;
procedure TffSqlDateLiteral.ConvertToNative;
begin
if (length(Value) <> 12)
or not (Value[6] in ['-', '.', '/'])
or (Value[9] <> Value[6]) then
SQLError('Syntax error in date literal');
DateValue := EncodeDate(
StrToInt(copy(Value, 2, 4)),
StrToInt(copy(Value, 7, 2)),
StrToInt(copy(Value, 10, 2)));
Converted := True;
end;
{--------}
procedure TffSqlDateLiteral.EmitSQL(Stream: TStream);
begin
WriteStr(Stream,' DATE ');
WriteStr(Stream, Value);
end;
{--------}
procedure TffSqlDateLiteral.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
EnumMethod(Self);
end;
{--------}
function TffSqlDateLiteral.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlDateLiteral)
and (AnsiCompareText(Value, TffSqlDateLiteral(Other).Value) = 0);
end;
{--------}
function TffSqlDateLiteral.GetType: TffFieldType;
begin
Result := fftStDate;
end;
function TffSqlDateLiteral.GetValue: Variant;
begin
if not Converted then
ConvertToNative;
Result := DateValue;
end;
{--------}
procedure TffSqlDateLiteral.MatchType(ExpectedType: TffFieldType);
begin
case ExpectedType of
fftStDate,
fftDateTime :
;
else
TypeMismatch;
end;
if not Converted then
ConvertToNative;
end;
{===TffSqlBooleanLiteral================================================}
{--------}
procedure TffSqlBooleanLiteral.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlBooleanLiteral then begin
Value := TffSqlBooleanLiteral(Source).Value;
end else
AssignError(Source);
end;
{--------}
procedure TffSqlBooleanLiteral.EmitSQL(Stream: TStream);
begin
if Value then
WriteStr(Stream, ' TRUE')
else
WriteStr(Stream, ' FALSE');
end;
{--------}
procedure TffSqlBooleanLiteral.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
EnumMethod(Self);
end;
{--------}
function TffSqlBooleanLiteral.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlBooleanLiteral)
and (Value = TffSqlBooleanLiteral(Other).Value);
end;
{--------}
function TffSqlBooleanLiteral.GetType: TffFieldType;
begin
Result := fftBoolean;
end;
function TffSqlBooleanLiteral.GetValue: Boolean;
begin
Result := Value;
end;
{--------}
procedure TffSqlBooleanLiteral.MatchType(ExpectedType: TffFieldType);
begin
case ExpectedType of
fftBoolean : ;
else
TypeMismatch;
end;
end;
{====================================================================}
const
FuncStr : array[TffSqlScalarFunction] of string = (
'CASE', 'CHARACTER_LENGTH','COALESCE', 'CURRENT_DATE','CURRENT_TIME','CURRENT_TIMESTAMP',
'CURRENT_USER','LOWER','UPPER','POSITION','SESSION_USER','SUBSTRING',
'SYSTEM_USER','TRIM','EXTRACT', 'NULLIF',
'ABS', 'CEIL', 'FLOOR', 'EXP', 'LOG', 'POWER', 'RAND', 'ROUND'); {!!.11}
LeadStr : array[TffSqlLTB] of string = ('BOTH', 'LEADING', 'TRAILING');
{===TffSqlScalarFunc=================================================}
procedure TffSqlScalarFunc.CheckIsConstant;
begin
FIsConstantChecked := True;
case SQLFunction of
sfCase :
FIsConstant := CaseExp.IsConstant;
sfCharlen :
FIsConstant := Arg1.IsConstant;
sfCoalesce :
FIsConstant := False;
sfCurrentDate :
FIsConstant := True;
sfCurrentTime :
FIsConstant := True;
sfCurrentTimestamp :
FIsConstant := True;
sfCurrentUser :
FIsConstant := True;
sfLower :
FIsConstant := Arg1.IsConstant;
sfUpper :
FIsConstant := Arg1.IsConstant;
sfPosition :
FIsConstant := Arg2.IsConstant and Arg1.IsConstant;
sfSessionUser :
FIsConstant := True;
sfSubstring :
FIsConstant :=
Arg1.IsConstant and Arg2.IsConstant and
((Arg3 = nil) or (Arg3.IsConstant));
sfSystemUser :
FIsConstant := True;
sfTrim :
FIsConstant :=
((Arg1 = nil) or (Arg1.IsConstant))
and ((Arg2 = nil) or (Arg2.IsConstant));
sfExtract :
FIsConstant := Arg1.IsConstant;
sfNullIf :
FIsConstant := Arg2.IsConstant and Arg1.IsConstant;
{!!.11 begin}
sfAbs, sfCeil, sfFloor, sfExp, sfLog, sfRound :
FIsConstant := Arg1.IsConstant;
sfRand :
FIsConstant := False;
sfPower :
FIsConstant := Arg2.IsConstant and Arg1.IsConstant;
{!!.11 end}
else
Assert(False);
end;
if FIsConstant then begin
FIsConstant := False;
ConstantValue := GetValue;
FIsConstant := True;
end;
end;
procedure TffSqlScalarFunc.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlScalarFunc then begin
Clear;
SQLFunction := TffSqlScalarFunc(Source).SQLFunction;
if assigned(TffSqlScalarFunc(Source).Arg1) then begin
Arg1 := TffSqlSimpleExpression.Create(Self);
Arg1.Assign(TffSqlScalarFunc(Source).Arg1);
end;
if assigned(TffSqlScalarFunc(Source).Arg2) then begin
Arg2 := TffSqlSimpleExpression.Create(Self);
Arg2.Assign(TffSqlScalarFunc(Source).Arg2);
end;
if assigned(TffSqlScalarFunc(Source).Arg3) then begin
Arg3 := TffSqlSimpleExpression.Create(Self);
Arg3.Assign(TffSqlScalarFunc(Source).Arg3);
end;
LTB := TffSqlScalarFunc(Source).LTB;
XDef := TffSqlScalarFunc(Source).XDef;
if assigned(TffSqlScalarFunc(Source).CaseExp) then begin
CaseExp := TffSqlCaseExpression.Create(Self);
CaseExp.Assign(TffSqlScalarFunc(Source).CaseExp);
end;
if assigned(TffSqlScalarFunc(Source).CoalesceExp) then begin
CoalesceExp := TffSqlCoalesceExpression.Create(Self);
CoalesceExp.Assign(TffSqlScalarFunc(Source).CoalesceExp);
end;
end else
AssignError(Source);
end;
procedure TffSqlScalarFunc.Clear;
begin
CaseExp.Free;
CoalesceExp.Free;
Arg1.Free;
Arg2.Free;
Arg3.Free;
CaseExp:= nil;
CoalesceExp:= nil;
Arg1:= nil;
Arg2:= nil;
Arg3:= nil;
end;
function TffSqlScalarFunc.DependsOn(Table: TFFSqlTableProxy): Boolean;
begin
case SQLFunction of
sfCase :
Result := CaseExp.DependsOn(Table);
sfCharlen,
sfLower,
sfUpper,
sfExtract :
Result := Arg1.DependsOn(Table);
sfCoalesce :
Result := CoalesceExp.DependsOn(Table);
sfSystemUser,
sfCurrentDate,
sfCurrentTime,
sfCurrentTimestamp,
sfCurrentUser,
sfSessionUser :
Result := False;
sfPosition :
Result := Arg2.DependsOn(Table) or Arg1.DependsOn(Table);
sfSubstring :
begin
Result := Arg1.DependsOn(Table) or Arg2.DependsOn(Table);
if not Result and (Arg3 <> nil) then
Result := Arg3.DependsOn(Table);
end;
sfTrim :
begin
if Arg2 = nil then
Result := Arg1.DependsOn(Table)
else
Result := Arg1.DependsOn(Table) or Arg2.DependsOn(Table)
end;
sfNullIf :
begin
Result := Arg1.DependsOn(Table) or Arg2.DependsOn(Table);
end;
{!!.11 begin}
sfAbs, sfCeil, sfFloor, sfExp, sfLog, sfRound :
Result := Arg1.DependsOn(Table) ;
sfRand :
Result := False;
sfPower :
Result := Arg1.DependsOn(Table) or Arg2.DependsOn(Table);
{!!.11 end}
else
Assert(False);
Result := False;
end;
end;
destructor TffSqlScalarFunc.Destroy;
begin
Clear;
inherited;
end;
procedure TffSqlScalarFunc.EmitSQL(Stream: TStream);
begin
WriteStr(Stream, ' ');
case SQLFunction of
sfCase :
CaseExp.EmitSQL(Stream);
sfCoalesce :
CoalesceExp.EmitSQL(Stream);
sfCurrentDate,
sfCurrentTime,
sfCurrentTimestamp,
sfCurrentUser,
sfSessionUser,
sfSystemUser,
sfRand : {!!.11}
WriteStr(Stream, FuncStr[SQLFunction]);
else
WriteStr(Stream, FuncStr[SQLFunction]);
WriteStr(Stream,'(');
case SQLFunction of
sfCharlen,
sfLower,
sfUpper,
sfAbs, sfCeil, sfFloor, sfExp, sfLog, sfRound : {!!.11}
begin
Arg1.EmitSQL(Stream);
end;
sfNullIf,
sfPosition,
sfPower : {!!.11}
begin
Arg1.EmitSQL(Stream);
WriteStr(Stream,' , ');
Arg2.EmitSQL(Stream);
end;
sfSubstring :
begin
Arg1.EmitSQL(Stream);
WriteStr(Stream,' FROM ');
Arg2.EmitSQL(Stream);
if Arg3 <> nil then begin
WriteStr(Stream,' FOR ');
Arg3.EmitSQL(Stream);
end;
end;
sfTrim :
begin
WriteStr(Stream, LeadStr[LTB]);
WriteStr(Stream, ' ');
if Arg1 <> nil then
Arg1.EmitSQL(Stream);
if Arg2 <> nil then begin
WriteStr(Stream,' FROM ');
Arg2.EmitSQL(Stream);
end;
end;
sfExtract :
begin
WriteStr(Stream, DefStr[XDef]);
WriteStr(Stream,' FROM ');
Arg1.EmitSQL(Stream);
end;
end;
WriteStr(Stream,')');
end;
end;
{--------}
procedure TffSqlScalarFunc.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
EnumMethod(Self);
case SQLFunction of
sfCase :
CaseExp.EnumNodes(EnumMethod, Deep);
sfCoalesce :
CoalesceExp.EnumNodes(EnumMethod, Deep);
sfCurrentDate,
sfCurrentTime,
sfCurrentTimestamp,
sfCurrentUser,
sfSessionUser,
sfSystemUser,
sfRand : {!!.11}
;
else
case SQLFunction of
sfCharlen,
sfLower,
sfUpper,
sfExtract,
sfAbs, sfCeil, sfFloor, sfExp, sfLog, sfRound : {!!.11}
Arg1.EnumNodes(EnumMethod, Deep);
sfNullIf,
sfPosition,
sfPower : {!!.11}
begin
Arg1.EnumNodes(EnumMethod, Deep);
Arg2.EnumNodes(EnumMethod, Deep);
end;
sfSubstring :
begin
Arg1.EnumNodes(EnumMethod, Deep);
Arg2.EnumNodes(EnumMethod, Deep);
if Arg3 <> nil then
Arg3.EnumNodes(EnumMethod, Deep);
end;
sfTrim :
begin
if Arg1 <> nil then
Arg1.EnumNodes(EnumMethod, Deep);
if Arg2 <> nil then
Arg2.EnumNodes(EnumMethod, Deep);
end;
end;
end;
end;
{--------}
function TffSqlScalarFunc.Equals(Other: TffSqlNode): Boolean;
begin
Result := False;
if Other is TffSqlScalarFunc then begin
if SQLFunction <> TffSqlScalarFunc(Other).SQLFunction then
exit;
case SQLFunction of
sfCase :
if not CaseExp.Equals(TffSqlScalarFunc(Other).CaseExp) then
exit;
sfCoalesce :
if not CoalesceExp.Equals(TffSqlScalarFunc(Other).CoalesceExp) then
exit;
sfCharlen,
sfLower,
sfUpper,
sfExtract,
sfAbs, sfCeil, sfFloor, sfExp, sfLog, sfRound : {!!.11}
if not Arg1.Equals(TffSqlScalarFunc(Other).Arg1) then
exit;
sfNullIf,
sfPosition,
sfPower : {!!.11}
begin
if not Arg1.Equals(TffSqlScalarFunc(Other).Arg1) then
exit;
if not Arg2.Equals(TffSqlScalarFunc(Other).Arg2) then
exit;
end;
sfSubstring :
begin
if not Arg1.Equals(TffSqlScalarFunc(Other).Arg1) then
exit;
if not Arg2.Equals(TffSqlScalarFunc(Other).Arg2) then
exit;
if not (
BothNil(Arg3, TffSqlScalarFunc(Other).Arg3)
or (BothNonNil(Arg3, TffSqlScalarFunc(Other).Arg3)
and Arg3.Equals(TffSqlScalarFunc(Other).Arg3))) then
exit;
end;
sfTrim :
begin
if not (
BothNil(Arg1, TffSqlScalarFunc(Other).Arg1)
or (BothNonNil(Arg1, TffSqlScalarFunc(Other).Arg1)
and Arg1.Equals(TffSqlScalarFunc(Other).Arg1))) then
exit;
if not (
BothNil(Arg2, TffSqlScalarFunc(Other).Arg2)
or (BothNonNil(Arg2, TffSqlScalarFunc(Other).Arg2)
and Arg2.Equals(TffSqlScalarFunc(Other).Arg2))) then
exit;
end;
end;
Result := True;
end;
end;
{--------}
function TffSqlScalarFunc.GetDecimals: Integer;
begin
Result := 0;
end;
{--------}
function TffSqlScalarFunc.GetSize: Integer;
var
S : string;
begin
{should only be called on text functions}
case SQLFunction of
sfCase :
Result := CaseExp.GetSize;
sfLower,
sfUpper,
sfSubstring :
Result := Arg1.GetSize;
sfTrim :
if Arg2 = nil then
Result := Arg1.GetSize
else
Result := Arg2.GetSize;
sfCoalesce :
Result := CoalesceExp.GetSize;
sfCurrentUser,
sfSystemUser,
sfSessionUser :
begin
S := GetValue;
Result := length(S);
end;
sfNullIf :
Result := Arg1.GetSize;
else
Result := 0;
end;
end;
{--------}
function TffSqlScalarFunc.GetTitle(const Qualified : Boolean): string; {!!.11}
begin
Result := FuncStr[SQLFunction];
end;
{--------}
procedure TffSqlScalarFunc.CheckType;
begin
case SQLFunction of
sfCase :
FType := CaseExp.GetType;
sfCharlen :
begin
Arg1.MatchType(fftShortString);
FType := fftInt32;
end;
sfCoalesce :
FType := CoalesceExp.GetType;
sfCurrentDate :
FType := fftStDate;
sfCurrentTime :
FType := fftStTime;
sfCurrentTimestamp :
FType := fftDateTime;
sfCurrentUser :
FType := fftShortAnsiStr;
sfLower :
begin
Arg1.MatchType(fftShortString);
FType := fftShortAnsiStr;
end;
sfUpper :
begin
Arg1.MatchType(fftShortString);
FType := fftShortAnsiStr;
end;
sfPosition :
begin
Arg1.MatchType(fftShortString);
Arg2.MatchType(fftShortString);
FType := fftInt32;
end;
sfSessionUser :
FType := fftShortAnsiStr;
sfSubstring :
begin
Arg1.MatchType(fftShortString);
Arg2.MatchType(fftInt32);
if Arg3 <> nil then
Arg3.MatchType(fftInt32);
FType := fftShortAnsiStr;
end;
sfSystemUser :
FType := fftShortAnsiStr;
sfTrim :
begin
if Arg1 <> nil then
Arg1.MatchType(fftShortString);
if Arg2 <> nil then
Arg2.MatchType(fftShortString);
FType := fftShortAnsiStr;
end;
sfExtract :
begin
Arg1.MatchType(fftDateTime);
FType := fftInt32;
end;
sfNullIf :
FType := Arg1.GetType;
{!!.11 begin}
sfAbs, {sfCeil, sfFloor, }sfExp, sfLog, sfRound, sfRand, sfPower : {!!.12}
FType := fftDouble;
{!!.11 end}
sfCeil, sfFloor: {!!.12}
case Arg1.GetType of {!!.12}
fftStDate..fftDateTime : {!!.12}
FType := Arg1.GetType; {!!.12}
else {!!.12}
FType := fftDouble; {!!.12}
end; {!!.12}
else
Assert(False);
end;
TypeKnown := True;
end;
{--------}
function TffSqlScalarFunc.GetType: TffFieldType;
begin
if not TypeKnown then
CheckType;
Result := FType;
end;
{Begin !!.13}
{--------}
function ConvertBLOBToString(const Value : Variant) : string;
{ Converts a BLOB value to a string value.
Assumption: Value is always a var array of byte }
var
ResultLen : Longint;
VPtr : PAnsiChar;
begin
ResultLen := VarArrayHighBound(Value, 1);
SetLength(Result, ResultLen);
VPtr := VarArrayLock(Value);
try
Move(VPtr^, Result[1], ResultLen);
finally
VarArrayUnlock(Value);
end;
end;
{End !!.13}
{--------}
function TffSqlScalarFunc.GetValue: Variant;
{Revised !!.13 - Scalar functions updated to recognize BLOB fields as
arrays of bytes instead of as strings. }
var
S : string;
WS, WS2 : widestring; {!!.11}
I1, I2 : Integer;
Y, M, D : Word;
Hour, Min, Sec, MSec : Word;
Ch : Char;
DT : TDateTime;
V, V2 : Variant; {!!.11}
begin
if IsConstant then begin
Result := ConstantValue;
exit;
end;
case SQLFunction of
sfCase :
Result := CaseExp.GetValue;
sfCharlen :
begin
V := Arg1.GetValue;
if VarIsNull(V) then
Result := V
else if (VarType(V) and VarTypeMask = varByte) then
Result := VarArrayHighBound(V, 1)
else
Result := length(V);
end;
sfCoalesce :
Result := CoalesceExp.GetValue;
sfCurrentDate :
Result := Owner.StartDate;
sfCurrentTime :
Result := Owner.StartTime;
sfCurrentTimestamp :
Result := Owner.StartDateTime;
sfCurrentUser :
Result := IntToStr(Owner.FClientID);
sfLower :
begin
V := Arg1.GetValue;
if VarIsNull(V) then
Result := V
else if (VarType(V) and VarTypeMask = varByte) then
Result := AnsiLowerCase(ConvertBLOBToString(V))
else
Result := AnsiLowerCase(V);
end;
sfUpper :
begin
V := Arg1.GetValue;
if VarIsNull(V) then
Result := V
else if (VarType(V) and VarTypeMask = varByte) then
Result := AnsiUpperCase(ConvertBLOBToString(V))
else
Result := AnsiUpperCase(V);
end;
sfPosition :
begin
V := Arg1.GetValue;
V2 := Arg2.GetValue;
if VarIsNull(V) or VarIsNull(V2) then
Result := 0
else begin
WS := V;
if WS = '' then
Result := 1
else begin
if (VarType(V2) and VarTypeMask = varByte) then
WS2 := ConvertBLOBToString(V2)
else
WS2 := V2;
Result := Pos(WS, WS2);
end; { if }
end; { if }
end;
sfSessionUser :
Result := IntToStr(Owner.FSessionID);
sfSubstring :
begin
V := Arg1.GetValue;
if VarIsNull(V) then
Result := V
else begin
if (VarType(V) and VarTypeMask = varByte) then
S := ConvertBLOBToString(V)
else
S := V;
I1 := Arg2.GetValue;
if Arg3 = nil then
Result := copy(S, I1, length(S))
else begin
I2 := Arg3.GetValue;
Result := copy(S, I1, I2);
end;
end;
end;
sfSystemUser :
SQLError('SYSTEM_USER is not supported at this time');
sfTrim :
begin
if Arg2 = nil then begin
V := Arg1.GetValue;
if VarIsNull(V) then begin
Result := V;
Exit;
end;
if (VarType(V) and VarTypeMask = varByte) then
S := ConvertBLOBToString(V)
else
S := V;
Ch := ' ';
end else
if Arg1 = nil then begin
V := Arg2.GetValue;
if VarIsNull(V) then begin
Result := V;
Exit;
end;
if (VarType(V) and VarTypeMask = varByte) then
S := ConvertBLOBToString(V)
else
S := V;
Ch := ' ';
end else begin
V := Arg1.GetValue;
if VarIsNull(V) then begin
Result := V;
Exit;
end;
if (VarType(V) and VarTypeMask = varByte) then
S := ConvertBLOBToString(V)
else
S := V;
Ch := S[1];
V := Arg2.GetValue;
if VarIsNull(V) then
S := ''
else if (VarType(V) and VarTypeMask = varByte) then
S := ConvertBLOBToString(V)
else
S := V;
end;
case LTB of
ltbBoth :
begin
while (length(S) > 0) and (S[1] = Ch) do
Delete(S, 1, 1);
while (length(S) > 0) and (S[length(S)] = Ch) do
Delete(S, length(S), 1);
end;
ltbLeading :
while (length(S) > 0) and (S[1] = Ch) do
Delete(S, 1, 1);
ltbTrailing :
while (length(S) > 0) and (S[length(S)] = Ch) do
Delete(S, length(S), 1);
end;
Result := S;
end;
sfExtract :
begin
V := Arg1.GetValue;
if VarIsNull(V) then begin
Result := V;
exit;
end;
DT := V;
case XDef of
iYear :
begin
DecodeDate(DT, Y, M, D);
Result := Y;
end;
iMonth :
begin
DecodeDate(DT, Y, M, D);
Result := M;
end;
iDay :
begin
DecodeDate(DT, Y, M, D);
Result := D;
end;
iHour :
begin
DecodeTime(DT, Hour, Min, Sec, MSec);
Result := Hour;
end;
iMinute:
begin
DecodeTime(DT, Hour, Min, Sec, MSec);
Result := Min;
end;
else
//iSecond:
begin
DecodeTime(DT, Hour, Min, Sec, MSec);
Result := Sec;
end;
end;
end;
sfNullIf :
begin
V := Arg1.GetValue;
if V = Arg2.GetValue then
Result := Null
else
Result := V;
end;
sfAbs :
begin
V := Arg1.GetValue;
if VarIsNull(V) then
Result := V
else
Result := abs(V);
end;
sfCeil :
begin
V := Arg1.GetValue;
if VarIsNull(V) then
Result := V
else
Result := Ceil(V);
end;
sfFloor :
begin
V := Arg1.GetValue;
if VarIsNull(V) then
Result := V
else
Result := Floor(V);
end;
sfExp :
begin
V := Arg1.GetValue;
if VarIsNull(V) then
Result := V
else
Result := Exp(V);
end;
sfLog :
begin
V := Arg1.GetValue;
if VarIsNull(V) then
Result := V
else
Result := Ln(V);
end;
sfRound :
begin
V := Arg1.GetValue;
if VarIsNull(V) then
Result := V
else
Result := 1.0 * Round(V);
end;
sfRand :
Result := Random;
sfPower :
begin
V := Arg1.GetValue;
if VarIsNull(V) then
Result := V
else begin
V2 := Arg2.GetValue;
if VarIsNull(V2) then
Result := V2
else
Result := Power(V, V2);
end;
end;
else
Assert(False);
end;
end;
function TffSqlScalarFunc.IsConstant: Boolean;
begin
if not FIsConstantChecked then
CheckIsConstant;
Result := FIsConstant;
end;
function TffSqlScalarFunc.IsFieldFrom(Table: TFFSqlTableProxy;
var FieldReferenced: TFFSqlFieldProxy): Boolean;
var
SameCase: Boolean;
begin
if SQLFunction in [sfUpper, sfLower] then
Result := Arg1.IsFieldFrom(Table, FieldReferenced, SameCase)
else
Result := False;
end;
procedure TffSqlScalarFunc.MatchType(ExpectedType: TffFieldType);
begin
case ExpectedType of
{!!.11 begin}
fftChar,
fftWideChar,
fftShortString,
fftShortAnsiStr,
fftNullString,
fftNullAnsiStr,
fftWideString,
fftBLOB..fftBLOBTypedBin :
case GetType of
fftChar,
fftWideChar,
fftShortString,
fftShortAnsiStr,
fftNullString,
fftNullAnsiStr,
fftWideString,
fftBLOB..fftBLOBTypedBin :
; {ok}
else
TypeMismatch;
end;
{!!.11 end}
fftStDate,
fftStTime,
fftDateTime:
case GetType of
fftStDate,
fftStTime,
fftDateTime:
; {ok}
else
TypeMismatch;
end;
else
if GetType <> ExpectedType then
TypeMismatch;
end;
end;
{--------}
function TffSqlScalarFunc.Reduce: Boolean;
begin
case SQLFunction of
sfCase :
Result := CaseExp.Reduce;
sfCharlen :
Result := Arg1.Reduce;
sfCoalesce :
Result := CoalesceExp.Reduce;
sfCurrentDate :
Result := False;
sfCurrentTime :
Result := False;
sfCurrentTimestamp :
Result := False;
sfCurrentUser :
Result := False;
sfLower :
Result := Arg1.Reduce;
sfUpper :
Result := Arg1.Reduce;
sfPosition :
begin
Result := Arg1.Reduce;
if not Result and (Arg2 <> nil) then
Result := Arg2.Reduce;
end;
sfSessionUser :
Result := False;
sfSubstring :
begin
Result := Arg1.Reduce or Arg2.Reduce;
if not Result and (Arg3 <> nil) then
Result := Arg3.Reduce;
end;
sfSystemUser :
Result := False;
sfTrim :
begin
if Arg2 = nil then begin
Result := Arg1.Reduce
end else
if Arg1 = nil then begin
Result := Arg2.Reduce;
end else begin
Result := Arg1.Reduce or Arg2.Reduce;
end;
end;
sfExtract :
begin
Result := Arg1.Reduce;
end;
sfNullIf :
begin
Result := Arg1.Reduce or Arg2.Reduce;
end;
{!!.11 begin}
sfAbs, sfCeil, sfFloor, sfExp, sfLog, sfRound :
Result := Arg1.Reduce;
sfRand :
Result := False;
sfPower :
Result := Arg1.Reduce or Arg2.Reduce;
{!!.11 end}
else
Result := False;
end;
end;
{--------}
procedure TffSqlScalarFunc.ResetConstant;
begin
FIsConstantChecked := False;
FIsConstant := False;
end;
{====================================================================}
{===TffSqlWhenClauseList=============================================}
function TffSqlWhenClauseList.AddWhenClause(Value: TffSqlWhenClause): TffSqlWhenClause;
begin
WhenClauseList.Add(Value);
Result := Value;
end;
{--------}
procedure TffSqlWhenClauseList.Assign(const Source: TffSqlNode);
var
i : Integer;
begin
if Source is TffSqlWhenClauseList then begin
Clear;
for i := 0 to pred(TffSqlWhenClauseList(Source).WhenClauseCount) do
AddWhenClause(TffSqlWhenClause.Create(Self)).Assign(
TffSqlWhenClauseList(Source).WhenClause[i]);
end else
AssignError(Source);
end;
procedure TffSqlWhenClauseList.CheckIsConstant;
var
i : Integer;
begin
FIsConstantChecked := True;
for i := 0 to pred(WhenClauseCount) do
if not WhenClause[i].IsConstant then begin
FIsConstant := False;
exit;
end;
FIsConstant := True;
end;
constructor TffSqlWhenClauseList.Create(AParent: TffSqlNode);
begin
inherited Create(AParent);
WhenClauseList := TList.Create;
end;
{--------}
function TffSqlWhenClauseList.DependsOn(Table: TFFSqlTableProxy): Boolean;
var
i : Integer;
begin
for i := 0 to pred(WhenClauseCount) do
if WhenClause[i].DependsOn(Table) then begin
Result := True;
exit;
end;
Result := False;
end;
{--------}
procedure TffSqlWhenClauseList.Clear;
var
i : Integer;
begin
for i := 0 to pred(WhenClauseCount) do
WhenClause[i].Free;
WhenClauseList.Clear;
end;
{--------}
destructor TffSqlWhenClauseList.Destroy;
begin
Clear;
WhenClauseList.Free;
inherited;
end;
{--------}
procedure TffSqlWhenClauseList.EmitSQL(Stream: TStream);
var
i : Integer;
begin
for i := 0 to pred(WhenClauseCount) do
WhenClause[i].EmitSQL(Stream);
end;
{--------}
procedure TffSqlWhenClauseList.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
var
i : Integer;
begin
EnumMethod(Self);
for i := 0 to pred(WhenClauseCount) do
WhenClause[i].EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlWhenClauseList.Equals(Other: TffSqlNode): Boolean;
var
i : Integer;
begin
Result := False;
if Other is TffSqlWhenClauseList then begin
if WhenClauseCount <> TffSqlWhenClauseList(Other).WhenClauseCount then
exit;
for i := 0 to pred(WhenClauseCount) do
if not WhenClause[i].Equals(TffSqlWhenClauseList(Other).WhenClause[i]) then
exit;
Result := True;
end;
end;
{--------}
function TffSqlWhenClauseList.GetWhenClause(
Index: Integer): TffSqlWhenClause;
begin
Result := TffSqlWhenClause(WhenClauseList[Index]);
end;
{--------}
function TffSqlWhenClauseList.GetWhenClauseCount: Integer;
begin
Result := WhenClauseList.Count;
end;
{--------}
function TffSqlWhenClauseList.IsConstant: Boolean;
begin
if not FIsConstantChecked then
CheckIsConstant;
Result := FIsConstant;
end;
procedure TffSqlWhenClauseList.ResetConstant;
begin
FIsConstantChecked := False;
FIsConstant := False;
end;
{====================================================================}
{===TffSqlWhenClause=================================================}
procedure TffSqlWhenClause.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlWhenClause then begin
if WhenExp = nil then
WhenExp := TffSqlCondExp.Create(Self);
WhenExp.Assign(TffSqlWhenClause(Source).WhenExp);
ThenExp.Free;
ThenExp := nil;
if assigned(TffSqlWhenClause(Source).ThenExp) then begin
ThenExp := TffSqlSimpleExpression.Create(Self);
ThenExp.Assign(TffSqlWhenClause(Source).ThenExp);
end;
end else
AssignError(Source);
end;
procedure TffSqlWhenClause.CheckIsConstant;
begin
FIsConstantChecked := True;
FIsConstant := WhenExp.IsConstant and
(not assigned(ThenExp) or
ThenExp.IsConstant);
end;
{--------}
function TffSqlWhenClause.DependsOn(Table: TFFSqlTableProxy): Boolean;
begin
Result := WhenExp.DependsOn(Table) or
((ThenExp <> nil) and ThenExp.DependsOn(Table));
end;
destructor TffSqlWhenClause.Destroy;
begin
WhenExp.Free;
ThenExp.Free;
inherited;
end;
procedure TffSqlWhenClause.EmitSQL(Stream: TStream);
begin
WriteStr(Stream,' WHEN ');
WhenExp.EmitSQL(Stream);
WriteStr(Stream,' THEN ');
if ThenExp <> nil then
ThenExp.EmitSQL(Stream)
else
WriteStr(Stream,' NULL');
end;
{--------}
procedure TffSqlWhenClause.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
EnumMethod(Self);
WhenExp.EnumNodes(EnumMethod, Deep);
if assigned(ThenExp) then
ThenExp.EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlWhenClause.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlWhenClause)
and (WhenExp.Equals(TffSqlWhenClause(Other).WhenExp))
and
BothNil(ThenExp, TffSqlWhenClause(Other).ThenExp)
or (BothNonNil(ThenExp, TffSqlWhenClause(Other).ThenExp)
and (ThenExp.Equals(TffSqlWhenClause(Other).ThenExp)));
end;
{--------}
function TffSqlWhenClause.IsConstant: Boolean;
begin
if not FIsConstantChecked then
CheckIsConstant;
Result := FIsConstant;
end;
procedure TffSqlWhenClause.ResetConstant;
begin
FIsConstantChecked := False;
FIsConstant := False;
end;
{====================================================================}
{===TffSqlCaseExpression=============================================}
procedure TffSqlCaseExpression.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlCaseExpression then begin
if WhenClauseList = nil then
WhenClauseList := TffSqlWhenClauseList.Create(Self);
WhenClauseList.Assign(TffSqlCaseExpression(Source).WhenClauseList);
ElseExp.Free;
ElseExp := nil;
if Assigned(TffSqlCaseExpression(Source).ElseExp) then begin
ElseExp := TffSqlSimpleExpression.Create(Self);
ElseExp.Assign(TffSqlCaseExpression(Source).ElseExp);
end;
end else
AssignError(Source);
end;
procedure TffSqlCaseExpression.CheckIsConstant;
begin
FIsConstantChecked := True;
FIsConstant :=
WhenClauseList.IsConstant and ((ElseExp = nil) or ElseExp.IsConstant);
if FIsConstant then begin
FIsConstant := False;
ConstantValue := GetValue;
FIsConstant := True;
end;
end;
function TffSqlCaseExpression.DependsOn(Table: TFFSqlTableProxy): Boolean;
begin
Result := WhenClauseList.DependsOn(Table) or
(ElseExp <> nil) and ElseExp.DependsOn(Table);
end;
destructor TffSqlCaseExpression.Destroy;
begin
WhenClauseList.Free;
ElseExp.Free;
inherited;
end;
procedure TffSqlCaseExpression.EmitSQL(Stream: TStream);
begin
WriteStr(Stream,' CASE');
WhenClauseList.EmitSQL(Stream);
WriteStr(Stream,' ELSE ');
if ElseExp <> nil then
ElseExp.EmitSQL(Stream)
else
WriteStr(Stream, 'NULL');
WriteStr(Stream,' END');
end;
{--------}
procedure TffSqlCaseExpression.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
EnumMethod(Self);
WhenClauseList.EnumNodes(EnumMethod, Deep);
if ElseExp <> nil then
ElseExp.EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlCaseExpression.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlCaseExpression)
and WhenClauseList.Equals(TffSqlCaseExpression(Other).WhenClauseList)
and (BothNil(ElseExp, TffSqlCaseExpression(Other).ElseExp)
or (BothNonNil(ElseExp, TffSqlCaseExpression(Other).ElseExp)
and
ElseExp.Equals(TffSqlCaseExpression(Other).ElseExp)
)
);
end;
{--------}
function TffSqlCaseExpression.GetSize: Integer;
var
i : Integer;
begin
Result := 0;
for i := 0 to pred(WhenClauseList.WhenClauseCount) do
if WhenClauseList.WhenClause[i].ThenExp <> nil then
Result := FFMaxI(Result, WhenClauseList.WhenClause[i].ThenExp.GetSize);
if ElseExp <> nil then
Result := FFMaxI(Result, ElseExp.GetSize);
end;
function TffSqlCaseExpression.GetType: TffFieldType;
begin
if WhenClauseList.WhenClause[0].ThenExp <> nil then
Result := WhenClauseList.WhenClause[0].ThenExp.GetType
else
Result := fftShortString; {actually, NULL}
end;
function TffSqlCaseExpression.GetValue: Variant;
var
i : Integer;
begin
if IsConstant then begin
Result := ConstantValue;
exit;
end;
for i := 0 to pred(WhenClauseList.WhenClauseCount) do
if WhenClauseList.WhenClause[i].WhenExp.AsBoolean then begin
if WhenClauseList.WhenClause[i].ThenExp <> nil then
Result := WhenClauseList.WhenClause[i].ThenExp.GetValue
else
Result := Null;
exit;
end;
if ElseExp <> nil then
Result := ElseExp.GetValue
else
Result := Null;
end;
{--------}
function TffSqlCaseExpression.IsConstant: Boolean;
begin
if not FIsConstantChecked then
CheckIsConstant;
Result := FIsConstant;
end;
{--------}
function TffSqlCaseExpression.Reduce: Boolean;
var
i : Integer;
begin
for i := 0 to pred(WhenClauseList.WhenClauseCount) do
if WhenClauseList.WhenClause[i].WhenExp.Reduce then begin
Result := True;
exit;
end else
if WhenClauseList.WhenClause[i].ThenExp <> nil then
if WhenClauseList.WhenClause[i].ThenExp.Reduce then begin
Result := True;
exit;
end;
if ElseExp <> nil then
Result := ElseExp.Reduce
else
Result := False;
end;
procedure TffSqlCaseExpression.ResetConstant;
begin
FIsConstantChecked := False;
FIsConstant := False;
end;
{====================================================================}
{===TffSqlMatchClause================================================}
function TffSqlMatchClause.AsBoolean(const TestValue: Variant): Boolean;
begin
Result := SubQuery.Match(TestValue, Unique, Option)
end;
{--------}
procedure TffSqlMatchClause.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlMatchClause then begin
Unique := TffSqlMatchClause(Source).Unique;
Option := TffSqlMatchClause(Source).Option;
SubQuery.Free;
SubQuery := TffSqlSELECT.Create(Self);
SubQuery.Assign(TffSqlMatchClause(Source).SubQuery);
end else
AssignError(Source);
end;
function TffSqlMatchClause.DependsOn(Table: TFFSqlTableProxy): Boolean;
begin
Result := SubQuery.DependsOn(Table);
end;
destructor TffSqlMatchClause.Destroy;
begin
SubQuery.Free;
inherited;
end;
{--------}
procedure TffSqlMatchClause.EmitSQL(Stream: TStream);
begin
WriteStr(Stream, ' MATCH');
if Unique then
WriteStr(Stream,' UNIQUE');
case Option of
moPartial :
WriteStr(Stream,' PARTIAL');
moFull :
WriteStr(Stream,' FULL');
end;
WriteStr(Stream,'(');
SubQuery.EmitSQL(Stream);
WriteStr(Stream,')');
end;
{--------}
procedure TffSqlMatchClause.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
begin
EnumMethod(Self);
SubQuery.EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlMatchClause.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlMatchClause)
and (Unique = TffSqlMatchClause(Other).Unique)
and (Option = TffSqlMatchClause(Other).Option)
and (SubQuery.Equals(TffSqlMatchClause(Other).SubQuery));
end;
{--------}
procedure TffSqlMatchClause.MatchType(ExpectedType: TffFieldType);
begin
SubQuery.MatchType(ExpectedType, False);
end;
function TffSqlMatchClause.Reduce: Boolean;
begin
Result := SubQuery.Reduce;
end;
{====================================================================}
{ TffSqlCoalesceExpression }
function TffSqlCoalesceExpression.AddArg(Value: TffSqlSimpleExpression): TffSqlSimpleExpression;
begin
ArgList.Add(Value);
Result := Value;
end;
{--------}
procedure TffSqlCoalesceExpression.Assign(const Source: TffSqlNode);
var
i : Integer;
begin
if Source is TffSqlCoalesceExpression then begin
Clear;
for i := 0 to pred(TffSqlCoalesceExpression(Source).ArgCount) do
AddArg(TffSqlSimpleExpression.Create(Self)).Assign(
TffSqlCoalesceExpression(Source).Arg[i]);
end else
AssignError(Source);
end;
constructor TffSqlCoalesceExpression.Create(AParent: TffSqlNode);
begin
inherited Create(AParent);
ArgList := TList.Create;
end;
{--------}
procedure TffSqlCoalesceExpression.Clear;
var
i : Integer;
begin
for i := 0 to pred(ArgCount) do
Arg[i].Free;
ArgList.Clear;
end;
{--------}
destructor TffSqlCoalesceExpression.Destroy;
begin
Clear;
ArgList.Free;
inherited;
end;
{--------}
procedure TffSqlCoalesceExpression.EmitSQL(Stream: TStream);
var
i : Integer;
begin
WriteStr(Stream,' COALESCE(');
Arg[0].EmitSQL(Stream);
for i := 1 to pred(ArgCount) do begin
WriteStr(Stream,' ,');
Arg[i].EmitSQL(Stream);
end;
WriteStr(Stream,')');
end;
{--------}
procedure TffSqlCoalesceExpression.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
var
i : Integer;
begin
EnumMethod(Self);
for i := 0 to pred(ArgCount) do
Arg[i].EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlCoalesceExpression.Equals(Other: TffSqlNode): Boolean;
var
i : Integer;
begin
Result := False;
if Other is TffSqlCoalesceExpression then
if ArgCount = TffSqlCoalesceExpression(Other).ArgCount then begin
for i := 0 to pred(ArgCount) do
if not Arg[i].Equals(TffSqlCoalesceExpression(Other).Arg[i]) then
exit;
Result := True;
end;
end;
{--------}
function TffSqlCoalesceExpression.GetArg(
Index: Integer): TffSqlSimpleExpression;
begin
Result := TffSqlSimpleExpression(ArgList[Index]);
end;
{--------}
function TffSqlCoalesceExpression.GetArgCount: Integer;
begin
Result := ArgList.Count;
end;
{--------}
function TffSqlCoalesceExpression.GetValue: Variant;
var
i : Integer;
begin
Result := Null;
for i := 0 to pred(ArgCount) do begin
Result := Arg[i].GetValue;
if Result <> Null then
exit;
end;
end;
{--------}
function TffSqlCoalesceExpression.DependsOn(
Table: TFFSqlTableProxy): Boolean;
var
i : Integer;
begin
for i := 0 to pred(ArgCount) do
if Arg[i].DependsOn(Table) then begin
Result := True;
exit;
end;
Result := False;
end;
{--------}
function TffSqlCoalesceExpression.GetType: TffFieldType;
begin
Result := Arg[0].GetType;
end;
{--------}
function TffSqlCoalesceExpression.Reduce: Boolean;
var
i : Integer;
begin
for i := 0 to pred(ArgCount) do
if Arg[i].Reduce then begin
Result := True;
exit;
end;
Result := False;
end;
{====================================================================}
function TffSqlCoalesceExpression.GetSize: Integer;
var
i : Integer;
begin
Result := 0;
for i := 0 to pred(ArgCount) do
Result := FFMaxI(Result, Arg[i].GetSize);
end;
{ TFFSqlTableProxySubset }
procedure TFFSqlTableProxySubset.Assign(
const Source: TFFSqlTableProxySubset);
begin
FTable := Source.Table;
KeyRelation := Source.KeyRelation;
Outer := Source.Outer;
Opposite := Source.Opposite;
end;
constructor TFFSqlTableProxySubset.Create;
begin
FTable := Table;
end;
procedure TFFSqlTableProxySubset.Iterate(Iterator: TFFSqlTableIterator;
Cookie: TffWord32);
begin
FTable.Iterate(Iterator, Cookie);
end;
function TFFSqlTableProxySubset.UniqueValue: Boolean;
begin
Result :=
(KeyRelation.RelationFieldCount = KeyRelation.RelationKeyFieldCount)
and (KeyRelation.RelationOperators[KeyRelation.RelationKeyFieldCount - 1] = roEQ);
end;
function TFFSqlTableProxySubset.ClosedSegment: Boolean;
begin
Result := KeyRelation.RelationOperatorB[KeyRelation.RelationKeyFieldCount - 1] <> roNone; {!!.11}
end;
function TFFSqlTableProxySubset.KeyDepth: Integer;
begin
Result := KeyRelation.RelationFieldCount;
end;
function TFFSqlTableProxySubset.EqualKeyDepth: Integer;
begin
Result := 0;
while (Result < KeyRelation.RelationFieldCount)
and (KeyRelation.RelationOperators[Result] = roEQ) do
inc(Result);
end;
{ TFFSqlTableProxySubsetList }
function TFFSqlTableProxySubsetList.Add(
TableProxySubset: TFFSqlTableProxySubset): TFFSqlTableProxySubset;
begin
FList.Add(TableProxySubset);
Result := TableProxySubset;
end;
{!!.10 new}
function TFFSqlTableProxySubsetList.Insert(
TableProxySubset: TFFSqlTableProxySubset): TFFSqlTableProxySubset;
begin
FList.Insert(0, TableProxySubset);
Result := TableProxySubset;
end;
procedure TFFSqlTableProxySubsetList.Assign(
const Source: TFFSqlTableProxySubsetList);
var
i : Integer;
begin
Clear;
for i := 0 to pred(Source.Count) do
Add(TFFSqlTableProxySubset.Create(Source.Item[i].Table)).Assign(Source.Item[i]);
OuterJoin := Source.OuterJoin;
end;
constructor TFFSqlTableProxySubsetList.Create;
begin
Assert(AOwner <> nil);
FOwner := AOwner;
FList := TList.Create;
end;
procedure TFFSqlTableProxySubsetList.Delete(Index: Integer);
begin
FList.Delete(Index);
end;
procedure TFFSqlTableProxySubsetList.Clear;
var
i : Integer;
begin
for i := 0 to pred(FList.Count) do
Item[i].Free;
FList.Clear;
end;
destructor TFFSqlTableProxySubsetList.Destroy;
begin
Clear;
FList.Free;
inherited;
end;
function TFFSqlTableProxySubsetList.GetCount: Integer;
begin
Result := FList.Count;
end;
function TFFSqlTableProxySubsetList.GetItem(
Index: Integer): TFFSqlTableProxySubset;
begin
Result := TFFSqlTableProxySubset(FList[Index]);
end;
function TFFSqlTableProxySubsetList.RelationUsed(
Relation: TffSqlCondFactor): Boolean;
var
i : Integer;
begin
for i := 0 to pred(Count) do
if Item[i].KeyRelation.CondF = Relation then begin
Result := True;
exit;
end;
Result := False;
end;
function TFFSqlTableProxySubsetList.DependencyExists(
Table : TFFSqlTableProxy): Boolean;
var
i, j : Integer;
begin
for i := 0 to pred(Count) do
for j := 0 to Item[i].KeyRelation.RelationFieldCount - 1 do begin
if Item[i].KeyRelation.ArgExpressions[j].DependsOn(Table) then begin
Result := True;
exit;
end;
if (Item[i].KeyRelation.ArgExpressionB[j] <> nil) {!!.11}
and Item[i].KeyRelation.ArgExpressionB[j].DependsOn(Table) then begin {!!.11}
Result := True;
exit;
end;
end;
Result := False;
end;
function TFFSqlTableProxySubsetList.ProcessLevel(Cookie1: TffWord32): Boolean;
begin
inc(FRecordsRead);
inc(Owner.RecordsRead);
{ Time to check for timeout? }
if FRecordsRead mod 1000 = 0 then
FFCheckRemainingTime;
Result := True; {continue}
if Level = 0 then begin
if FCondTerm.AsBoolean then
if not SkipInner then
FCreateResultRecord;
if SkipInner then
{SkipInner means we're writing NULL records for outer join
records with no match, so we just need to know if there
were any here; we don't need to see the rest, so stop reading:}
Result := False;
WroteRow := True;
end else begin
if FCondTerm.AsBooleanLevel(Level) then begin
dec(Level);
ReadSources;
inc(Level);
end;
end;
end;
procedure TFFSqlTableProxySubsetList.ReadSources;
var
{V : array[0..pred(ffcl_MaxIndexFlds)] of Variant;
VB : array[0..pred(ffcl_MaxIndexFlds)] of Variant;} {!!.11}
i : Integer;
NullLimit,
BUsed : Boolean;
KeyHasIntervals: Boolean; {!!.11}
begin
with Item[Level] do begin
NullLimit := False;
if KeyRelation.CondF <> nil then begin
Table.SetIndex(KeyRelation.NativeKeyIndex - 1);
for i := 0 to KeyRelation.RelationFieldCount - 1 do begin
Assert(KeyRelation.ArgExpressions[i] is TffSqlSimpleExpression);
V[i] := TffSqlSimpleExpression(KeyRelation.ArgExpressions[i]).GetValue;
if VarIsNull(V[i]) then
NullLimit := True;
VB[i] := V[i];
end;
{!!.11 begin}
KeyHasIntervals := False;
for i := 0 to KeyRelation.RelationFieldCount - 2 do
if KeyRelation.RelationOperators[i] <> roEQ then begin
KeyHasIntervals := True;
break;
end;
{!!.11 end}
{!!.13}
{can't preevaluate open intervals on key alone because of possible null values}
for i := 0 to KeyRelation.RelationFieldCount - 1 do
case KeyRelation.RelationOperators[i] of
roL, roG : begin
KeyHasIntervals := True;
break;
end;
end;
{!!.13}
if not KeyHasIntervals and {!!.11}
not KeyRelation.RelationKeyIsCaseInsensitive then
KeyRelation.CondF.MarkTrue;
for i := 0 to KeyRelation.RelationFieldCount - 1 do {!!.11}
if KeyRelation.RelationOperatorB[i] <> roNone then begin {!!.11}
Assert(KeyRelation.ArgExpressionB[i] is TffSqlSimpleExpression); {!!.11}
VB[i{KeyRelation.RelationFieldCount - 1}] := {!!.11}
TffSqlSimpleExpression(KeyRelation.ArgExpressionB[i]).GetValue; {!!.11}
if VarIsNull(VB[i{KeyRelation.RelationFieldCount - 1}]) then {!!.11}
NullLimit := True;
end;
BUsed := False;
if not NullLimit then
case KeyRelation.RelationOperators[KeyRelation.RelationFieldCount - 1] of
roEQ :
Table.SetRange(V, VB, KeyRelation.RelationFieldCount, {!!.11}
KeyRelation.RelationFieldCount, True, True,
KeyRelation.RelationKeyIndexAsc);
roLE :
case KeyRelation.RelationOperatorB[KeyRelation.RelationFieldCount - 1] of {!!.11}
roG :
begin
Table.SetRange(VB, V, KeyRelation.RelationFieldCount,
KeyRelation.RelationFieldCount, False, True,
KeyRelation.RelationKeyIndexAsc);
BUsed := True;
end;
roGE :
begin
Table.SetRange(VB, V, KeyRelation.RelationFieldCount,
KeyRelation.RelationFieldCount, True, True,
KeyRelation.RelationKeyIndexAsc);
BUsed := True;
end;
else
Table.SetRange(V, V, KeyRelation.RelationFieldCount - 1,
KeyRelation.RelationFieldCount, True, True,
KeyRelation.RelationKeyIndexAsc);
end;
roL :
case KeyRelation.RelationOperatorB[KeyRelation.RelationFieldCount - 1] of {!!.11}
roG :
begin
Table.SetRange(VB, V, KeyRelation.RelationFieldCount,
KeyRelation.RelationFieldCount, False, False,
KeyRelation.RelationKeyIndexAsc);
BUsed := True;
end;
roGE :
begin
Table.SetRange(VB, V, KeyRelation.RelationFieldCount,
KeyRelation.RelationFieldCount, True, False,
KeyRelation.RelationKeyIndexAsc);
BUsed := True;
end;
else
Table.SetRange(V, V, KeyRelation.RelationFieldCount - 1,
KeyRelation.RelationFieldCount, True, False,
KeyRelation.RelationKeyIndexAsc);
end;
roG :
case KeyRelation.RelationOperatorB[KeyRelation.RelationFieldCount - 1] of {!!.11}
roLE :
begin
Table.SetRange(V, VB, KeyRelation.RelationFieldCount,
KeyRelation.RelationFieldCount, False, True,
KeyRelation.RelationKeyIndexAsc);
BUsed := True;
end;
roL :
begin
Table.SetRange(V, VB, KeyRelation.RelationFieldCount,
KeyRelation.RelationFieldCount, False, False,
KeyRelation.RelationKeyIndexAsc);
BUsed := True;
end;
else
Table.SetRange(V, V, KeyRelation.RelationFieldCount,
KeyRelation.RelationFieldCount - 1, False, True,
KeyRelation.RelationKeyIndexAsc);
end;
roGE :
case KeyRelation.RelationOperatorB[KeyRelation.RelationFieldCount - 1] of {!!.11}
roLE :
begin
Table.SetRange(V, VB, KeyRelation.RelationFieldCount,
KeyRelation.RelationFieldCount, True, True,
KeyRelation.RelationKeyIndexAsc);
BUsed := True;
end;
roL :
begin
Table.SetRange(V, VB, KeyRelation.RelationFieldCount,
KeyRelation.RelationFieldCount, True, False,
KeyRelation.RelationKeyIndexAsc);
BUsed := True;
end;
else
Table.SetRange(V, V, KeyRelation.RelationFieldCount,
KeyRelation.RelationFieldCount - 1, True, True,
KeyRelation.RelationKeyIndexAsc);
end;
else
Assert(False);
end;
if not KeyHasIntervals and {!!.11}
not KeyRelation.RelationKeyIsCaseInsensitive and BUsed then
KeyRelation.RelationB[KeyRelation.RelationFieldCount - 1].MarkTrue; {!!.11}
end else
Table.SetIndex(-1);
{if not NullLimit then begin} {!!.11}
WroteRow := False;
if not NullLimit then {!!.11}
Iterate(ProcessLevel, 0);
if OuterJoin and not WroteRow and (Level = 0) then begin
Item[0].Table.NullRecord;
FCreateResultRecord;
end;
{end;} {!!.11}
if KeyRelation.CondF <> nil then begin
KeyRelation.CondF.MarkUnknown;
if KeyRelation.RelationOperatorB[KeyRelation.RelationFieldCount - 1] <> roNone then {!!.11}
KeyRelation.RelationB[KeyRelation.RelationFieldCount - 1].MarkUnknown; {!!.11}
end;
end;
end;
procedure TFFSqlTableProxySubsetList.Join;
begin
FCondTerm := CondTerm;
CondTerm.SetLevelDep(Self);
FCreateResultRecord := CreateResultRecord;
Level := Count - 1;
ReadSources;
end;
{ TffSqlINSERT }
procedure TffSqlINSERT.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlINSERT then begin
Clear;
DefaultValues := TffSqlINSERT(Source).DefaultValues;
TableName := TffSqlINSERT(Source).TableName;
if TffSqlINSERT(Source).InsertColumnList <> nil then begin
InsertColumnList := TffSqlInsertColumnList.Create(Self);
InsertColumnList.Assign(TffSqlINSERT(Source).InsertColumnList);
end;
if TffSqlINSERT(Source).TableExp <> nil then begin
TableExp := TffSqlTableExp.Create(Self);
TableExp.Assign(TffSqlINSERT(Source).TableExp);
end;
end else
AssignError(Source);
end;
procedure TffSqlINSERT.AddColumns(Node: TffSqlNode);
begin
Node.AddColumnDef(Self);
end;
{--------}
procedure TffSqlINSERT.Bind;
var
i: Integer;
F: TFFSqlFieldProxy;
begin
if InsertColumnList <> nil then
InsertColumnList.EnumNodes(ClearBindings, False);
T := Owner.FDatabase.TableByName(Self, TableName, False, ''); {!!.11}
if T = nil then
SQLError('Unable to open table: ' + TableName +
'. Ensure the table exists and is not in use by ' +
'another process.');
{build column list}
Assert(Assigned(Columns));
Columns.Clear;
if InsertColumnList <> nil then
InsertColumnList.EnumNodes(AddColumns, False);
if Columns.Count = 0 then begin
for i := 0 to T.FieldCount - 1 do begin
F := T.Field(i);
if not F.CanUpdate then
SQLError('Changing fields of this type is not currently supported ' +
'through SQL:' + Columns[i]);
Columns.AddObject(T.Field(i).Name, F);
end;
end else begin
for i := 0 to Columns.Count - 1 do begin
F := T.FieldByName(Columns[i]);
if F = nil then
SQLError('Unknown field for table ' + TableName + 'in INSERT statement:' +
Columns[i]);
if not F.CanUpdate then
SQLError('Changing fields of this type is not currently supported through SQL:' +
Columns[i]);
Columns.Objects[i] := F;
end;
end;
Bound := True;
end;
{--------}
procedure TffSqlINSERT.Clear;
begin
TableName := '';
InsertColumnList.Free;
InsertColumnList := nil;
TableExp.Free;
TableExp := nil;
end;
{--------}
procedure TffSqlINSERT.ClearBindings(Node: TffSqlNode);
begin
Node.ClearBinding;
end;
{--------}
destructor TffSqlINSERT.Destroy;
begin
Clear;
if T <> nil then
if T.Owner = Self then begin
T.Owner := nil;
T.Free;
end;
inherited;
end;
{--------}
procedure TffSqlINSERT.EmitSQL(Stream: TStream);
begin
WriteStr(Stream, 'INSERT INTO ');
WriteStr(Stream, TableName);
WriteStr(Stream,' ');
if DefaultValues then
WriteStr(Stream,'DEFAULT VALUES ')
else begin
if assigned(InsertColumnList) then begin
WriteStr(Stream,'(');
InsertColumnList.EmitSQL(Stream);
WriteStr(Stream,') ');
end;
if assigned(TableExp) then
TableExp.EmitSQL(Stream);
end;
end;
{--------}
procedure TffSqlINSERT.EnumNodes(EnumMethod: TffSqlEnumMethod;
const Deep: Boolean);
begin
EnumMethod(Self);
if assigned(InsertColumnList) then
InsertColumnList.EnumNodes(EnumMethod,Deep);
if assigned(TableExp) then
TableExp.EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlINSERT.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlINSERT)
and (DefaultValues = TffSqlINSERT(Other).DefaultValues)
and (TableName = TffSqlINSERT(Other).TableName)
and (BothNil(InsertColumnList, TffSqlINSERT(Other).InsertColumnList)
or (BothNonNil(InsertColumnList, TffSqlINSERT(Other).InsertColumnList)
and InsertColumnList.Equals(TffSqlINSERT(Other).InsertColumnList))
)
and (BothNil(TableExp, TffSqlINSERT(Other).TableExp)
or (BothNonNil(TableExp, TffSqlINSERT(Other).TableExp)
and TableExp.Equals(TffSqlINSERT(Other).TableExp))
);
end;
{Begin !!.13}
{--------}
function CanInsert(const SrcType, TgtType : TffFieldType) : Boolean;
begin
{ According to our past rules, which are very lax, most every type is
compatible with all other types. New rules:
- BLOBs may not be inserted into non-BLOB fields
- strings may be inserted into BLOBs
- strings cannot be inserted into numerics or date time }
if SrcType <> TgtType then
case TgtType of
{ Numerics & datetime values may be inserted into numerics. }
fftByte..fftCurrency :
case SrcType of
fftByte..fftCurrency, fftStDate..fftDateTime :
Result := True;
else
Result := False;
end;
fftStDate..fftDateTime :
{ Numerics, datetime, and string values may be inserted into datetime
columns. If a date is to be inserted via a string, the string must
be preceded via the DATE keyword. }
case SrcType of
fftByte..fftCurrency,
fftStDate..fftDateTime :
Result := True;
else
Result := False;
end; { case }
fftChar,
fftWideChar,
fftShortString..fftWideString :
{ Everything except BLOBs may be inserted into a string. }
case SrcType of
fftBLOB..fftBLOBTypedBIN :
Result := False;
else
Result := True;
end; { case }
fftBLOB..fftBLOBTypedBIN :
{ Strings & other BLOBs may be inserted into BLOBs. }
case SrcType of
fftChar, fftWideChar,
fftShortString..fftWideString,
fftBLOB..fftBLOBTypedBIN :
Result := True;
else
Result := False;
end; { case }
else
Result := False;
end { case }
else
Result := True;
end;
{End !!.13}
{--------}
function TffSqlINSERT.Execute(var RowsAffected: Integer) : TffResult;
{Revised !!.13}
var
i : Integer;
ST : TffSQLTableProxy;
begin
Result := Owner.FDatabase.StartTransaction([T]);
if Result = DBIERR_NONE then
try
RowsAffected := 0;
if not Bound then
Bind;
{ Make sure the target table can be modified. }
Result := T.EnsureWritable;
if Result <> DBIERR_NONE then begin
Owner.FDatabase.AbortTransaction;
Exit;
end;
{ If inserting default values only then do so. }
if DefaultValues then begin
T.Insert;
T.SetDefaults;
Result := T.Post;
if Result = DBIERR_NONE then begin
Owner.FDatabase.Commit;
RowsAffected := 1;
end
else
Owner.FDatabase.AbortTransaction;
end
else if TableExp <> nil then begin
{ Values are coming from a valuelist or subquery. }
ST := TableExp.ResultTable;
{ Validate the number of source and target columns. }
if ST.FieldCount <> Columns.Count then
SQLError('The number of columns in the source clause must match ' +
'the number of columns in the INSERT statement.');
{ Do the field types match? }
for i := 0 to Pred(ST.FieldCount) do
if not CanInsert(ST.Field(i).GetType,
TffSqlFieldProxy(Columns.Objects[i]).GetType) then
SQLError(Format('The type for source column %d (column name ' +
'"%s") is incompatible with the type for ' +
'target column %d (column name "%s")',
[i, ST.Field(i).Name, i, Columns[i]]));
{ Roll through the source table, inserting its rows into the result
table. }
ST.First;
while not ST.EOF do begin
T.Insert;
T.SetDefaults;
for i := 0 to FFMinI(Pred(ST.FieldCount), Pred(Columns.Count)) do
TFFSqlFieldProxy(Columns.Objects[i]).SetValue(ST.Field(i).GetValue);
Result := T.PostNoDefaults;
if Result = DBIERR_NONE then
inc(RowsAffected)
else
break;
ST.Next;
end;
if Result = DBIERR_NONE Then
Owner.FDatabase.Commit
else begin
Owner.FDatabase.AbortTransaction;
RowsAffected := 0;
end;
end else
Assert(False, 'Unexpected INSERT scenario');
except
Owner.FDatabase.AbortTransaction;
RowsAffected := 0;
raise;
end
else if Result = DBIERR_LOCKED then
FFRaiseException(EffException, ffStrResServer, fferrLockRejected,
[ffcLockExclusive, '', T.Name])
else
FFRaiseException(EffException, ffStrResServer, Result, [T.Name]);
end;
{--------}
{!!.11 new}
function TffSqlINSERT.Reduce: Boolean;
begin
if TableExp <> nil then
if TableExp.Reduce then begin
Result := True;
exit;
end;
Result := False;
end;
{ TffSqlInsertItem }
procedure TffSqlInsertItem.AddColumnDef(Target: TffSqlColumnListOwner);
begin
Target.Columns.Add(ColumnName);
end;
procedure TffSqlInsertItem.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlInsertItem then begin
ColumnName := TffSqlInsertItem(Source).ColumnName;
end else
AssignError(Source);
end;
procedure TffSqlInsertItem.EmitSQL(Stream: TStream);
begin
WriteStr(Stream, ColumnName);
end;
procedure TffSqlInsertItem.EnumNodes(EnumMethod: TffSqlEnumMethod;
const Deep: Boolean);
begin
EnumMethod(Self);
end;
function TffSqlInsertItem.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlInsertItem)
and (ColumnName = TffSqlInsertItem(Other).ColumnName);
end;
{ TffSqlInsertColumnList }
function TffSqlInsertColumnList.AddItem(
NewInsertColumn: TffSqlInsertItem): TffSqlInsertItem;
begin
FInsertColumnItemList.Add(NewInsertColumn);
Result := NewInsertColumn;
end;
procedure TffSqlInsertColumnList.Assign(const Source: TffSqlNode);
var
i : Integer;
begin
if Source is TffSqlInsertColumnList then begin
Clear;
for i := 0 to pred(TffSqlInsertColumnList(Source).InsertColumnCount) do
AddItem(TffSqlInsertItem.Create(Self)).Assign(
TffSqlInsertColumnList(Source).InsertColumnItem[i]);
end else
AssignError(Source);
end;
procedure TffSqlInsertColumnList.Clear;
var
i : Integer;
begin
for i := 0 to pred(InsertColumnCount) do
InsertColumnItem[i].Free;
FInsertColumnItemList.Clear;
end;
constructor TffSqlInsertColumnList.Create(AParent: TffSqlNode);
begin
inherited;
FInsertColumnItemList := TList.Create;
end;
destructor TffSqlInsertColumnList.Destroy;
begin
Clear;
FInsertColumnItemList.Free;
inherited;
end;
procedure TffSqlInsertColumnList.EmitSQL(Stream: TStream);
var
i : Integer;
First: Boolean;
begin
First := True;
for i := 0 to pred(InsertColumnCount) do begin
if First then
First := False
else
WriteStr(Stream, ', ');
InsertColumnItem[i].EmitSQL(Stream);
end;
end;
procedure TffSqlInsertColumnList.EnumNodes(EnumMethod: TffSqlEnumMethod;
const Deep: Boolean);
var
i : Integer;
begin
EnumMethod(Self);
for i := 0 to pred(InsertColumnCount) do
InsertColumnItem[i].EnumNodes(EnumMethod, Deep);
end;
function TffSqlInsertColumnList.Equals(Other: TffSqlNode): Boolean;
var
i : Integer;
begin
Result := False;
if Other is TffSqlInsertColumnList then begin
if InsertColumnCount <> TffSqlInsertColumnList(Other).InsertColumnCount then
exit;
for i := 0 to pred(InsertColumnCount) do
if not InsertColumnItem[i].Equals(TffSqlInsertColumnList(Other).InsertColumnItem[i]) then
exit;
Result := True;
end;
end;
function TffSqlInsertColumnList.GetInsertColumnCount: Integer;
begin
Result := FInsertColumnItemList.Count;
end;
function TffSqlInsertColumnList.GetInsertColumnItem(
Index: Integer): TffSqlInsertItem;
begin
Result := TffSqlInsertItem(FInsertColumnItemList[Index]);
end;
procedure TffSqlInsertColumnList.SetInsertColumnItem(Index: Integer;
const Value: TffSqlInsertItem);
begin
FInsertColumnItemList[Index] := Value;
end;
{ TffSqlValueItem }
procedure TffSqlValueItem.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlValueItem then begin
Simplex.Free;
{Simplex := nil;} {unnecessary}
Default := TffSqlUpdateItem(Source).Default;
Simplex := TffSqlSimpleExpression.Create(Self);
Simplex.Assign(TffSqlValueItem(Source).Simplex);
end else
AssignError(Source);
end;
destructor TffSqlValueItem.Destroy;
begin
Simplex.Free;
inherited;
end;
procedure TffSqlValueItem.EmitSQL(Stream: TStream);
begin
if Default then
WriteStr(Stream, 'DEFAULT ')
else if Simplex = nil then
WriteStr(Stream, 'NULL ')
else
Simplex.EmitSQL(Stream);
end;
procedure TffSqlValueItem.EnumNodes(EnumMethod: TffSqlEnumMethod;
const Deep: Boolean);
begin
EnumMethod(Self);
if assigned(Simplex) then
Simplex.EnumNodes(EnumMethod, Deep);
end;
function TffSqlValueItem.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlValueItem)
and (Default = TffSqlValueItem(Other).Default)
and (BothNil(Simplex, TffSqlValueItem(Other).Simplex)
or (BothNonNil(Simplex, TffSqlValueItem(Other).Simplex)
and Simplex.Equals(TffSqlValueItem(Other).Simplex)));
end;
function TffSqlValueItem.GetDecimals: Integer;
begin
if assigned(Simplex) then
Result := Simplex.GetDecimals
else
Result := 0;
end;
function TffSqlValueItem.GetSize: Integer;
begin
if assigned(Simplex) then
Result := Simplex.GetSize
else
Result := 1;
end;
function TffSqlValueItem.GetType: TffFieldType;
begin
if assigned(Simplex) then
Result := Simplex.GetType
else
Result := fftBoolean;
end;
{ TffSqlValueList }
function TffSqlValueList.AddItem(
NewValue: TffSqlValueItem): TffSqlValueItem;
begin
FValueItemList.Add(NewValue);
Result := NewValue;
end;
procedure TffSqlValueList.Assign(const Source: TffSqlNode);
var
i : Integer;
begin
if Source is TffSqlValueList then begin
Clear;
for i := 0 to pred(TffSqlValueList(Source).ValueCount) do
AddItem(TffSqlValueItem.Create(Self)).Assign(
TffSqlValueList(Source).ValueItem[i]);
end else
AssignError(Source);
end;
procedure TffSqlValueList.Clear;
var
i : Integer;
begin
for i := 0 to pred(ValueCount) do
ValueItem[i].Free;
FValueItemList.Clear;
end;
constructor TffSqlValueList.Create(AParent: TffSqlNode);
begin
inherited;
FValueItemList := TList.Create;
end;
destructor TffSqlValueList.Destroy;
begin
Clear;
FValueItemList.Free;
if FResultTable <> nil then begin
if FResultTable.Owner = Self then begin
FResultTable.Owner := nil;
FResultTable.Free;
end;
end;
inherited;
end;
procedure TffSqlValueList.EmitSQL(Stream: TStream);
var
i : Integer;
First: Boolean;
begin
First := True;
for i := 0 to pred(ValueCount) do begin
if First then
First := False
else
WriteStr(Stream, ', ');
ValueItem[i].EmitSQL(Stream);
end;
end;
procedure TffSqlValueList.EnumNodes(EnumMethod: TffSqlEnumMethod;
const Deep: Boolean);
var
i: Integer;
begin
EnumMethod(Self);
for i := 0 to pred(ValueCount) do
ValueItem[i].EnumNodes(EnumMethod, Deep);
end;
function TffSqlValueList.Equals(Other: TffSqlNode): Boolean;
var
i : Integer;
begin
Result := False;
if Other is TffSqlValueList then begin
if ValueCount <> TffSqlValueList(Other).ValueCount then
exit;
for i := 0 to pred(ValueCount) do
if not ValueItem[i].Equals(TffSqlValueList(Other).ValueItem[i]) then
exit;
Result := True;
end;
end;
procedure TffSqlValueList.Execute(
var aLiveResult: Boolean; var aCursorID: TffCursorID;
var RecordsRead: Integer);
begin
raise Exception.Create('Not yet implemented');
end;
function TffSqlValueList.GetResultTable: TFFSqlTableProxy;
var
FieldDefList : TffSqlFieldDefList;
i: Integer;
FldName : string; {!!.11}
Field : TffSqlFieldProxy; {!!.11}
begin
{Begin !!.13}
if FResultTable <> nil then
for i := 0 to pred(ValueCount) do
if (ValueItem[i].Simplex <> nil) and
not ValueItem[i].Simplex.IsConstant then begin
FResultTable.Owner := nil;
FResultTable.Free;
FResultTable := nil;
break;
end; { if }
{End !!.13}
if FResultTable = nil then begin
FieldDefList := TffSqlFieldDefList.Create;
try
{Begin !!.11}
for i := 0 to pred(ValueCount) do begin
FldName := 'Value_'+IntToStr(i+1);
Field := OwnerStmt.T.Field(i);
if ValueItem[i].Default then
FieldDefList.AddField(FldName, Field.GetType, Field.GetSize,
Field.GetDecimals)
else
FieldDefList.AddField(FldName, ValueItem[i].GetType,
ValueItem[i].GetSize, ValueItem[i].GetDecimals);
end; { for }
{End !!.11}
FResultTable := Owner.FDatabase.CreateTemporaryTableWithoutIndex(Self, FieldDefList); {!!.10}
finally
FieldDefList.Free;
end;
Owner.FDatabase.StartTransaction([nil]);
try
FResultTable.Insert;
for i := 0 to pred(ValueCount) do
if ValueItem[i].Simplex <> nil then
FResultTable.Field(i).SetValue(ValueItem[i].Simplex.GetValue)
{Begin !!.11}
else if ValueItem[i].Default then
FResultTable.Field(i).SetDefault
{End !!.11}
else
FResultTable.Field(i).SetFieldToNull;
FResultTable.Post;
except
Owner.FDatabase.AbortTransaction;
FResultTable.Owner := nil;
FResultTable.Free;
FResultTable := nil;
raise;
end;
Owner.FDatabase.Commit;
end;
Result := FResultTable;
end;
function TffSqlValueList.GetValueCount: Integer;
begin
Result := FValueItemList.Count;
end;
function TffSqlValueList.GetValueItem(Index: Integer): TffSqlValueItem;
begin
Result := TffSqlValueItem(FValueItemList[Index]);
end;
function TffSqlValueList.Reduce: Boolean;
begin
Result := False;
end;
procedure TffSqlValueList.SetValueItem(Index: Integer;
const Value: TffSqlValueItem);
begin
FValueItemList[Index] := Value;
end;
{ TffSqlDELETE }
procedure TffSqlDELETE.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlDELETE then begin
Clear;
if TffSqlDELETE(Source).TableRef <> nil then begin
TableRef := TffSqlTableRef.Create(Self);
TableRef.Assign(TffSqlDELETE(Source).TableRef);
end;
if TffSqlDELETE(Source).CondExpWhere <> nil then begin
CondExpWhere := TffSqlCondExp.Create(Self);
CondExpWhere.Assign(TffSqlDELETE(Source).CondExpWhere);
end;
end else
AssignError(Source);
end;
procedure TffSqlDELETE.Bind;
begin
Assert(TableRef <> nil);
T := TableRef.GetTable(Self, False); {!!.11}
if T = nil then
SQLError('Unable to open table: ' + TableRef.SQLName + //TableName +
'. Ensure the table exists and is not in use by ' +
'another process.');
if CondExpWhere <> nil then
CondExpWhere.MatchType(fftBoolean);
Bound := True;
end;
function TffSqlDELETE.BindField(const TableName,
FieldName: string): TFFSqlFieldProxy;
begin
Result := nil;
Assert(T <> nil);
Assert(T is TffSqlTableProxy);
if T.FieldByName(FieldName) <> nil then begin
Result := T.FieldByName(FieldName);
Exit;
end;
SQLError('Unknown field:' + FieldName);
end;
procedure TffSqlDELETE.Clear;
begin
TableRef.Free;
TableRef := nil;
CondExpWhere.Free;
CondExpWhere := nil;
end;
procedure TffSqlDELETE.DeleteRecord;
var
Pos: TffInt64;
begin
Pos := T.GetCurrentRecordID;
DeleteList.Add(Pointer(Pos.iLow));
DeleteList.Add(Pointer(Pos.iHigh));
end;
destructor TffSqlDELETE.Destroy;
begin
if T <> nil then
if T.Owner = Self then begin
T.Owner := nil;
T.Free;
end;
Clear;
Joiner.Free;
inherited;
end;
procedure TffSqlDELETE.EmitSQL(Stream: TStream);
begin
WriteStr(Stream,'DELETE FROM ');
TableRef.EmitSQL(Stream);
WriteStr(Stream,' ');
if assigned(CondExpWhere) then begin
WriteStr(Stream,'WHERE ');
CondExpWhere.EmitSQL(Stream);
end;
end;
procedure TffSqlDELETE.EnumNodes(EnumMethod: TffSqlEnumMethod;
const Deep: Boolean);
begin
EnumMethod(Self);
if assigned(TableRef) then
TableRef.EnumNodes(EnumMethod, Deep);
if assigned(CondExpWhere) then
CondExpWhere.EnumNodes(EnumMethod, Deep);
end;
function TffSqlDELETE.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlDELETE)
and (BothNil(TableRef, TffSqlDELETE(Other).TableRef)
or (BothNonNil(TableRef, TffSqlDELETE(Other).TableRef)
and TableRef.Equals(TffSqlDELETE(Other).TableRef)))
and (BothNil(CondExpWhere, TffSqlDELETE(Other).CondExpWhere)
or (BothNonNil(CondExpWhere, TffSqlDELETE(Other).CondExpWhere)
and CondExpWhere.Equals(TffSqlDELETE(Other).CondExpWhere)));
end;
function TffSqlDELETE.Execute(var RowsAffected: Integer) : TffResult; {!!.11}
var
i: Integer;
Pos: TffInt64;
begin
Result := Owner.FDatabase.StartTransaction([T]);
if Result = DBIERR_NONE then
try
if not Bound then
Bind;
{Begin !!.11}
Result := T.EnsureWritable;
if Result <> DBIERR_NONE then begin
Owner.FDatabase.AbortTransaction;
Exit;
end;
{End !!.11}
RowsAffected := 0;
if Joiner = nil then begin
Joiner := TffSqlJoiner.Create(Owner, CondExpWhere);
Joiner.Sources.Add(TFFSqlTableProxySubset.Create(T));
end;
Joiner.ClearColumnList;
Joiner.Target := nil;
DeleteList := TList.Create;
try
Joiner.Execute(Owner.UseIndex, DeleteRecord, jmNone);
T.SetIndex(-1); {switch to raw record id index} {!!.11}
i := 0;
while (Result = DBIERR_NONE) and {!!.11}
(i < DeleteList.Count) do begin {!!.11}
Pos.iLow := TffWord32(DeleteList[i]);
inc(i);
Assert(i < DeleteList.Count);
Pos.iHigh := TffWord32(DeleteList[i]);
inc(i);
T.GetRecordByID(Pos, ffsltExclusive); {!!.11}
Result := T.Delete; {!!.11}
if Result = DBIERR_NONE then {!!.11}
inc(RowsAffected); {!!.11}
end;
// RowsAffected := DeleteList.Count div 2; {Deleted !!.11}
finally
DeleteList.Free;
end;
{Begin !!.11}
if Result = DBIERR_NONE then
Owner.FDatabase.Commit
else
Owner.FDatabase.AbortTransaction;
{End !!.11}
except
Owner.FDatabase.AbortTransaction;
RowsAffected := 0;
raise;
end
else if Result = DBIERR_LOCKED then
FFRaiseException(EffException, ffStrResServer, fferrLockRejected,
[ffcLockExclusive, '', T.Name])
else
FFRaiseException(EffException, ffStrResServer, Result, [T.Name]);
end;
{--------}
{!!.11 new}
function TffSqlDELETE.Reduce: Boolean;
begin
if TableRef <> nil then
if TableRef.Reduce then begin
Result := True;
exit;
end;
if CondExpWhere <> nil then
if CondExpWhere.Reduce then begin
Result := True;
exit;
end;
Result := False;
end;
{ TffSqlUPDATE }
procedure TffSqlUPDATE.AddColumns(Node: TffSqlNode);
begin
Node.AddColumnDef(Self);
end;
procedure TffSqlUPDATE.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlUPDATE then begin
Clear;
if TffSqlUPDATE(Source).TableRef <> nil then begin
TableRef := TffSqlTableRef.Create(Self);
TableRef.Assign(TffSqlUPDATE(Source).TableRef);
end;
if TffSqlUPDATE(Source).UpdateList <> nil then begin
UpdateList := TffSqlUpdateList.Create(Self);
UpdateList.Assign(TffSqlUPDATE(Source).UpdateList);
end;
if TffSqlUPDATE(Source).CondExpWhere <> nil then begin
CondExpWhere := TffSqlCondExp.Create(Self);
CondExpWhere.Assign(TffSqlUPDATE(Source).CondExpWhere);
end;
end else
AssignError(Source);
end;
procedure TffSqlUPDATE.Bind;
var
i: Integer;
F: TFFSqlFieldProxy;
begin
Assert(UpdateList <> nil);
UpdateList.EnumNodes(ClearBindings, False);
T := TableRef.GetTable(Self, False); {!!.11}
if T = nil then
SQLError('Unable to open table: ' + TableRef.SQLName + //TableName +
'. Ensure the table exists and is not in use by ' +
'another process.');
{build column list}
Assert(Assigned(Columns));
Columns.Clear;
UpdateList.EnumNodes(AddColumns, False);
Assert(Columns.Count > 0);
for i := 0 to Columns.Count - 1 do begin
F := T.FieldByName(Columns[i]);
if F = nil then
SQLError('Unknown field for table ' + TableRef.SQLName + 'in UPDATE statement:' +
Columns[i]);
if not F.CanUpdate then
SQLError('Changing fields of this type is not currently supported through SQL:' +
Columns[i]);
TffSqlUpdateItem(Columns.Objects[i]).F := F;
with TffSqlUpdateItem(Columns.Objects[i]) do
if Simplex <> nil then
Simplex.MatchType(F.GetType);
end;
if CondExpWhere <> nil then
CondExpWhere.MatchType(fftBoolean);
Bound := True;
end;
function TffSqlUPDATE.BindField(const TableName,
FieldName: string): TFFSqlFieldProxy;
begin
Result := nil;
Assert(T <> nil);
Assert(T is TffSqlTableProxy);
if T.FieldByName(FieldName) <> nil then begin
Result := T.FieldByName(FieldName);
Exit;
end;
SQLError('Unknown field:' + FieldName);
end;
procedure TffSqlUPDATE.Clear;
begin
TableRef.Free;
TableRef := nil;
UpdateList.Free;
UpdateList := nil;
CondExpWhere.Free;
CondExpWhere := nil;
end;
procedure TffSqlUPDATE.ClearBindings(Node: TffSqlNode);
begin
Node.ClearBinding;
end;
destructor TffSqlUPDATE.Destroy;
begin
if T <> nil then
if T.Owner = Self then begin
T.Owner := nil;
T.Free;
end;
Clear;
Joiner.Free;
inherited;
end;
procedure TffSqlUPDATE.EmitSQL(Stream: TStream);
begin
WriteStr(Stream, 'UPDATE ');
TableRef.EmitSQL(Stream);
WriteStr(Stream,' SET ');
if assigned(UpdateList) then
UpdateList.EmitSQL(Stream);
if assigned(CondExpWhere) then
CondExpWhere.EmitSQL(Stream);
end;
procedure TffSqlUPDATE.EnumNodes(EnumMethod: TffSqlEnumMethod;
const Deep: Boolean);
begin
EnumMethod(Self);
if assigned(TableRef) then
TableRef.EnumNodes(EnumMethod, Deep);
if assigned(UpdateList) then
UpdateList.EnumNodes(EnumMethod, Deep);
if assigned(CondExpWhere) then
CondExpWhere.EnumNodes(EnumMethod, Deep);
end;
function TffSqlUPDATE.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlUPDATE)
and (BothNil(TableRef, TffSqlUPDATE(Other).TableRef)
or (BothNonNil(TableRef, TffSqlUPDATE(Other).TableRef)
and UpdateList.Equals(TffSqlUPDATE(Other).UpdateList)))
and (BothNil(UpdateList, TffSqlUPDATE(Other).UpdateList)
or (BothNonNil(UpdateList, TffSqlUPDATE(Other).UpdateList)
and UpdateList.Equals(TffSqlUPDATE(Other).UpdateList)))
and (BothNil(CondExpWhere, TffSqlUPDATE(Other).CondExpWhere)
or (BothNonNil(CondExpWhere, TffSqlUPDATE(Other).CondExpWhere)
and CondExpWhere.Equals(TffSqlUPDATE(Other).CondExpWhere)));
end;
function TffSqlUPDATE.Execute(var RowsAffected: Integer) : TffResult; {!!.11}
var
i: Integer;
Pos: TffInt64;
begin
Result := Owner.FDatabase.StartTransaction([T]);
if Result = DBIERR_NONE then
try
if not Bound then
Bind;
{Begin !!.11}
Result := T.EnsureWritable;
if Result <> DBIERR_NONE then begin
Owner.FDatabase.AbortTransaction;
Exit;
end;
{End !!.11}
FRowsAffected := 0;
if Joiner = nil then begin
Joiner := TffSqlJoiner.Create(Owner, CondExpWhere);
Joiner.Sources.Add(
TFFSqlTableProxySubset.Create(
TFFSqlTableProxy(T)));
end;
Joiner.ClearColumnList;
Joiner.Target := nil;
UpdateRecList := TList.Create;
try
Joiner.Execute(Owner.UseIndex, UpdateRecord, jmNone);
T.SetIndex(-1); {switch to raw record id index} {!!.11}
i := 0;
while (Result = DBIERR_NONE) and {!!.11}
(i < UpdateRecList.Count) do begin {!!.11}
Pos.iLow := TffWord32(UpdateRecList[i]);
inc(i);
Assert(i < UpdateRecList.Count);
Pos.iHigh := TffWord32(UpdateRecList[i]);
inc(i);
T.GetRecordByID(Pos, ffsltExclusive); {!!.11}
Result := UpdateList.Update; {!!.11}
if Result = DBIERR_NONE then {!!.11}
inc(FRowsAffected);
end;
finally
UpdateRecList.Free;
end;
{Begin !!.11}
if Result = DBIERR_NONE then begin
Owner.FDatabase.Commit;
RowsAffected := FRowsAffected;
end
else
Owner.FDatabase.AbortTransaction;
{End !!.11}
except
Owner.FDatabase.AbortTransaction;
RowsAffected := 0;
raise;
end
else if Result = DBIERR_LOCKED then
FFRaiseException(EffException, ffStrResServer, fferrLockRejected,
[ffcLockExclusive, '', T.Name])
else
FFRaiseException(EffException, ffStrResServer, Result, [T.Name]);
end;
{--------}
{!!.11 new}
function TffSqlUPDATE.Reduce: Boolean;
begin
if TableRef <> nil then
if TableRef.Reduce then begin
Result := True;
exit;
end;
if CondExpWhere <> nil then
if CondExpWhere.Reduce then begin
Result := True;
exit;
end;
if UpdateList <> nil then
if UpdateList.Reduce then begin
Result := True;
exit;
end;
Result := False;
end;
procedure TffSqlUPDATE.UpdateRecord;
var
Pos: TffInt64;
begin
Pos := T.GetCurrentRecordID;
UpdateRecList.Add(Pointer(Pos.iLow));
UpdateRecList.Add(Pointer(Pos.iHigh));
end;
{ TffSqlUpdateItem }
procedure TffSqlUpdateItem.AddColumnDef(Target: TffSqlColumnListOwner);
begin
Target.Columns.AddObject(ColumnName, Self);
end;
procedure TffSqlUpdateItem.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlUpdateItem then begin
Simplex.Free;
Simplex := nil;
ColumnName := TffSqlUpdateItem(Source).ColumnName;
Default := TffSqlUpdateItem(Source).Default;
if TffSqlUpdateItem(Source).Simplex <> nil then begin
Simplex := TffSqlSimpleExpression.Create(Self);
Simplex.Assign(TffSqlUpdateItem(Source).Simplex);
end;
end else
AssignError(Source);
end;
destructor TffSqlUpdateItem.Destroy;
begin
Simplex.Free;
inherited;
end;
procedure TffSqlUpdateItem.EmitSQL(Stream: TStream);
begin
WriteStr(Stream, ColumnName);
WriteStr(Stream,' = ');
if Default then
WriteStr(Stream, 'DEFAULT ')
else
if Simplex = nil then
WriteStr(Stream, 'NULL ')
else
Simplex.EmitSQL(Stream);
end;
procedure TffSqlUpdateItem.EnumNodes(EnumMethod: TffSqlEnumMethod;
const Deep: Boolean);
begin
EnumMethod(Self);
if Simplex <> nil then
Simplex.EnumNodes(EnumMethod, Deep);
end;
function TffSqlUpdateItem.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
(Other is TffSqlUpdateItem)
and (ColumnName = TffSqlUpdateItem(Other).ColumnName)
and (Default = TffSqlUpdateItem(Other).Default)
and (BothNil(Simplex, TffSqlUpdateItem(Other).Simplex)
or (BothNonNil(Simplex, TffSqlUpdateItem(Other).Simplex)
and Simplex.Equals(TffSqlUpdateItem(Other).Simplex)));
end;
function TffSqlUpdateItem.Reduce: Boolean;
begin
Result := (Simplex <> nil) and Simplex.Reduce;
end;
procedure TffSqlUpdateItem.Update;
begin
Assert(F <> nil);
if Simplex <> nil then
F.SetValue(Simplex.GetValue)
else
F.SetFieldToNull;
end;
{ TffSqlUpdateList }
function TffSqlUpdateList.AddItem(
NewValue: TffSqlUpdateItem): TffSqlUpdateItem;
begin
FUpdateItemList.Add(NewValue);
Result := NewValue;
end;
procedure TffSqlUpdateList.Assign(const Source: TffSqlNode);
var
i : Integer;
begin
if Source is TffSqlValueList then begin
Clear;
for i := 0 to pred(TffSqlValueList(Source).ValueCount) do
AddItem(TffSqlUpdateItem.Create(Self)).Assign(
TffSqlValueList(Source).ValueItem[i]);
end else
AssignError(Source);
end;
procedure TffSqlUpdateList.Clear;
var
i : Integer;
begin
for i := 0 to pred(UpdateCount) do
UpdateItem[i].Free;
FUpdateItemList.Clear;
end;
constructor TffSqlUpdateList.Create(AParent: TffSqlNode);
begin
inherited;
FUpdateItemList := TList.Create;
end;
destructor TffSqlUpdateList.Destroy;
begin
Clear;
FUpdateItemList.Free;
inherited;
end;
procedure TffSqlUpdateList.EmitSQL(Stream: TStream);
var
i : Integer;
First: Boolean;
begin
First := True;
for i := 0 to pred(UpdateCount) do begin
if First then
First := False
else
WriteStr(Stream, ', ');
UpdateItem[i].EmitSQL(Stream);
end;
end;
procedure TffSqlUpdateList.EnumNodes(EnumMethod: TffSqlEnumMethod;
const Deep: Boolean);
var
i: Integer;
begin
EnumMethod(Self);
for i := 0 to pred(UpdateCount) do
UpdateItem[i].EnumNodes(EnumMethod, Deep);
end;
function TffSqlUpdateList.Equals(Other: TffSqlNode): Boolean;
var
i : Integer;
begin
Result := False;
if Other is TffSqlValueList then begin
if UpdateCount <> TffSqlUpdateList(Other).UpdateCount then
exit;
for i := 0 to pred(UpdateCount) do
if not UpdateItem[i].Equals(TffSqlUpdateList(Other).UpdateItem[i]) then
exit;
Result := True;
end;
end;
function TffSqlUpdateList.GetUpdateCount: Integer;
begin
Result := FUpdateItemList.Count;
end;
function TffSqlUpdateList.GetUpdateItem(Index: Integer): TffSqlUpdateItem;
begin
Result := TffSqlUpdateItem(FUpdateItemList[Index]);
end;
{!!.11 new}
function TffSqlUpdateList.Reduce: Boolean;
var
i: Integer;
begin
for i := 0 to UpdateCount - 1 do
if UpdateItem[i].Reduce then begin
Result := True;
exit;
end;
Result := False;
end;
function TffSqlUpdateList.Update : TffResult; {!!.11}
var
i: Integer;
begin
for i := 0 to UpdateCount - 1 do
UpdateItem[i].Update;
Assert(Parent <> nil);
Assert(TObject(Parent) is TffSqlUpdate);
Result := TffSqlUpdate(Parent).T.Update; {!!.11}
end;
{ TffSqlColumnListOwner }
constructor TffSqlColumnListOwner.Create(AParent: TffSqlNode);
begin
inherited;
Columns := TStringList.Create;
end;
destructor TffSqlColumnListOwner.Destroy;
begin
Columns.Free;
inherited;
end;
{ TffSqlNonJoinTablePrimary }
procedure TffSqlNonJoinTablePrimary.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlNonJoinTablePrimary then begin
Clear;
if TffSqlNonJoinTablePrimary(Source).SelectSt <> nil then begin
SelectSt := TFFSqlSELECT.Create(Self);
SelectSt.Assign(TffSqlNonJoinTablePrimary(Source).SelectSt);
end;
if TffSqlNonJoinTablePrimary(Source).ValueList <> nil then begin
ValueList := TffSqlValueList.Create(Self);
ValueList.Assign(TffSqlNonJoinTablePrimary(Source).ValueList);
end;
if TffSqlNonJoinTablePrimary(Source).NonJoinTableExp <> nil then begin
NonJoinTableExp := TffSqlNonJoinTableExp.Create(Self);
NonJoinTableExp.Assign(TffSqlNonJoinTablePrimary(Source).NonJoinTableExp);
end;
if TffSqlNonJoinTablePrimary(Source).TableRef <> nil then begin
TableRef := TffSqlTableRef.Create(Self);
TableRef.Assign(TffSqlNonJoinTablePrimary(Source).TableRef);
end;
end else
AssignError(Source);
end;
function TffSqlNonJoinTablePrimary.BindFieldDown(const TableName,
FieldName: string): TFFSqlFieldProxy;
begin
if SelectSt <> nil then
Result := SelectSt.BindField(TableName, FieldName)
else
if NonJoinTableExp <> nil then
Result := NonJoinTableExp.BindFieldDown(TableName, FieldName)
else
if TableRef <> nil then
Result := TableRef.BindFieldDown(TableName, FieldName)
else
Result := nil;
end;
function TffSqlNonJoinTablePrimary.BindTable(AOwner: TObject;
const TableName: string): TFFSqlTableProxy;
begin
if SelectSt <> nil then
Result := SelectSt.BindTable(AOwner, TableName)
else
if NonJoinTableExp <> nil then
Result := NonJoinTableExp.BindTable(AOwner, TableName)
else
if TableRef <> nil then
Result := TableRef.BindTable(AOwner, TableName)
else
Result := nil;
end;
procedure TffSqlNonJoinTablePrimary.Clear;
begin
SelectSt.Free;
SelectSt := nil;
ValueList.Free;
ValueList := nil;
NonJoinTableExp.Free;
NonJoinTableExp := nil;
TableRef.Free;
TableRef := nil;
end;
function TffSqlNonJoinTablePrimary.DependsOn(
Table: TFFSqlTableProxy): Boolean;
begin
if SelectSt <> nil then
Result := SelectSt.DependsOn(Table)
else
if NonJoinTableExp <> nil then
Result := NonJoinTableExp.DependsOn(Table)
else
if TableRef <> nil then
Result := TableRef.DependsOn(Table)
else
Result := False;
end;
destructor TffSqlNonJoinTablePrimary.Destroy;
begin
Clear;
inherited;
end;
procedure TffSqlNonJoinTablePrimary.EmitSQL(Stream: TStream);
begin
if SelectSt <> nil then
SelectSt.EmitSQL(Stream);
if ValueList <> nil then
ValueList.EmitSQL(Stream);
if NonJoinTableExp <> nil then begin
WriteStr(Stream,' (');
NonJoinTableExp.EmitSQL(Stream);
WriteStr(Stream,')');
end;
if TableRef <> nil then begin
WriteStr(Stream,' TABLE ');
TableRef.EmitSQL(Stream);
end;
end;
procedure TffSqlNonJoinTablePrimary.EnsureResultTable(NeedData: Boolean);
begin
if SelectSt <> nil then
SelectSt.EnsureResultTable(NeedData);
if NonJoinTableExp <> nil then
NonJoinTableExp.EnsureResultTable(NeedData);
end;
procedure TffSqlNonJoinTablePrimary.EnumNodes(EnumMethod: TffSqlEnumMethod;
const Deep: Boolean);
begin
EnumMethod(Self);
if SelectSt <> nil then
SelectSt.EnumNodes(EnumMethod, Deep);
if ValueList <> nil then
ValueList.EnumNodes(EnumMethod, Deep);
if NonJoinTableExp <> nil then
NonJoinTableExp.EnumNodes(EnumMethod, Deep);
if TableRef <> nil then
TableRef.EnumNodes(EnumMethod, Deep);
end;
function TffSqlNonJoinTablePrimary.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
Other is TffSqlNonJoinTablePrimary
and ((BothNil(SelectSt, TffSqlNonJoinTablePrimary(Other).SelectSt)
or (BothNonNil(SelectSt, TffSqlNonJoinTablePrimary(Other).SelectSt)
and SelectSt.Equals(TffSqlNonJoinTablePrimary(Other).SelectSt))))
and ((BothNil(ValueList, TffSqlNonJoinTablePrimary(Other).ValueList)
or (BothNonNil(ValueList, TffSqlNonJoinTablePrimary(Other).ValueList)
and ValueList.Equals(TffSqlNonJoinTablePrimary(Other).ValueList))))
and ((BothNil(NonJoinTableExp, TffSqlNonJoinTablePrimary(Other).NonJoinTableExp)
or (BothNonNil(NonJoinTableExp, TffSqlNonJoinTablePrimary(Other).NonJoinTableExp)
and NonJoinTableExp.Equals(TffSqlNonJoinTablePrimary(Other).NonJoinTableExp))))
and ((BothNil(TableRef, TffSqlNonJoinTablePrimary(Other).TableRef)
or (BothNonNil(TableRef, TffSqlNonJoinTablePrimary(Other).TableRef)
and TableRef.Equals(TffSqlNonJoinTablePrimary(Other).TableRef))));
end;
procedure TffSqlNonJoinTablePrimary.Execute(
var aLiveResult: Boolean; var aCursorID: TffCursorID;
var RecordsRead: Integer);
begin
if assigned(SelectSt) then
SelectSt.Execute(aLiveResult, aCursorID, RecordsRead)
else
if assigned(ValueList) then
ValueList.Execute(aLiveResult, aCursorID, RecordsRead)
else
if assigned(NonJoinTableExp) then
NonJoinTableExp.Execute(aLiveResult, aCursorID, RecordsRead)
else
if assigned(TableRef) then
TableRef.Execute(aLiveResult, aCursorID, RecordsRead)
else
Assert(False);
end;
function TffSqlNonJoinTablePrimary.GetResultTable: TffSqlTableProxy;
begin
Result := nil;
if assigned(SelectSt) then
Result := SelectSt.ResultTable
else
if assigned(ValueList) then
Result := ValueList.ResultTable
else
if assigned(NonJoinTableExp) then
Result := NonJoinTableExp.ResultTable
else
if assigned(TableRef) then
Result := TableRef.ResultTable
else
Assert(False);
end;
function TffSqlNonJoinTablePrimary.Reduce: Boolean;
begin
Result := False;
if assigned(SelectSt) then
Result := SelectSt.Reduce
else
if assigned(ValueList) then
Result := ValueList.Reduce
else
if assigned(NonJoinTableExp) then
Result := NonJoinTableExp.Reduce
else
if assigned(TableRef) then
Result := False //TableRef.Reduce
else
Assert(False);
end;
function TffSqlNonJoinTablePrimary.TargetFieldFromSourceField(
const F: TffSqlFieldProxy): TffSqlFieldProxy;
begin
Result := nil;
if assigned(SelectSt) then
Result := SelectSt.TargetFieldFromSourceField(F)
else
if assigned(ValueList) then
Result := nil
else
if assigned(NonJoinTableExp) then
Result := NonJoinTableExp.TargetFieldFromSourceField(F)
else
if assigned(TableRef) then
Result := TableRef.TargetFieldFromSourceField(F)
else
Assert(False);
end;
{ TffSqlTableExp }
procedure TffSqlTableExp.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlTableExp then begin
Clear;
if TffSqlTableExp(Source).NestedTableExp <> nil then begin
NestedTableExp := TffSqlTableExp.Create(Self);
NestedTableExp.Assign(TffSqlTableExp(Source).NestedTableExp);
end;
if TffSqlTableExp(Source).JoinTableExp <> nil then begin
JoinTableExp := TffSqlJoinTableExp.Create(Self);
JoinTableExp.Assign(TffSqlTableExp(Source).JoinTableExp);
end;
if TffSqlTableExp(Source).NonJoinTableExp <> nil then begin
NonJoinTableExp := TffSqlNonJoinTableExp.Create(Self);
NonJoinTableExp.Assign(TffSqlTableExp(Source).NonJoinTableExp);
end;
end else
AssignError(Source);
end;
procedure TffSqlTableExp.Clear;
begin
NestedTableExp.Free;
NestedTableExp := nil;
JoinTableExp.Free;
JoinTableExp := nil;
NonJoinTableExp.Free;
NonJoinTableExp := nil;
end;
destructor TffSqlTableExp.Destroy;
begin
Clear;
inherited;
end;
procedure TffSqlTableExp.EmitSQL(Stream: TStream);
begin
if assigned(NestedTableExp) then
NestedTableExp.EmitSQL(Stream);
if assigned(JoinTableExp) then
JoinTableExp.EmitSQL(Stream);
if assigned(NonJoinTableExp) then
NonJoinTableExp.EmitSQL(Stream);
end;
function TffSqlTableExp.BindFieldDown(const TableName,
FieldName: string): TFFSqlFieldProxy;
begin
if assigned(NestedTableExp) then
Result := NestedTableExp.BindFieldDown(TableName, FieldName)
else
if assigned(JoinTableExp) then
Result := JoinTableExp.BindFieldDown(TableName, FieldName)
else
if assigned(NonJoinTableExp) then
Result := NonJoinTableExp.BindFieldDown(TableName, FieldName)
else
Result := nil;
end;
function TffSqlTableExp.BindTable(AOwner: TObject;
const TableName: string): TFFSqlTableProxy;
begin
if assigned(NestedTableExp) then
Result := NestedTableExp.BindTable(AOwner, TableName)
else
if assigned(JoinTableExp) then
Result := JoinTableExp.BindTable(AOwner, TableName)
else
if assigned(NonJoinTableExp) then
Result := NonJoinTableExp.BindTable(AOwner, TableName)
else
Result := nil;
end;
function TffSqlTableExp.CheckNoDups: Boolean;
begin
EnsureResultTable(True);
Result := not ResultTable.HasDuplicates(True); {!!.13}
end;
function TffSqlTableExp.DependsOn(Table: TFFSqlTableProxy): Boolean;
begin
if assigned(NestedTableExp) then
Result := NestedTableExp.DependsOn(Table)
else
if assigned(JoinTableExp) then
Result := JoinTableExp.DependsOn(Table)
else
if assigned(NonJoinTableExp) then
Result := NonJoinTableExp.DependsOn(Table)
else
Result := False;
end;
procedure TffSqlTableExp.EnsureResultTable(NeedData: Boolean);
begin
if assigned(NestedTableExp) then
NestedTableExp.EnsureResultTable(NeedData);
if assigned(JoinTableExp) then
JoinTableExp.EnsureResultTable(NeedData);
if assigned(NonJoinTableExp) then
NonJoinTableExp.EnsureResultTable(NeedData);
end;
procedure TffSqlTableExp.EnumNodes(EnumMethod: TffSqlEnumMethod;
const Deep: Boolean);
begin
EnumMethod(Self);
if assigned(NestedTableExp) then
NestedTableExp.EnumNodes(EnumMethod, Deep);
if assigned(JoinTableExp) then
JoinTableExp.EnumNodes(EnumMethod, Deep);
if assigned(NonJoinTableExp) then
NonJoinTableExp.EnumNodes(EnumMethod, Deep);
end;
function TffSqlTableExp.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
Other is TffSqlTableExp
and ((BothNil(NestedTableExp, TffSqlTableExp(Other).NestedTableExp)
or (BothNonNil(NestedTableExp, TffSqlTableExp(Other).NestedTableExp)
and NestedTableExp.Equals(TffSqlTableExp(Other).NestedTableExp))))
and ((BothNil(JoinTableExp, TffSqlTableExp(Other).JoinTableExp)
or (BothNonNil(JoinTableExp, TffSqlTableExp(Other).JoinTableExp)
and JoinTableExp.Equals(TffSqlTableExp(Other).JoinTableExp))))
and ((BothNil(NonJoinTableExp, TffSqlTableExp(Other).NonJoinTableExp)
or (BothNonNil(NonJoinTableExp, TffSqlTableExp(Other).NonJoinTableExp)
and NonJoinTableExp.Equals(TffSqlTableExp(Other).NonJoinTableExp))));
end;
procedure TffSqlTableExp.Execute(
var aLiveResult: Boolean; var aCursorID: TffCursorID;
var RecordsRead: Integer);
begin
if assigned(NestedTableExp) then
NestedTableExp.Execute(aLiveResult, aCursorID, RecordsRead);
if assigned(JoinTableExp) then
JoinTableExp.Execute(aLiveResult, aCursorID, RecordsRead);
if assigned(NonJoinTableExp) then
NonJoinTableExp.Execute(aLiveResult, aCursorID, RecordsRead);
end;
{!!.11 new}
function TffSqlTableExp.GetFieldsFromTable(const TableName: string; List: TList):
TffSqlTableProxy;
{-returns fields from table that are ultimately coming from the table
specified in the TableName argument. NIL if not found.}
begin
Result := nil;
if assigned(NestedTableExp) then
Result := NestedTableExp.GetFieldsFromTable(TableName, List)
else
if assigned(JoinTableExp) then
Result := JoinTableExp.GetFieldsFromTable(TableName, List)
else
if assigned(NonJoinTableExp) then
Result := NonJoinTableExp.GetFieldsFromTable(TableName, List)
else
Assert(False);
end;
function TffSqlTableExp.GetResultTable: TFFSqlTableProxy;
begin
Result := nil;
if assigned(NestedTableExp) then
Result := NestedTableExp.ResultTable
else
if assigned(JoinTableExp) then
Result := JoinTableExp.ResultTable
else
if assigned(NonJoinTableExp) then
Result := NonJoinTableExp.ResultTable
else
Assert(False);
end;
function TffSqlTableExp.Reduce: Boolean;
begin
if assigned(NestedTableExp) then
Result := NestedTableExp.Reduce
else
if assigned(JoinTableExp) then
Result := JoinTableExp.Reduce
else
Result := False;
if assigned(NonJoinTableExp) then
Result := Result or NonJoinTableExp.Reduce;
end;
function TffSqlTableExp.TargetFieldFromSourceField(
const F: TffSqlFieldProxy): TffSqlFieldProxy;
begin
Result := nil;
if assigned(NestedTableExp) then
Result := NestedTableExp.TargetFieldFromSourceField(F)
else
if assigned(JoinTableExp) then
Result := JoinTableExp.TargetFieldFromSourceField(F)
else
if assigned(NonJoinTableExp) then
NonJoinTableExp.TargetFieldFromSourceField(F)
else
Assert(False);
end;
{ TffSqlJoinTableExp }
function TffSqlJoinTableExp.BuildSimpleFieldExpr(AOwner: TffSqlNode;
const ATableName, AFieldName: string; AField: TffSqlFieldProxy
): TffSqlSimpleExpression;
var
Term: TffSqlTerm;
Fact: TffSqlFactor;
FieldRef: TffSqlFieldRef;
begin
Result := TffSqlSimpleExpression.Create(AOwner);
Term := TffSqlTerm.Create(Result);
Fact := TffSqlFactor.Create(Term);
FieldRef := TffSqlFieldRef.Create(Fact);
FieldRef.TableName := ATableName;
FieldRef.FieldName := AFieldName;
FieldRef.FField := AField;
Fact.FieldRef := FieldRef;
Term.AddFactor(Fact);
Result.AddTerm(Term);
end;
procedure TffSqlJoinTableExp.ClearColumns;
var
i: Integer;
begin
if Columns = nil then exit;
for i := 0 to Columns.Count - 1 do
if TObject(Columns.Objects[i]) is TffSqlSimpleExpression then
TObject(Columns.Objects[i]).Free;
Columns.Clear;
end;
procedure TffSqlJoinTableExp.Bind;
var
i, j : Integer;
FL, FR: TffSqlFieldProxy;
lCondTerm: TffSqlCondTerm;
lCondFact: TffSqlCondFactor;
lCondPrim: TffSqlCondPrimary;
lSimp1, lSimp2, cSimp, cSimp1, cSimp2: TffSqlSimpleExpression;
cTerm: TffSqlTerm;
cFact: TffSqlFactor;
cScalar : TffSqlScalarFunc;
cCoalesce : TffSqlCoalesceExpression;
S: string; {!!.11}
OS: TffSqlSELECT;
CF, NewCF: TffSqlCondFactor;
CP: TffSqlCondPrimary;
const
UorN: array[Boolean] of string = ('UNION', 'NATURAL');
begin
if JoinType = jtUnion then
SQLError('UNION JOIN is not currently supported by FlashFiler SQL');
if Natural and (JoinType = jtUnion) then
SQLError('NATURAL and UNION cannot both be specified on a JOIN');
if Natural or (JoinType = jtUnion) then begin
if CondExp <> nil then
SQLError(UorN[Natural] + ' joins do not accept an ON clause');
if UsingList <> nil then
sQLError(UorN[Natural] + ' joins do not accept a USING clause');
end;
if not Natural and not (JoinType in [jtCross,jtUnion]) then begin
if (CondExp = nil) and (UsingList = nil) then
SQLError('The join must have either an ON or a USING clause');
end;
if CondExp <> nil then
CondExp.EnumNodes(ClearBindings, False);
Assert(assigned(TableRef1));
TL := TableRef1.BindTable(Self, TableRef1.TableName);
Assert(assigned(TL));
Assert(assigned(TableRef2));
TR := TableRef2.BindTable(Self, TableRef2.TableName);
Assert(assigned(TR));
{build column list}
Assert(Assigned(Columns));
ClearColumns;
if Natural then begin
UsingCondExp := TffSqlCondExp.Create(Self);
lCondTerm := TffSqlCondTerm.Create(UsingCondExp);
for i := 0 to TL.FieldCount - 1 do begin
FL := TL.Field(i);
FR := TR.FieldByName(FL.Name);
if FR <> nil then begin
{common field}
lCondFact := TffSqlCondFactor.Create(lCondTerm);
lCondPrim := TffSqlCondPrimary.Create(lCondFact);
lSimp1 := BuildSimpleFieldExpr(lCondPrim, TableRef1.SQLName,
FL.Name, FL);
lSimp2 := BuildSimpleFieldExpr(lCondPrim, TableRef2.SQLName,
FR.Name, FR);
case JoinType of
jtRightOuter :
Columns.AddObject(FL.Name, FR);
jtFullOuter :
begin
cSimp := TffSqlSimpleExpression.Create(Self);
cTerm := TffSqlTerm.Create(cSimp);
cFact := TffSqlFactor.Create(cTerm);
cScalar := TffSqlScalarFunc.Create(cFact);
cScalar.SQLFunction := sfCoalesce;
cCoalesce := TffSqlCoalesceExpression.Create(cScalar);
cSimp1 := BuildSimpleFieldExpr(cCoalesce, TableRef1.SQLName,
FL.Name, FL);
cSimp2 := BuildSimpleFieldExpr(cCoalesce, TableRef2.SQLName,
FR.Name, FR);
cCoalesce.AddArg(cSimp1);
cCoalesce.AddArg(cSimp2);
cScalar.CoalesceExp := cCoalesce;
cFact.ScalarFunc := cScalar;
cTerm.AddFactor(cFact);
cSimp.AddTerm(cTerm);
Columns.AddObject(FL.Name, cSimp);
end;
else
Columns.AddObject(FL.Name, FL);
end;
lCondPrim.SimpleExp1 := lSimp1;
lCondPrim.SimpleExp2 := lSimp2;
lCondPrim.RelOp := roEQ;
lCondFact.CondPrimary := lCondPrim;
lCondTerm.AddCondFactor(lCondFact);
end;
end;
if lCondTerm.CondFactorCount = 0 then begin
lCondTerm.Free;
UsingCondExp.Free;
UsingCondExp := nil;
end else begin
UsingCondExp.AddCondTerm(lCondTerm);
UsingCondExp.MatchType(fftBoolean);
end;
for i := 0 to TL.FieldCount - 1 do begin
FL := TL.Field(i);
if Columns.IndexOf(FL.Name) = -1 then
Columns.AddObject(FL.Name, FL);
end;
for i := 0 to TR.FieldCount - 1 do begin
FR := TR.Field(i);
if Columns.IndexOf(FR.Name) = -1 then
Columns.AddObject(FR.Name, FR);
end;
end else
if UsingList <> nil then begin
UsingCondExp := TffSqlCondExp.Create(Self);
lCondTerm := TffSqlCondTerm.Create(UsingCondExp);
for i := 0 to UsingList.UsingCount - 1 do begin
lCondFact := TffSqlCondFactor.Create(lCondTerm);
lCondPrim := TffSqlCondPrimary.Create(lCondFact);
FL := TL.FieldByName(UsingList.UsingItem[i].ColumnName);
if FL = nil then
SQLError(format('Field %s does not exist in table %s.',
[UsingList.UsingItem[i].ColumnName, TableRef1.SQLName]));
FR := TR.FieldByName(UsingList.UsingItem[i].ColumnName);
if FR = nil then
SQLError(format('Field %s does not exist in table %s.',
[UsingList.UsingItem[i].ColumnName, TableRef2.SQLName]));
lSimp1 := BuildSimpleFieldExpr(lCondPrim, TableRef1.SQLName,
FL.Name, FL);
lSimp2 := BuildSimpleFieldExpr(lCondPrim, TableRef2.SQLName,
FR.Name, FR);
case JoinType of
jtRightOuter :
Columns.AddObject(FL.Name, FR);
jtFullOuter :
begin
cSimp := TffSqlSimpleExpression.Create(Self);
cTerm := TffSqlTerm.Create(cSimp);
cFact := TffSqlFactor.Create(cTerm);
cScalar := TffSqlScalarFunc.Create(cFact);
cScalar.SQLFunction := sfCoalesce;
cCoalesce := TffSqlCoalesceExpression.Create(cScalar);
cSimp1 := BuildSimpleFieldExpr(cCoalesce, TableRef1.SQLName,
FL.Name, FL);
cSimp2 := BuildSimpleFieldExpr(cCoalesce, TableRef2.SQLName,
FR.Name, FR);
cCoalesce.AddArg(cSimp1);
cCoalesce.AddArg(cSimp2);
cScalar.CoalesceExp := cCoalesce;
cFact.ScalarFunc := cScalar;
cTerm.AddFactor(cFact);
cSimp.AddTerm(cTerm);
Columns.AddObject(FL.Name, cSimp);
end;
else
Columns.AddObject(FL.Name, FL);
end;
lCondPrim.SimpleExp1 := lSimp1;
lCondPrim.SimpleExp2 := lSimp2;
lCondPrim.RelOp := roEQ;
lCondFact.CondPrimary := lCondPrim;
lCondTerm.AddCondFactor(lCondFact);
end;
UsingCondExp.AddCondTerm(lCondTerm);
(*
{!!.11 begin}
{if this join is enclosed in a SELECT with a WHERE clause,
and if the WHERE clause consists only of a single conditional term,
and if any of the conditional factors limit either side of the join,
then copy those conditional factors into the join condition}
//writeln(SqlText);
//writeln(' ',CondExp.SqlText);
OS := OwnerSelect;
if (OS <> nil)
and (OS.CondExpWhere <> nil)
and (OS.CondExpWhere.CondTermCount = 1) then begin
for i := 0 to OS.CondExpWhere.CondTerm[0].CondFactorCount - 1 do begin
CF := OS.CondExpWhere.CondTerm[0].CondFactor[i];
//writeln(' ',CF.SqlText);
if not CF.IsConstant
and not CF.UnaryNot then begin
CP := CF.CondPrimary;
if CP.RelOp in [roEQ, roLE, roL, roG, roGE] then begin
if CP.SimpleExp2.IsConstant or CP.SimpleExp2.IsParameter then begin
if Cp.SimpleExp1.TermCount = 1 then
if Cp.SimpleExp1.Term[0].FactorCount = 1 then
if Cp.SimpleExp1.Term[0].Factor[0].FieldRef <> nil then
if (Cp.SimpleExp1.Term[0].Factor[0].FieldRef.TableName
= TableRef1.TableName)
or (Cp.SimpleExp1.Term[0].Factor[0].FieldRef.TableName
= TableRef1.Alias) then begin
//writeln(' found left constraint:', CP.SqlText);
NewCF := TffSqlCondFactor.Create(lCondTerm);
NewCF.Assign(CF);
lCondTerm.AddCondFactor(NewCF);
//writeln(' ',CondExp.SqlText);
end
else
if Cp.SimpleExp1.Term[0].Factor[0].FieldRef <> nil then
if (Cp.SimpleExp1.Term[0].Factor[0].FieldRef.TableName
= TableRef2.TableName)
or (Cp.SimpleExp1.Term[0].Factor[0].FieldRef.TableName
= TableRef2.Alias) then begin
//writeln(' found right constraint', CP.SqlText);
NewCF := TffSqlCondFactor.Create(lCondTerm);
NewCF.Assign(CF);
lCondTerm.AddCondFactor(NewCF);
//writeln(' ',CondExp.SqlText);
end;
end;
end;
end;
end;
end;
{!!.11 end}
*)
UsingCondExp.MatchType(fftBoolean);
for i := 0 to TL.FieldCount - 1 do begin
FL := TL.Field(i);
if Columns.IndexOf(FL.Name) = -1 then
Columns.AddObject(FL.Name, FL);
end;
for i := 0 to TR.FieldCount - 1 do begin
FL := TR.Field(i);
j := Columns.IndexOf(FL.Name);
if j = -1 then
Columns.AddObject(FL.Name, FL)
else
if j >= UsingList.UsingCount then
Columns.AddObject(TR.Name + '.' + FL.Name, FL);
end;
end else begin
for i := 0 to TL.FieldCount - 1 do
Columns.AddObject(TL.Field(i).Name, TL.Field(i));
for i := 0 to TR.FieldCount - 1 do
if Columns.IndexOf(TR.Field(i).Name) = -1 then
Columns.AddObject(TR.Field(i).Name, TR.Field(i))
{!!.11 begin}
else begin
S := TR.Name + '.' + TR.Field(i).Name;
if Columns.IndexOf(S) = -1 then
Columns.AddObject(S, TR.Field(i))
else begin
j := 2;
while Columns.IndexOf(S + '_' + IntToStr(j)) <> -1 do
inc(j);
Columns.AddObject(S+ '_' + IntToStr(j), TR.Field(i));
end;
end;
{!!.11 end}
end;
if (CondExp <> nil) then begin
{!!.11 begin}
if (CondExp.CondTermCount = 1) then begin
{if this join is enclosed in a SELECT with a WHERE clause,
and if the WHERE clause consists only of a single conditional term,
and if any of the conditional factors limit either side of the join,
then copy those conditional factors into the join condition}
//writeln(SqlText);
//writeln(' ',CondExp.SqlText);
OS := OwnerSelect;
if (OS <> nil)
and (OS.CondExpWhere <> nil)
and (OS.CondExpWhere.CondTermCount = 1) then begin
for i := 0 to OS.CondExpWhere.CondTerm[0].CondFactorCount - 1 do begin
CF := OS.CondExpWhere.CondTerm[0].CondFactor[i];
//writeln(' ',CF.SqlText);
if not CF.IsConstant
and not CF.UnaryNot then begin
CP := CF.CondPrimary;
if CP.RelOp in [roEQ, roLE, roL, roG, roGE, roNE] then begin
if CP.SimpleExp2.IsConstant or CP.SimpleExp2.IsParameter then begin
if Cp.SimpleExp1.TermCount = 1 then
if Cp.SimpleExp1.Term[0].FactorCount = 1 then
if Cp.SimpleExp1.Term[0].Factor[0].FieldRef <> nil then
if (Cp.SimpleExp1.Term[0].Factor[0].FieldRef.TableName <> '') {!!.13}
and ( {!!.13}
(Cp.SimpleExp1.Term[0].Factor[0].FieldRef.TableName
= TableRef1.TableName)
or (Cp.SimpleExp1.Term[0].Factor[0].FieldRef.TableName
= TableRef1.Alias)) then begin {!!.13}
//writeln(' found left constraint:', CP.SqlText);
NewCF := TffSqlCondFactor.Create(CondExp.CondTerm[0]);
NewCF.Assign(CF);
CondExp.CondTerm[0].AddCondFactor(NewCF);
//writeln(' ',CondExp.SqlText);
end
else
if Cp.SimpleExp1.Term[0].Factor[0].FieldRef <> nil then
if (Cp.SimpleExp1.Term[0].Factor[0].FieldRef.TableName <> '') {!!.13}
and ( {!!.13}
((Cp.SimpleExp1.Term[0].Factor[0].FieldRef.TableName
= TableRef2.TableName)
or (Cp.SimpleExp1.Term[0].Factor[0].FieldRef.TableName
= TableRef2.Alias))) then begin {!!.13}
//writeln(' found right constraint', CP.SqlText);
NewCF := TffSqlCondFactor.Create(CondExp.CondTerm[0]);
NewCF.Assign(CF);
CondExp.CondTerm[0].AddCondFactor(NewCF);
//writeln(' ',CondExp.SqlText);
end;
end;
end;
end;
end;
end;
end;
{!!.11 end}
CondExp.MatchType(fftBoolean);
end;
Bound := True;
end;
function TffSqlJoinTableExp.BindTable(AOwner: TObject;
const TableName: string): TFFSqlTableProxy;
begin
Result := TableRef1.BindTable(AOwner, TableName);
if Result = nil then
Result := TableRef2.BindTable(AOwner, TableName);
end;
function TffSqlJoinTableExp.BindField(const TableName,
FieldName: string): TFFSqlFieldProxy;
var
T: TFFSqlTableProxy;
begin
Result := nil;
if TableName <> '' then begin
T := TableRef1.BindTable(Self, TableName);
if T <> nil then
if T <> TL then begin
Result := TableRef1.TargetFieldFromSourceField(T.FieldByName(FieldName));
exit;
end;
if T = nil then begin
T := TableRef2.BindTable(Self, TableName);
if T <> nil then {!!.11}
if T <> TR then begin
Result := TableRef2.TargetFieldFromSourceField(T.FieldByName(FieldName));
exit;
end;
end;
if T = nil then
SQLError('Unknown field:' + TableName + '.' + FieldName);
Assert(T <> nil);
Result := T.FieldByName(FieldName);
if Result = nil then
SQLError('Unknown field:' + TableName + '.' + FieldName);
end else begin
if TL.FieldByName(FieldName) <> nil then begin
Result := TL.FieldByName(FieldName);
Exit;
end;
if TR.FieldByName(FieldName) <> nil then begin
Result := TR.FieldByName(FieldName);
Exit;
end;
SQLError('Unknown field:' + FieldName);
end;
end;
function TffSqlJoinTableExp.BindFieldDown(const TableName,
FieldName: string): TFFSqlFieldProxy;
var
i: Integer;
begin
Result := nil;
if TableName <> '' then begin
Result := TableRef1.BindFieldDown(TableName, FieldName);
if Result = nil then
Result := TableRef2.BindFieldDown(TableName, FieldName);
if Result = nil then
exit;
EnsureResultTable(False{True});
for i := 0 to pred(Columns.Count) do
if Columns.Objects[i] = Result then begin
Result := FResultTable.Field(i);
exit;
end;
Result := nil;
end else begin
if TL.FieldByName(FieldName) <> nil then begin
Result := TL.FieldByName(FieldName);
Exit;
end;
if TR.FieldByName(FieldName) <> nil then begin
Result := TR.FieldByName(FieldName);
Exit;
end;
SQLError('Unknown field:' + FieldName);
end;
end;
procedure TffSqlJoinTableExp.ClearBindings(Node: TffSqlNode);
begin
Node.ClearBinding;
end;
function TffSqlJoinTableExp.DependsOn(Table: TFFSqlTableProxy): Boolean;
begin
if not Bound then
Bind;
Result :=
((UsingCondExp <> nil) and UsingCondExp.DependsOn(Table))
or ((CondExp <> nil) and CondExp.DependsOn(Table));
end;
function TffSqlJoinTableExp.DoJoin(NeedData: Boolean): TffSqlTableProxy;
var
i : Integer;
T2 : TffSqlTableProxy;
F : TffSqlFieldProxy;
N : TffSqlNode;
FieldDefList: TffSqlFieldDefList;
OuterJoinMode: TffSqlOuterJoinMode;
begin
{build a normal answer table}
{build field definition for answer table}
FieldDefList := TffSqlFieldDefList.Create;
try
Assert(Assigned(Columns));
for i := 0 to pred(Columns.Count) do begin
if Columns.Objects[i] is TffSqlFieldProxy then begin
F := TffSqlFieldProxy(Columns.Objects[i]);
FieldDefList.AddField(Columns[i], F.GetType, F.GetSize, F.GetDecimals);
end else begin
N := TffSqlNode(Columns.Objects[i]);
FieldDefList.AddField(Columns[i], N.GetType, N.GetSize, N.GetDecimals);
end;
end;
Result := Owner.FDatabase.CreateTemporaryTableWithoutIndex(Self, FieldDefList);
finally
FieldDefList.Free;
end;
try
if Joiner = nil then begin
if UsingCondExp <> nil then
Joiner := TffSqlJoiner.Create(Owner, UsingCondExp)
else
Joiner := TffSqlJoiner.Create(Owner, CondExp);
Joiner.Sources.Add(
TFFSqlTableProxySubset.Create(TL));
Joiner.Sources.Add(
TFFSqlTableProxySubset.Create(TR));
end;
Joiner.ClearColumnList;
Assert(Assigned(Columns));
for i := 0 to pred(Columns.Count) do
if Columns.Objects[i] is TffSqlFieldProxy then
Joiner.AddColumn(
nil,
TffSqlFieldProxy(Columns.Objects[i]),
Result.Field(i))
else
Joiner.AddColumn(
TffSqlSimpleExpression(Columns.Objects[i]),
nil,
Result.Field(i));
if NeedData then begin
Joiner.Target := Result;
Owner.FDatabase.StartTransaction([nil]);
try
case JoinType of
jtLeftOuter :
OuterJoinMode := jmLeft;
jtRightOuter :
OuterJoinMode := jmRight;
jtFullOuter :
OuterJoinMode := jmFull;
else
OuterJoinMode := jmNone;
end;
Joiner.Execute(Owner.UseIndex, nil, OuterJoinMode);
except
Owner.FDatabase.AbortTransaction;
raise;
end;
Owner.FDatabase.Commit;
end;
for i := 0 to Result.FieldCount - 1 do
Result.Field(i).IsTarget := False;
if (Parent is TffSqlInClause) or (Parent is TffSqlMatchClause) then begin
{need an index to allow the IN and MATCH clauses to be evaluated}
T2 := Result.CopySortedOnAllFields(Self);
Result.Owner := nil;
Result.Free;
Result := T2;
end;
except
Result.Owner := nil;
Result.Free;
raise;
end;
end;
procedure TffSqlJoinTableExp.EnsureResultTable(NeedData: Boolean);
begin
if (NeedData and not HaveData) then begin
FResultTable.Free;
FResultTable := nil;
end;
if FResultTable = nil then begin
FResultTable := Execute2(NeedData);
HaveData := NeedData;
end;
end;
function TffSqlJoinTableExp.Execute2(NeedData: Boolean): TffSqlTableProxy;
begin
{check that all referenced tables and fields exist}
if not Bound then
Bind;
{create the result}
Result := DoJoin(NeedData);
end;
function TffSqlJoinTableExp.GetResultTable: TffSqlTableProxy;
begin
EnsureResultTable(True);
Result := FResultTable;
end;
procedure TffSqlJoinTableExp.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlJoinTableExp then begin
Clear;
JoinType := TffSqlJoinTableExp(Source).JoinType;
Natural := TffSqlJoinTableExp(Source).Natural;
if TffSqlJoinTableExp(Source).TableRef1 <> nil then begin
TableRef1 := TffSqlTableRef.Create(Self);
TableRef1.Assign(TffSqlJoinTableExp(Source).TableRef1);
end;
if TffSqlJoinTableExp(Source).TableRef2 <> nil then begin
TableRef2 := TffSqlTableRef.Create(Self);
TableRef2.Assign(TffSqlJoinTableExp(Source).TableRef2);
end;
if TffSqlJoinTableExp(Source).CondExp <> nil then begin
CondExp := TFFSqlCondExp.Create(Self);
CondExp.Assign(TffSqlJoinTableExp(Source).CondExp);
end;
if TffSqlJoinTableExp(Source).UsingList <> nil then begin
UsingList := TFFSqlUsingList.Create(Self);
UsingList.Assign(TffSqlJoinTableExp(Source).UsingList);
end;
end else
AssignError(Source);
end;
procedure TffSqlJoinTableExp.Clear;
begin
ClearColumns;
UsingCondExp.Free;
UsingCondExp := nil;
TableRef1.Free;
TableRef1 := nil;
TableRef2.Free;
TableRef2 := nil;
CondExp.Free;
CondExp := nil;
UsingList.Free;
UsingList := nil;
end;
destructor TffSqlJoinTableExp.Destroy;
begin
ClearColumns;
Columns.Free;
Columns := nil;
{only free the tables if they belongs to us}
{if they are sub-expressions they will be
destroyed by the owning expression object}
if (TL <> nil) and (TL.Owner = Self) then begin
TL.Owner := nil;
TL.Free;
end;
if (TR <> nil) and (TR.Owner = Self) then begin
TR.Owner := nil;
TR.Free;
end;
Clear;
Joiner.Free;
if FResultTable <> nil then
if FResultTable.Owner = Self then begin
FResultTable.Owner := nil;
FResultTable.Free;
FResultTable := nil;
end;
UsingCondExp.Free;
inherited;
end;
procedure TffSqlJoinTableExp.EmitSQL(Stream: TStream);
begin
WriteStr(Stream,' ');
TableRef1.EmitSQL(Stream);
if JoinType = jtCross then
WriteStr(Stream,' CROSS JOIN ')
else begin
if Natural then
WriteStr(Stream,' NATURAL');
case JoinType of
jtInner :
WriteStr(Stream,' INNER');
jtLeftOuter :
WriteStr(Stream,' LEFT OUTER');
jtRightOuter :
WriteStr(Stream,' RIGHT OUTER');
jtFullOuter :
WriteStr(Stream,' FULL OUTER');
jtUnion :
WriteStr(Stream,' UNION');
end;
WriteStr(Stream,' JOIN');
end;
TableRef2.EmitSQL(Stream);
if CondExp <> nil then begin
WriteStr(Stream,' ON');
CondExp.EmitSQL(Stream);
end;
if UsingList <> nil then begin
WriteStr(Stream,' USING (');
UsingList.EmitSQL(Stream);
WriteStr(Stream,')');
end;
end;
procedure TffSqlJoinTableExp.EnumNodes(EnumMethod: TffSqlEnumMethod;
const Deep: Boolean);
begin
EnumMethod(Self);
if assigned(TableRef1) then
TableRef1.EnumNodes(EnumMethod, Deep);
if assigned(TableRef2) then
TableRef2.EnumNodes(EnumMethod, Deep);
if assigned(CondExp) then
CondExp.EnumNodes(EnumMethod, Deep);
if assigned(UsingList) then
UsingList.EnumNodes(EnumMethod, Deep);
end;
function TffSqlJoinTableExp.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
Other is TffSqlJoinTableExp
and (JoinType = TffSqlJoinTableExp(Other).JoinType)
and (Natural = TffSqlJoinTableExp(Other).Natural)
and ((BothNil(TableRef1, TffSqlJoinTableExp(Other).TableRef1)
or (BothNonNil(TableRef1, TffSqlJoinTableExp(Other).TableRef1)
and TableRef1.Equals(TffSqlJoinTableExp(Other).TableRef1))))
and ((BothNil(TableRef2, TffSqlJoinTableExp(Other).TableRef2)
or (BothNonNil(TableRef2, TffSqlJoinTableExp(Other).TableRef2)
and TableRef2.Equals(TffSqlJoinTableExp(Other).TableRef2))))
and ((BothNil(CondExp, TffSqlJoinTableExp(Other).CondExp)
or (BothNonNil(CondExp, TffSqlJoinTableExp(Other).CondExp)
and CondExp.Equals(TffSqlJoinTableExp(Other).CondExp))))
and ((BothNil(UsingList, TffSqlJoinTableExp(Other).UsingList)
or (BothNonNil(UsingList, TffSqlJoinTableExp(Other).UsingList)
and UsingList.Equals(TffSqlJoinTableExp(Other).UsingList))));
end;
procedure TffSqlJoinTableExp.Execute(
var aLiveResult: Boolean; var aCursorID: TffCursorID;
var RecordsRead: Integer);
var
T : TffSqlTableProxy;
begin
Assert(Owner <> nil);
aLiveResult := False;
T := Execute2(True);
aCursorID := T.CursorID;
T.LeaveCursorOpen := True;
if T.Owner = self then begin
T.Owner := nil;
T.Free;
end;
end;
function TffSqlJoinTableExp.GetFieldsFromTable(const TableName: string; List: TList): TffSqlTableProxy;
var
i: Integer;
begin
Result := nil;
if SameText(TableRef1.Alias, TableName)
or SameText(TableRef1.TableName, TableName) then begin
Result := ResultTable;
for i := 0 to pred(Columns.Count) do
if Columns.Objects[i] is TffSqlFieldProxy then
if TffSqlFieldProxy(Columns.Objects[i]).OwnerTable = TableRef1.FTable then
List.Add(Columns.Objects[i]);
exit;
end;
if SameText(TableRef2.Alias, TableName)
or SameText(TableRef2.TableName, TableName) then begin
Result := ResultTable;
for i := 0 to pred(Columns.Count) do
if Columns.Objects[i] is TffSqlFieldProxy then
if TffSqlFieldProxy(Columns.Objects[i]).OwnerTable = TableRef2.FTable then
List.Add(Columns.Objects[i]);
exit;
end;
end;
function TffSqlJoinTableExp.Reduce: Boolean;
begin
if assigned(CondExp) then
Result := CondExp.Reduce
else
Result := False;
{!!.11 begin}
if not Result then
if TableRef1.Reduce then
Result := True
else
if TableRef2.Reduce then
Result := True;
{!!.11 end}
end;
function TffSqlJoinTableExp.TargetFieldFromSourceField(
const F: TffSqlFieldProxy): TffSqlFieldProxy;
var
i: Integer;
begin
for i := 0 to pred(Columns.Count) do
if Columns.Objects[i] = F then begin
Result := ResultTable.Field(i);
exit;
end;
{!!.11 begin}
{We don't have the sought after source field represented in
our answer table directly, but it might be represented
indirectly as a field in a nested table expression}
Result := TableRef1.TargetFieldFromSourceField(F);
if Result <> nil then begin
for i := 0 to pred(Columns.Count) do
if Columns.Objects[i] = Result then begin
Result := ResultTable.Field(i);
exit;
end;
end;
Result := TableRef2.TargetFieldFromSourceField(F);
if Result <> nil then begin
for i := 0 to pred(Columns.Count) do
if Columns.Objects[i] = Result then begin
Result := ResultTable.Field(i);
exit;
end;
end;
{!!.11 end}
Result := nil;
end;
{ TffSqlNonJoinTableTerm }
procedure TffSqlNonJoinTableTerm.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlNonJoinTableTerm then begin
Clear;
if TffSqlNonJoinTableTerm(Source).NonJoinTablePrimary <> nil then begin
NonJoinTablePrimary := TffSqlNonJoinTablePrimary.Create(Self);
NonJoinTablePrimary.Assign(TffSqlNonJoinTableTerm(Source).NonJoinTablePrimary);
end;
end else
AssignError(Source);
end;
function TffSqlNonJoinTableTerm.BindFieldDown(const TableName,
FieldName: string): TFFSqlFieldProxy;
begin
Result := NonJoinTablePrimary.BindFieldDown(TableName, FieldName);
end;
function TffSqlNonJoinTableTerm.BindTable(AOwner: TObject;
const TableName: string): TFFSqlTableProxy;
begin
Result := NonJoinTablePrimary.BindTable(AOwner, TableName);
end;
procedure TffSqlNonJoinTableTerm.Clear;
begin
NonJoinTablePrimary.Free;
NonJoinTablePrimary := nil;
end;
function TffSqlNonJoinTableTerm.DependsOn(
Table: TFFSqlTableProxy): Boolean;
begin
Assert(NonJoinTablePrimary <> nil);
Result := NonJoinTablePrimary.DependsOn(Table);
end;
destructor TffSqlNonJoinTableTerm.Destroy;
begin
Clear;
inherited;
end;
procedure TffSqlNonJoinTableTerm.EmitSQL(Stream: TStream);
begin
if assigned(NonJoinTablePrimary) then
NonJoinTablePrimary.EmitSQL(Stream);
end;
procedure TffSqlNonJoinTableTerm.EnsureResultTable(NeedData: Boolean);
begin
assert(assigned(NonJoinTablePrimary));
NonJoinTablePrimary.EnsureResultTable(NeedData);
end;
procedure TffSqlNonJoinTableTerm.EnumNodes(EnumMethod: TffSqlEnumMethod;
const Deep: Boolean);
begin
EnumMethod(Self);
if assigned(NonJoinTablePrimary) then
NonJoinTablePrimary.EnumNodes(EnumMethod, Deep);
end;
function TffSqlNonJoinTableTerm.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
Other is TffSqlNonJoinTableTerm
and ((BothNil(NonJoinTablePrimary, TffSqlNonJoinTableTerm(Other).NonJoinTablePrimary)
or (BothNonNil(NonJoinTablePrimary, TffSqlNonJoinTableTerm(Other).NonJoinTablePrimary)
and NonJoinTablePrimary.Equals(TffSqlNonJoinTableTerm(Other).NonJoinTablePrimary))))
end;
procedure TffSqlNonJoinTableTerm.Execute(
var aLiveResult: Boolean; var aCursorID: TffCursorID;
var RecordsRead: Integer);
begin
Assert(NonJoinTablePrimary <> nil);
NonJoinTablePrimary.Execute(aLiveResult, aCursorID, RecordsRead);
end;
function TffSqlNonJoinTableTerm.GetResultTable: TffSqlTableProxy;
begin
Assert(NonJoinTablePrimary <> nil);
Result := NonJoinTablePrimary.ResultTable;
end;
function TffSqlNonJoinTableTerm.Reduce: Boolean;
begin
Assert(NonJoinTablePrimary <> nil);
Result := NonJoinTablePrimary.Reduce;
end;
function TffSqlNonJoinTableTerm.TargetFieldFromSourceField(
const F: TffSqlFieldProxy): TffSqlFieldProxy;
begin
Result := NonJoinTablePrimary.TargetFieldFromSourceField(F);
end;
{ TffSqlNonJoinTableExp }
procedure TffSqlNonJoinTableExp.Assign(const Source: TffSqlNode);
begin
if Source is TffSqlNonJoinTableExp then begin
Clear;
if TffSqlNonJoinTableExp(Source).NonJoinTableTerm <> nil then begin
NonJoinTableTerm := TffSqlNonJoinTableTerm.Create(Self);
NonJoinTableTerm.Assign(TffSqlNonJoinTableExp(Source).NonJoinTableTerm);
end;
end else
AssignError(Source);
end;
function TffSqlNonJoinTableExp.BindFieldDown(const TableName,
FieldName: string): TFFSqlFieldProxy;
begin
Result := NonJoinTableTerm.BindFieldDown(TableName, FieldName);
end;
function TffSqlNonJoinTableExp.BindTable(AOwner: TObject;
const TableName: string): TFFSqlTableProxy;
begin
Result := NonJoinTableTerm.BindTable(AOwner, TableName);
end;
procedure TffSqlNonJoinTableExp.Clear;
begin
NonJoinTableTerm.Free;
NonJoinTableTerm := nil;
end;
function TffSqlNonJoinTableExp.DependsOn(Table: TFFSqlTableProxy): Boolean;
begin
Assert(NonJoinTableTerm <> nil);
Result := NonJoinTableTerm.DependsOn(Table);
end;
destructor TffSqlNonJoinTableExp.Destroy;
begin
Clear;
inherited;
end;
procedure TffSqlNonJoinTableExp.EmitSQL(Stream: TStream);
begin
if assigned(NonJoinTableTerm) then
NonJoinTableTerm.EmitSQL(Stream);
end;
procedure TffSqlNonJoinTableExp.EnsureResultTable(NeedData: Boolean);
begin
Assert(Assigned(NonJoinTableTerm));
NonJoinTableTerm.EnsureResultTable(NeedData);
end;
procedure TffSqlNonJoinTableExp.EnumNodes(EnumMethod: TffSqlEnumMethod;
const Deep: Boolean);
begin
EnumMethod(Self);
if assigned(NonJoinTableTerm) then
NonJoinTableTerm.EnumNodes(EnumMethod, Deep);
end;
function TffSqlNonJoinTableExp.Equals(Other: TffSqlNode): Boolean;
begin
Result :=
Other is TffSqlNonJoinTableExp
and ((BothNil(NonJoinTableTerm, TffSqlNonJoinTableExp(Other).NonJoinTableTerm)
or (BothNonNil(NonJoinTableTerm, TffSqlNonJoinTableExp(Other).NonJoinTableTerm)
and NonJoinTableTerm.Equals(TffSqlNonJoinTableExp(Other).NonJoinTableTerm))))
end;
procedure TffSqlNonJoinTableExp.Execute(
var aLiveResult: Boolean; var aCursorID: TffCursorID;
var RecordsRead: Integer);
begin
Assert(NonJoinTableTerm <> nil);
NonJoinTableTerm.Execute(aLiveResult, aCursorID, RecordsRead);
end;
{!!.11 new}
function TffSqlNonJoinTableExp.GetFieldsFromTable(const TableName: string; List: TList): TffSqlTableProxy; {!!.11}
begin
Result := nil;
end;
function TffSqlNonJoinTableExp.GetResultTable: TffSqlTableProxy;
begin
Assert(NonJoinTableTerm <> nil);
Result := NonJoinTableTerm.ResultTable;
end;
function TffSqlNonJoinTableExp.Reduce: Boolean;
begin
Assert(NonJoinTableTerm <> nil);
Result := NonJoinTableTerm.Reduce;
end;
constructor TffSqlJoinTableExp.Create;
begin
inherited;
Columns := TStringList.Create;
end;
function TffSqlNonJoinTableExp.TargetFieldFromSourceField(
const F: TffSqlFieldProxy): TffSqlFieldProxy;
begin
Result := NonJoinTableTerm.TargetFieldFromSourceField(F);
end;
{ TFFSqlUsingItem }
procedure TFFSqlUsingItem.Assign(const Source: TffSqlNode);
begin
if Source is TFFSqlUsingItem then begin
ColumnName := TFFSqlUsingItem(Source).ColumnName;
end else
AssignError(Source);
end;
procedure TFFSqlUsingItem.EmitSQL(Stream: TStream);
begin
WriteStr(Stream, ' ');
WriteStr(Stream, ColumnName);
end;
procedure TFFSqlUsingItem.EnumNodes(EnumMethod: TffSqlEnumMethod;
const Deep: Boolean);
begin
EnumMethod(Self);
end;
function TFFSqlUsingItem.Equals(Other: TffSqlNode): Boolean;
begin
if Other is TFFSqlUsingItem then
Result := ColumnName = TFFSqlUsingItem(Other).ColumnName
else
Result := False;
end;
{===TffSqlUsingList==================================================}
function TffSqlUsingList.AddItem(NewUsing: TffSqlUsingItem): TffSqlUsingItem;
begin
FUsingItemList.Add(NewUsing);
Result := NewUsing;
end;
{--------}
procedure TffSqlUsingList.Assign(const Source: TffSqlNode);
var
i: Integer;
begin
if Source is TffSqlUsingList then begin
Clear;
for i := 0 to pred(TffSqlUsingList(Source).UsingCount) do
AddItem(TffSqlUsingItem.Create(Self)).Assign(
TffSqlUsingList(Source).UsingItem[i]);
end else
AssignError(Source);
end;
constructor TffSqlUsingList.Create(AParent: TffSqlNode);
begin
inherited Create(AParent);
FUsingItemList := TList.Create;
end;
{--------}
procedure TffSqlUsingList.Clear;
var
i : Integer;
begin
for i := 0 to pred(FUsingItemList.Count) do
UsingItem[i].Free;
FUsingItemList.Clear;
end;
{--------}
destructor TffSqlUsingList.Destroy;
begin
Clear;
FUsingItemList.Free;
inherited;
end;
{--------}
procedure TffSqlUsingList.EmitSQL(Stream: TStream);
var
i : Integer;
begin
UsingItem[0].EmitSQL(Stream);
for i := 1 to pred(UsingCount) do begin
WriteStr(Stream,', ');
UsingItem[i].EmitSQL(Stream);
end;
end;
{--------}
procedure TffSqlUsingList.EnumNodes(EnumMethod: TffSqlEnumMethod; const Deep: Boolean);
var
i : Integer;
begin
EnumMethod(Self);
for i := 0 to pred(UsingCount) do
UsingItem[i].EnumNodes(EnumMethod, Deep);
end;
{--------}
function TffSqlUsingList.Equals(Other: TffSqlNode): Boolean;
var
i : Integer;
begin
Result := False;
if Other is TffSqlUsingList then begin
if UsingCount <> TffSqlUsingList(Other).UsingCount then
exit;
for i := 0 to pred(UsingCount) do
if not UsingItem[i].Equals(TffSqlUsingList(Other).UsingItem[i]) then
exit;
Result := True;
end;
end;
{--------}
function TffSqlUsingList.GetUsingCount: Integer;
begin
Result := FUsingItemList.Count;
end;
{--------}
function TffSqlUsingList.GetUsingItem(
Index: Integer): TffSqlUsingItem;
begin
Result := TffSqlUsingItem(FUsingItemList[Index]);
end;
{--------}
procedure TffSqlUsingList.SetUsingItem(Index: Integer;
const Value: TffSqlUsingItem);
begin
FUsingItemList[Index] := Value;
end;
{====================================================================}
initialization
{calculate TimeDelta as one second} {!!.01}
TimeDelta := EncodeTime(0, 0, 2, 0) - EncodeTime(0, 0, 1, 0); {!!.01}
end.