david
e4d0fcb01d
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@46 b6239004-a887-0f4b-9937-50029ccdca16
1229 lines
34 KiB
ObjectPascal
1229 lines
34 KiB
ObjectPascal
unit uDAWhere;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ Data Abstract Library - Core Library }
|
|
{ }
|
|
{ compiler: Delphi 6 and up, Kylix 3 and up }
|
|
{ platform: Win32, Linux }
|
|
{ }
|
|
{ (c)opyright RemObjects Software. all rights reserved. }
|
|
{ }
|
|
{ Using this code requires a valid license of the Data Abstract }
|
|
{ which can be obtained at http://www.remobjects.com. }
|
|
{----------------------------------------------------------------------------}
|
|
|
|
{$I DataAbstract.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils, Classes, uDAInterfaces, DateUtils, uROBinaryHelpers,
|
|
uROCompression, uROXMLIntf, uROClientIntf, FMTBcd;
|
|
|
|
type
|
|
TDABinaryExpression = class(TDAWhereExpression)
|
|
private
|
|
fLeft,
|
|
fRight: TDAWhereExpression;
|
|
fOperator: TDABinaryOperator;
|
|
public
|
|
constructor Create(aLeft, aRight: TDAWhereExpression; anOp: TDABinaryOperator); overload;
|
|
destructor Destroy; override;
|
|
|
|
property Left: TDAWhereExpression read fLeft write fLeft;
|
|
property Right: TDAWhereExpression read fRight write fRight;
|
|
property Operator: TDABinaryOperator read fOperator write fOperator;
|
|
|
|
procedure ReadFromXml(xr: IXmlNode); override;
|
|
procedure WriteToXml(sw: IXmlNode); override;
|
|
procedure Validate; override;
|
|
end;
|
|
|
|
TDAUnaryExpression = class(TDAWhereExpression)
|
|
private
|
|
fExpression: TDAWhereExpression;
|
|
fOperator: TDAUnaryOperator;
|
|
public
|
|
constructor Create(anExpression: TDAWhereExpression; anOp: TDAUnaryOperator); overload;
|
|
|
|
destructor Destroy; override;
|
|
|
|
property Expression: TDAWhereExpression read fExpression write fExpression;
|
|
property Operator: TDAUnaryOperator read fOperator write fOperator;
|
|
|
|
procedure ReadFromXml(xr: IXmlNode); override;
|
|
procedure WriteToXml(sw: IXmlNode); override;
|
|
procedure Validate; override;
|
|
end;
|
|
|
|
TDAConstantExpression = class(TDAWhereExpression)
|
|
private
|
|
fType: TDADataType;
|
|
fValue: Variant;
|
|
procedure SetValue(const Value: Variant);
|
|
public
|
|
class function SerializeObject(const v: Variant; dt: TDADataType): string;
|
|
class function DeserializeObject(const s: string; dt: TDADataType): Variant;
|
|
|
|
constructor Create(const aValue: Variant); overload;
|
|
constructor Create(const aValue: Variant; aType: TDADataType); overload;
|
|
|
|
property aType: TDADataType read fType write fType;
|
|
property Value: Variant read fValue write SetValue;
|
|
|
|
procedure ReadFromXml(xr: IXmlNode); override;
|
|
procedure WriteToXml(sw: IXmlNode); override;
|
|
end;
|
|
|
|
TDAListExpression = class(TDAWhereExpression)
|
|
private
|
|
FItems: TList;
|
|
function GetItem(idx: Integer): TDAWhereExpression;
|
|
procedure SetItem(idx: Integer; aValue: TDAWhereExpression);
|
|
function GetCount: Integer;
|
|
public
|
|
constructor Create(const aValues: array of TDAWhereExpression); overload;
|
|
constructor Create; overload;
|
|
|
|
destructor Destroy; override;
|
|
|
|
property Count: Integer read GetCount;
|
|
property Item[idx: Integer]: TDAWhereExpression read getItem write setItem; default;
|
|
|
|
procedure Add(aValue: TDAWhereExpression);
|
|
procedure Delete(index: Integer);
|
|
procedure Remove(aValue: TDAWhereExpression);
|
|
procedure Insert(Position: Integer; aValue: TDAWhereExpression);
|
|
|
|
procedure ReadFromXml(xr: IXmlNode); override;
|
|
procedure WriteToXml(sw: IXmlNode); override;
|
|
procedure Validate; override;
|
|
end;
|
|
|
|
TDAParameterExpression = class(TDAWhereExpression)
|
|
private
|
|
fParameterName: string;
|
|
public
|
|
constructor Create(const aParameterName: string); overload;
|
|
|
|
property ParameterName: string read fParameterName write fParameterName;
|
|
|
|
procedure ReadFromXml(xr: IXmlNode); override;
|
|
procedure WriteToXml(sw: IXmlNode); override;
|
|
procedure Validate; override;
|
|
end;
|
|
|
|
TDAFieldExpression = class(TDAWhereExpression)
|
|
private
|
|
fFieldName: string;
|
|
fTableName: string;
|
|
public
|
|
constructor Create(const aTableName, aFieldName: string); overload;
|
|
|
|
property TableName: string read fTableName write fTableName;
|
|
property FieldName: string read fFieldName write fFieldName;
|
|
|
|
procedure ReadFromXml(xr: IXmlNode); override;
|
|
procedure WriteToXml(sw: IXmlNode); override;
|
|
procedure Validate; override;
|
|
end;
|
|
|
|
TDANullExpression = class(TDAWhereExpression)
|
|
public
|
|
procedure ReadFromXml(xr: IXmlNode); override;
|
|
procedure WriteToXml(sw: IXmlNode); override;
|
|
end;
|
|
|
|
TDAMacroExpression = class(TDAWhereExpression)
|
|
private
|
|
FItems: TList;
|
|
fName: string;
|
|
function GetItem(idx: Integer): TDAWhereExpression;
|
|
procedure SetItem(idx: Integer; aValue: TDAWhereExpression);
|
|
function GetCount: Integer;
|
|
public
|
|
constructor Create; overload;
|
|
constructor Create(const aName: string); overload;
|
|
constructor Create(const aName: string; const aValues: array of TDAWhereExpression); overload;
|
|
|
|
destructor Destroy; override;
|
|
|
|
property Name: string read fName write fName;
|
|
|
|
property Count: Integer read GetCount;
|
|
property Item[idx: Integer]: TDAWhereExpression read GetItem write SetItem; default;
|
|
|
|
procedure Add(aValue: TDAWhereExpression);
|
|
procedure Delete(index: Integer);
|
|
procedure Remove(aValue: TDAWhereExpression);
|
|
procedure Insert(Position: Integer; aValue: TDAWhereExpression);
|
|
|
|
procedure ReadFromXml(xr: IXmlNode); override;
|
|
procedure WriteToXml(sw: IXmlNode); override;
|
|
procedure Validate; override;
|
|
end;
|
|
|
|
TDASelectWhereBuilder = class;
|
|
TDASelectWhereItem = class(TObject) // abstract
|
|
private
|
|
fOwner: TDASelectWhereBuilder;
|
|
public
|
|
constructor Create(anOwner: TDASelectWhereBuilder);
|
|
|
|
property Owner: TDASelectWhereBuilder read fOwner;
|
|
|
|
procedure ReadFromXml(xr: IXmlNode); virtual; abstract;
|
|
procedure WriteToXml(sw: IXmlNode); virtual; abstract;
|
|
end;
|
|
|
|
TDASelectWhereField = class(TDASelectWhereItem)
|
|
private
|
|
fAlias, fFieldName: string;
|
|
public
|
|
constructor Create(anOwner: TDASelectWhereBuilder); overload;
|
|
constructor Create(anOwner: TDASelectWhereBuilder; const aFieldName: String); overload;
|
|
constructor Create(anOwner: TDASelectWhereBuilder; const aFieldName, anAlias: string); overload;
|
|
|
|
property FieldName: string read fFieldName write fFieldName;
|
|
property Alias: string read fAlias write fAlias;
|
|
|
|
procedure ReadFromXml(xr: IXmlNode); override;
|
|
procedure WriteToXml(sw: IXmlNode); override;
|
|
end;
|
|
|
|
TDASelectWhereBuilder = class(TDAWhereBuilder)
|
|
private
|
|
fFields: TList;
|
|
fTableName: string;
|
|
function GetCount: Integer;
|
|
function GetItem(i: Integer): TDASelectWhereItem;
|
|
protected
|
|
function ReadFromXml(xr: IXmlNode):TDAWhereExpression; override;
|
|
procedure WriteToXml(sw: IXmlNode; const aExpression: TDAWhereExpression); override;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
|
|
|
|
property TableName: string read fTableName write fTableName;
|
|
property Fields[i: Integer]: TDASelectWhereItem read GetItem;
|
|
property FieldCount: Integer read GetCount;
|
|
|
|
function AddField(aField: TDASelectWhereItem): Integer;
|
|
procedure DeleteField(index: Integer);
|
|
end;
|
|
|
|
|
|
function CreateWhereExpression(AName: string): TDAWhereExpression;
|
|
|
|
type
|
|
TWhereFieldsArray = array of string;
|
|
|
|
function Where_ExtractFieldNames(const AWhereExpression: TDAWhereExpression): TWhereFieldsArray;
|
|
function Where_RemapFieldNames(const aXML: widestring; aMappings: TDAColumnMappingCollection; aTargetTableName: String): widestring;
|
|
function ProcessDAWhereForUnions(aSourceTableID: Integer; var aDAWhereString: WideString): Boolean;
|
|
|
|
implementation
|
|
|
|
uses Variants, TypInfo, uROClasses, uDAClasses;
|
|
|
|
|
|
function Where_ExtractFieldNames(const AWhereExpression: TDAWhereExpression): TWhereFieldsArray;
|
|
|
|
procedure ProcessExpression(aExpression: TDAWhereExpression);
|
|
var
|
|
i: integer;
|
|
begin
|
|
if aExpression = nil then Exit;
|
|
if aExpression is TDABinaryExpression then begin
|
|
ProcessExpression(TDABinaryExpression(aExpression).fLeft);
|
|
ProcessExpression(TDABinaryExpression(aExpression).fRight);
|
|
end
|
|
else if aExpression is TDAUnaryExpression then begin
|
|
ProcessExpression(TDAUnaryExpression(aExpression).Expression);
|
|
end
|
|
else if aExpression is TDAListExpression then begin
|
|
with TDAListExpression(aExpression) do
|
|
for i := 0 to Count - 1 do
|
|
ProcessExpression(Item[i]);
|
|
end
|
|
else if aExpression is TDAFieldExpression then begin
|
|
SetLength(Result,Length(Result)+1);
|
|
with TDAFieldExpression(AExpression) do begin
|
|
//Result[High(Result)]:=TableName +'.'+ FieldName;
|
|
Result[High(Result)]:=FieldName;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
SetLength(Result,0);
|
|
ProcessExpression(AWhereExpression);
|
|
end;
|
|
|
|
function Where_RemapFieldNames(const aXML: widestring; aMappings: TDAColumnMappingCollection; aTargetTableName: String): widestring;
|
|
|
|
procedure ProcessExpression(aExpression: TDAWhereExpression);
|
|
var
|
|
i: integer;
|
|
lMapping : TDAColumnMapping;
|
|
begin
|
|
if aExpression = nil then Exit;
|
|
if aExpression is TDABinaryExpression then begin
|
|
ProcessExpression(TDABinaryExpression(aExpression).fLeft);
|
|
ProcessExpression(TDABinaryExpression(aExpression).fRight);
|
|
end
|
|
else if aExpression is TDAUnaryExpression then begin
|
|
ProcessExpression(TDAUnaryExpression(aExpression).Expression);
|
|
end
|
|
else if aExpression is TDAListExpression then begin
|
|
with TDAListExpression(aExpression) do
|
|
for i := 0 to Count - 1 do
|
|
ProcessExpression(Item[i]);
|
|
end
|
|
else if aExpression is TDAFieldExpression then begin
|
|
SetLength(Result,Length(Result)+1);
|
|
with TDAFieldExpression(AExpression) do begin
|
|
TableName := aTargetTableName;
|
|
lMapping := aMappings.FindMappingByDatasetField(FieldName);
|
|
if (assigned(lMapping)) then FieldName := lMapping.TableField;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
SetLength(Result,0);
|
|
if aXML <> '' then
|
|
with TDAWhereBuilder.Create do try
|
|
Xml:=aXML;
|
|
ProcessExpression(Expression);
|
|
result := Xml;
|
|
finally
|
|
free;
|
|
end;
|
|
end;
|
|
|
|
function CreateWhereExpression(AName: string): TDAWhereExpression;
|
|
begin
|
|
if AName = 'binaryoperation' then
|
|
Result := TDABinaryExpression.Create
|
|
else if AName = 'unaryoperation' then
|
|
Result := TDAUnaryExpression.Create
|
|
else if AName = 'constant' then
|
|
Result := TDAConstantExpression.Create
|
|
else if AName = 'list' then
|
|
Result := TDAListExpression.Create
|
|
else if AName = 'parameter' then
|
|
Result := TDAParameterExpression.Create
|
|
else if AName = 'field' then
|
|
Result := TDAFieldExpression.Create
|
|
else if AName = 'null' then
|
|
Result := TDANullExpression.Create
|
|
else if AName = 'macro' then
|
|
Result := TDAMacroExpression.Create
|
|
else
|
|
raise Exception.Create('Unknown element type: '+AName);
|
|
end;
|
|
|
|
{ TDABinaryExpression }
|
|
|
|
constructor TDABinaryExpression.Create(aLeft,aRight: TDAWhereExpression; anOp: TDABinaryOperator);
|
|
begin
|
|
inherited Create;
|
|
fLeft := aLeft;
|
|
fRight := aRight;
|
|
fOperator := anOp;
|
|
end;
|
|
|
|
destructor TDABinaryExpression.Destroy;
|
|
begin
|
|
fLeft.Free;
|
|
fRight.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TDABinaryExpression.ReadFromXml(xr: IXmlNode);
|
|
begin
|
|
fOperator := TDABinaryOperator(GetEnumValue(typeinfo(TDABinaryOperator), 'dbo'+xr.GetAttributeValue('operator', 'Addition')));
|
|
FreeAndNil(fLeft);
|
|
FreeAndNil(fRight);
|
|
Left := TDAWhereExpression.ParseExpression(xr.FirstChild);
|
|
Right := TDAWhereExpression.ParseExpression(xr.FirstChild.NextSibling);
|
|
end;
|
|
|
|
procedure TDABinaryExpression.Validate;
|
|
begin
|
|
inherited;
|
|
if Left = nil then raise Exception.Create('TDABinaryExpression.Left must be assigned.');
|
|
Left.Validate;
|
|
if Right = nil then raise Exception.Create('TDABinaryExpression.Right must be assigned.');
|
|
Right.Validate;
|
|
end;
|
|
|
|
procedure TDABinaryExpression.WriteToXml(sw: IXmlNode);
|
|
var
|
|
lNode: IXMLNode;
|
|
begin
|
|
lNode := sw.Add('binaryoperation');
|
|
lNode.AddAttribute('operator', Copy(GetEnumName(typeinfo(TDABinaryOperator), ord(fOperator)), 4, MaxInt));
|
|
if Left <> nil then Left.WriteToXml(lNode);
|
|
if Right <> nil then Right.WriteToXml(lNode);
|
|
end;
|
|
|
|
{ TDAUnaryExpression }
|
|
|
|
constructor TDAUnaryExpression.Create(anExpression: TDAWhereExpression; anOp: TDAUnaryOperator);
|
|
begin
|
|
inherited Create;
|
|
fExpression := anExpression;
|
|
fOperator := anOp;
|
|
end;
|
|
|
|
destructor TDAUnaryExpression.Destroy;
|
|
begin
|
|
fExpression.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDAUnaryExpression.ReadFromXml(xr: IXmlNode);
|
|
begin
|
|
FreeAndNil(fExpression);
|
|
fOperator := TDAUnaryOperator(GetEnumValue(typeinfo(TDAUnaryOperator), 'duo'+xr.GetAttributeValue('operator', 'Not')));
|
|
fExpression := TDAWhereExpression.ParseExpression(xr.FirstChild);
|
|
end;
|
|
|
|
procedure TDAUnaryExpression.Validate;
|
|
begin
|
|
inherited;
|
|
if Expression = nil then raise Exception.Create('TDAUnaryExpression.Expression must be assigned.');
|
|
Expression.Validate;
|
|
end;
|
|
|
|
procedure TDAUnaryExpression.WriteToXml(sw: IXmlNode);
|
|
var
|
|
lNode: IXMLNode;
|
|
begin
|
|
lNode := sw.Add('unaryoperation');
|
|
lNode.AddAttribute('operator', Copy(GetEnumName(typeinfo(TDAUnaryOperator), ord(fOperator)), 4, MaxInt));
|
|
if fExpression <> nil then fExpression.WriteToXml(lNode);
|
|
end;
|
|
|
|
{ TDAConstantExpression }
|
|
|
|
constructor TDAConstantExpression.Create(const aValue: Variant);
|
|
begin
|
|
inherited Create;
|
|
Value := aValue;
|
|
end;
|
|
|
|
constructor TDAConstantExpression.Create(const aValue: Variant; aType: TDADataType);
|
|
begin
|
|
Create(aValue);
|
|
fType := aType;
|
|
end;
|
|
|
|
function GetVariantBase64(s: string): Variant;
|
|
var ss: TStringStream;
|
|
binstream : TMemoryStream;
|
|
begin
|
|
binstream := TMemoryStream.Create;
|
|
ss := TStringStream.Create(s);
|
|
|
|
try
|
|
|
|
DecodeStream(ss, binstream);
|
|
binstream.Position := 0;
|
|
|
|
Result := ReadVariantFromBinary(binstream);
|
|
finally
|
|
FreeAndNIL(ss);
|
|
FreeAndNIL(binstream);
|
|
end;
|
|
end;
|
|
|
|
class function TDAConstantExpression.DeserializeObject(const s: string;
|
|
dt: TDADataType): Variant;
|
|
var
|
|
lTemp: Currency;
|
|
c: Integer;
|
|
lTemp2: Double;
|
|
lTemp3: Single;
|
|
begin
|
|
case dt of
|
|
datGuid: if copy(s,1,1) <> '{' then result := '{'+s+'}' else result := s;
|
|
datXml: result := s;
|
|
datDecimal: result := BCDToVariant(StrToBcd(StringReplace(s, '.', DecimalSeparator, [])));
|
|
datSingleFloat:
|
|
begin
|
|
Val(s, lTemp3, c);
|
|
Result := lTemp3;
|
|
end;
|
|
datLargeAutoInc,
|
|
datCardinal,
|
|
datLargeUInt,
|
|
datLargeInt: Result := StrToInt64(s);
|
|
datBoolean: result := Lowercase(S) = 'true';
|
|
datAutoInc,
|
|
datByte,
|
|
datShortInt,
|
|
datWord,
|
|
datSmallInt,
|
|
datInteger: Result := STrToInt(S);
|
|
datBlob: Result := GetVariantBase64(s);
|
|
datCurrency:
|
|
begin
|
|
Int64((@lTemp)^) := StrToInt64(s);
|
|
Result := lTemp;
|
|
end;
|
|
datDateTime: Result := UnixToDateTime(StrToInt64(s));
|
|
datFloat:
|
|
begin
|
|
Val(s, lTemp2, c);
|
|
Result := lTemp2;
|
|
end;
|
|
{
|
|
DataType.Memo: ;
|
|
DataType.String: ;
|
|
DataType.Unknown: ;
|
|
DataType.WideMemo: ;
|
|
DataType.WideString: ;
|
|
}
|
|
else
|
|
Result := s;
|
|
end;
|
|
end;
|
|
|
|
function GetBase64Variant(v: Variant): string;
|
|
var ss: TStringStream;
|
|
binstream : TMemoryStream;
|
|
begin
|
|
binstream := TMemoryStream.Create;
|
|
ss := TStringStream.Create('');
|
|
|
|
try
|
|
WriteVariantToBinary(v, binstream);
|
|
binstream.Position := 0;
|
|
|
|
EncodeStream(binstream, ss);
|
|
result := ss.DataString;
|
|
finally
|
|
FreeAndNIL(ss);
|
|
FreeAndNIL(binstream);
|
|
end;
|
|
end;
|
|
|
|
class function TDAConstantExpression.SerializeObject(const v: Variant;
|
|
dt: TDADataType): string;
|
|
var
|
|
lTemp: Int64;
|
|
begin
|
|
case dt of
|
|
datBoolean: if v then Result := 'True' else Result := 'False';
|
|
datGuid: begin Result := v; if Copy(Result, 1,1) = '{' then Result := Copy(Result, 2, Length(Result) -2); end;
|
|
datXml: result := v;
|
|
datDecimal: Result := StringReplace(BcdToStr(VariantToBCD(v)), DecimalSeparator, '.', []);
|
|
datSingleFloat: Result:= FloatToStr(Single(V)); //Str(Single(v), Result);
|
|
|
|
datLargeAutoInc,
|
|
datByte,
|
|
datShortInt,
|
|
datWord,
|
|
datSmallInt,
|
|
datCardinal,
|
|
datLargeUInt,
|
|
datLargeInt,
|
|
datAutoInc,
|
|
datInteger: begin
|
|
lTemp := v;
|
|
Result := IntTostr(lTemp);
|
|
end;
|
|
datBlob:
|
|
begin
|
|
Result := GetBase64Variant(v);
|
|
end;
|
|
datCurrency:
|
|
begin
|
|
Currency((@lTemp)^) := Currency(v);
|
|
Result := IntToStr(lTemp)
|
|
end;
|
|
datDateTime: Result := IntToStr(DateTimeToUnix(v));
|
|
datFloat: Result:= FloatToStr(Double(V)); //Str(Double(v), Result); // System.Str always emits .
|
|
{
|
|
DataType.Memo: ;
|
|
DataType.String: ;
|
|
DataType.Unknown: ;
|
|
DataType.WideMemo: ;
|
|
DataType.WideString: ;
|
|
}
|
|
else
|
|
Result := v;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAConstantExpression.ReadFromXml(xr: IXmlNode);
|
|
var
|
|
s: string;
|
|
begin
|
|
s := xr.GetAttributeValue('type', '');
|
|
if s <> '' then begin
|
|
s := 'dat' + s;
|
|
fType := TDADataType(GetEnumValue(typeinfo(TDADataType), s));
|
|
end;
|
|
if xr.GetAttributeValue('null', '0') = '1' then begin
|
|
fValue := null;
|
|
end else begin
|
|
fValue := DeserializeObject(xr.Value, fType);
|
|
end;
|
|
end;
|
|
|
|
procedure TDAConstantExpression.WriteToXml(sw: IXmlNode);
|
|
var
|
|
lNode: IXMLNode;
|
|
begin
|
|
lNode := sw.Add('constant');
|
|
lNode.AddAttribute('type', Copy(GetEnumName(typeinfo(TDADataType), ord(fType)), 4, MaxInt));
|
|
if VarIsNull(fValue) or VarIsError(fValue) then
|
|
lNode.AddAttribute('null', '1')
|
|
else begin
|
|
lNode.AddAttribute('null', '0');
|
|
LNode.Value := SerializeObject(fValue, fType);
|
|
end;
|
|
end;
|
|
|
|
procedure TDAConstantExpression.SetValue(const Value: Variant);
|
|
var
|
|
d: TDecimal;
|
|
begin
|
|
if not ROVariantsEqual(fValue,Value) then begin
|
|
fValue := Value;
|
|
case VarType(fValue) of
|
|
varSmallint: fType := datSmallInt;
|
|
varInteger: fType := datInteger;
|
|
varSingle: fType := datSingleFloat;
|
|
varDouble: fType := datFloat;
|
|
varCurrency: fType := datCurrency;
|
|
varDate: fType := datDateTime;
|
|
varUString,
|
|
varOleStr: fType := datWideString;
|
|
//varDispatch:
|
|
//varError:
|
|
varBoolean: fType := datBoolean;
|
|
//varVariant:
|
|
//varUnknown:
|
|
varShortInt: fType := datShortInt;
|
|
varByte: fType := datByte;
|
|
varWord: fType := datWord;
|
|
varLongWord: fType := datCardinal;
|
|
varInt64: fType := datLargeInt;
|
|
//varStrArg:
|
|
varString: fType := datString;
|
|
//varAny:
|
|
//varTypeMask:
|
|
//varByRef:
|
|
//: fType := datGuid;
|
|
//: fType := datXml;
|
|
//: fType := datDecimal;
|
|
//: fType := datLargeAutoInc;
|
|
//: fType := datLargeUInt;
|
|
//: fType := datAutoInc;
|
|
//: fType := datMemo;
|
|
//: fType := datWideMemo;
|
|
else
|
|
if fValue = varArray or varByte then begin
|
|
if VarByteArrayToDecimal(fValue,d) then
|
|
fType:= datDecimal
|
|
else
|
|
fType := datBlob;
|
|
end
|
|
else begin
|
|
fType:= datUnknown;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TDAListExpression }
|
|
|
|
procedure TDAListExpression.Add(aValue: TDAWhereExpression);
|
|
begin
|
|
FItems.Add(aValue);
|
|
end;
|
|
|
|
constructor TDAListExpression.Create(const aValues: array of TDAWhereExpression);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Create;
|
|
for i := 0 to Length(aValues) -1 do
|
|
Add(aValues[i]);
|
|
end;
|
|
|
|
constructor TDAListExpression.Create;
|
|
begin
|
|
inherited Create;
|
|
FItems := TList.Create;
|
|
end;
|
|
|
|
function TDAListExpression.GetCount: Integer;
|
|
begin
|
|
Result := FItems.Count;
|
|
end;
|
|
|
|
function TDAListExpression.GetItem(idx: Integer): TDAWhereExpression;
|
|
begin
|
|
Result := TDAWhereExpression(fItems[idx]);
|
|
end;
|
|
|
|
procedure TDAListExpression.Insert(Position: Integer;
|
|
aValue: TDAWhereExpression);
|
|
begin
|
|
fItems.Insert(Position, aValue);
|
|
end;
|
|
|
|
procedure TDAListExpression.ReadFromXml(xr: IXmlNode);
|
|
var
|
|
i: Integer;
|
|
el: IXMLNode;
|
|
begin
|
|
for i := 0 to xr.ChildrenCount -1 do begin
|
|
el := xr.Children[i];
|
|
Add(TDAWhereExpression.ParseExpression(el));
|
|
end;
|
|
end;
|
|
|
|
procedure TDAListExpression.WriteToXml(sw: IXmlNode);
|
|
var
|
|
i: Integer;
|
|
el: IXMLNode;
|
|
begin
|
|
el := sw.Add('list');
|
|
for i := 0 to Count -1 do begin
|
|
Item[i].WriteToXml(el);
|
|
end;
|
|
end;
|
|
|
|
procedure TDAListExpression.Remove(aValue: TDAWhereExpression);
|
|
var
|
|
lIndex: Integer;
|
|
begin
|
|
lIndex := FItems.IndexOf(aValue);
|
|
if lIndex <> -1 then
|
|
Delete(lIndex);
|
|
end;
|
|
|
|
procedure TDAListExpression.Delete(index: Integer);
|
|
begin
|
|
TObject(FItems[index]).Free;
|
|
fItems.Delete(index);
|
|
end;
|
|
|
|
procedure TDAListExpression.SetItem(idx: Integer;
|
|
aValue: TDAWhereExpression);
|
|
begin
|
|
fItems[idx] := aValue;
|
|
end;
|
|
|
|
destructor TDAListExpression.Destroy;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := fItems.Count -1 downto 0 do
|
|
TDAWhereExpression(fItems[i]).Free;
|
|
fItems.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TDAListExpression.Validate;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
inherited;
|
|
for i:=0 to Count-1 do begin
|
|
if Item[i] = nil then raise Exception.CreateFmt('TDAListExpression.Item[%d] must be assigned.',[i]);
|
|
Item[i].Validate;
|
|
end;
|
|
end;
|
|
|
|
{ TDAParameterExpression }
|
|
|
|
constructor TDAParameterExpression.Create(const aParameterName: string);
|
|
begin
|
|
inherited Create;
|
|
fParameterName := aParameterName;
|
|
end;
|
|
|
|
procedure TDAParameterExpression.ReadFromXml(xr: IXmlNode);
|
|
begin
|
|
fParameterName := xr.Value;
|
|
end;
|
|
|
|
procedure TDAParameterExpression.Validate;
|
|
begin
|
|
inherited;
|
|
if ParameterName = '' then raise Exception.Create('TDAParameterExpression.ParameterName must be assigned.');
|
|
end;
|
|
|
|
procedure TDAParameterExpression.WriteToXml(sw: IXmlNode);
|
|
var
|
|
el: IXmlNode;
|
|
begin
|
|
el := sw.Add('parameter');
|
|
el.Value := fParameterName;
|
|
end;
|
|
|
|
{ TDAFieldExpression }
|
|
|
|
constructor TDAFieldExpression.Create(const aTableName, aFieldName: string);
|
|
begin
|
|
inherited Create;
|
|
fTableName := aTableName;
|
|
fFieldName := aFieldName;
|
|
end;
|
|
|
|
procedure TDAFieldExpression.ReadFromXml(xr: IXmlNode);
|
|
begin
|
|
if xr.LocalName <> 'field' then raise Exception.Create('field tag expected');
|
|
fFieldName := VarToStr(xr.Value);
|
|
fTableName := xr.GetAttributeValue('tablename', '');
|
|
end;
|
|
|
|
procedure TDAFieldExpression.Validate;
|
|
begin
|
|
inherited;
|
|
if FieldName = '' then raise Exception.Create('TDAFieldExpression.FieldName must be assigned.');
|
|
end;
|
|
|
|
procedure TDAFieldExpression.WriteToXml(sw: IXmlNode);
|
|
var
|
|
el: IXMLNode;
|
|
begin
|
|
el := sw.Add('field');
|
|
el.Value := fFieldName;
|
|
if fTableName <> '' then
|
|
el.AddAttribute('tablename', fTableName);
|
|
end;
|
|
|
|
{ TDANullExpression }
|
|
|
|
procedure TDANullExpression.ReadFromXml(xr: IXmlNode);
|
|
begin
|
|
// nothing to do.
|
|
end;
|
|
|
|
procedure TDANullExpression.WriteToXml(sw: IXmlNode);
|
|
begin
|
|
sw.Add('null');
|
|
end;
|
|
|
|
{ TDAMacroExpression }
|
|
|
|
procedure TDAMacroExpression.Add(aValue: TDAWhereExpression);
|
|
begin
|
|
FItems.Add(aValue);
|
|
end;
|
|
|
|
constructor TDAMacroExpression.Create;
|
|
begin
|
|
inherited Create;
|
|
FItems := TList.Create;
|
|
end;
|
|
|
|
constructor TDAMacroExpression.Create(const aName: string);
|
|
begin
|
|
Create;
|
|
fName := aName;
|
|
end;
|
|
|
|
constructor TDAMacroExpression.Create(const aName: string; const aValues: array of TDAWhereExpression);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Create(aName);
|
|
for i := 0 to Length(aValues) -1 do
|
|
Add(aValues[i]);
|
|
end;
|
|
|
|
destructor TDAMacroExpression.Destroy;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := fItems.Count -1 downto 0 do
|
|
TObject(FItems[i]).Free;
|
|
fItems.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TDAMacroExpression.GetCount: Integer;
|
|
begin
|
|
Result := FItems.Count;
|
|
end;
|
|
|
|
function TDAMacroExpression.GetItem(idx: Integer): TDAWhereExpression;
|
|
begin
|
|
result := TDAWhereExpression(FItems[idx]);
|
|
end;
|
|
|
|
procedure TDAMacroExpression.Insert(Position: Integer;
|
|
aValue: TDAWhereExpression);
|
|
begin
|
|
FItems.Insert(Position, aValue);
|
|
end;
|
|
|
|
procedure TDAMacroExpression.Remove(aValue: TDAWhereExpression);
|
|
var
|
|
lIndex: Integer;
|
|
begin
|
|
lIndex := FItems.IndexOf(aValue);
|
|
if lIndex <> -1 then
|
|
Delete(lIndex);
|
|
end;
|
|
|
|
procedure TDAMacroExpression.Delete(index: Integer);
|
|
begin
|
|
TDAWhereExpression(FItems[index]).Free;
|
|
FItems.Delete(index);
|
|
end;
|
|
|
|
procedure TDAMacroExpression.SetItem(idx: Integer;
|
|
aValue: TDAWhereExpression);
|
|
begin
|
|
FItems[idx] := aValue;
|
|
end;
|
|
|
|
procedure TDAMacroExpression.ReadFromXml(xr: IXmlNode);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
fName := xr.GetAttributeValue('name', '');
|
|
for i := 0 to xr.ChildrenCount -1 do
|
|
Add(TDAWhereExpression.ParseExpression(xr.Children[i]));
|
|
end;
|
|
|
|
procedure TDAMacroExpression.WriteToXml(sw: IXmlNode);
|
|
var
|
|
el: IXMLNode;
|
|
i: Integer;
|
|
begin
|
|
el := sw.Add('macro');
|
|
el.AddAttribute('name', fName);
|
|
for i := 0 to Count -1 do
|
|
Item[i].WriteToXml(el);
|
|
end;
|
|
|
|
procedure TDAMacroExpression.Validate;
|
|
var
|
|
i: integer;
|
|
begin
|
|
inherited;
|
|
if Name = '' then raise Exception.Create('TDAMacroExpression.Name must be assigned.');
|
|
for i := 0 to Count -1 do begin
|
|
if Item[i] = nil then raise Exception.CreateFmt('TDAMacroExpression.Item[%d] must be assigned.',[i]);
|
|
Item[i].Validate;
|
|
end;
|
|
end;
|
|
|
|
{ TDASelectWhereItem }
|
|
|
|
constructor TDASelectWhereItem.Create(anOwner: TDASelectWhereBuilder);
|
|
begin
|
|
inherited Create;
|
|
fOwner := anOwner;
|
|
end;
|
|
|
|
{ TDASelectWhereField }
|
|
|
|
constructor TDASelectWhereField.Create(anOwner: TDASelectWhereBuilder);
|
|
begin
|
|
inherited Create(anOwner);
|
|
end;
|
|
|
|
constructor TDASelectWhereField.Create(anOwner: TDASelectWhereBuilder;
|
|
const aFieldName: String);
|
|
begin
|
|
inherited Create(anOwner);
|
|
fFieldName := aFieldName;
|
|
end;
|
|
|
|
constructor TDASelectWhereField.Create(anOwner: TDASelectWhereBuilder;
|
|
const aFieldName, anAlias: string);
|
|
begin
|
|
inherited Create(anOwner);
|
|
fFieldName := aFieldName;
|
|
fAlias := anAlias;
|
|
end;
|
|
|
|
procedure TDASelectWhereField.ReadFromXml(xr: IXmlNode);
|
|
begin
|
|
if xr.LocalName <> 'field' then raise Exception.Create('field tag expected');
|
|
Alias := xr.GetAttributeValue('alias', '');
|
|
fFieldName := VarToStr(xr.Value);
|
|
end;
|
|
|
|
procedure TDASelectWhereField.WriteToXml(sw: IXmlNode);
|
|
var
|
|
el: IXMLNode;
|
|
begin
|
|
el := sw.Add('field');
|
|
el.Value := fFieldName;
|
|
if fAlias <> '' then
|
|
el.AddAttribute('alias', fAlias);
|
|
end;
|
|
|
|
{ TDASelectWhereBuilder }
|
|
|
|
function TDASelectWhereBuilder.AddField(
|
|
aField: TDASelectWhereItem): Integer;
|
|
begin
|
|
Result := fFields.Add(aField);
|
|
end;
|
|
|
|
constructor TDASelectWhereBuilder.Create;
|
|
begin
|
|
inherited Create;
|
|
fFields := TList.Create;
|
|
end;
|
|
|
|
procedure TDASelectWhereBuilder.DeleteField(index: Integer);
|
|
begin
|
|
TDASelectWhereItem(fFields[index]).Free;
|
|
fFields.Delete(index);
|
|
end;
|
|
|
|
destructor TDASelectWhereBuilder.Destroy;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := fFields.Count -1 downto 0 do
|
|
TDASelectWhereItem(fFields[i]).Free;
|
|
fFields.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TDASelectWhereBuilder.GetCount: Integer;
|
|
begin
|
|
result := fFields.Count;
|
|
end;
|
|
|
|
function TDASelectWhereBuilder.GetItem(i: Integer): TDASelectWhereItem;
|
|
begin
|
|
result := TDASelectWhereItem(fFields[i]);
|
|
end;
|
|
|
|
function TDASelectWhereBuilder.ReadFromXml(xr: IXmlNode):TDAWhereExpression;
|
|
var
|
|
el: IXMLNode;
|
|
i: Integer;
|
|
sw: TDASelectWhereField;
|
|
begin
|
|
el := SelectNodeLocal(xr, 'select');
|
|
if el = nil then raise Exception.Create('"select" node expected');
|
|
fTableName := el.GetNodeValue('table', '');
|
|
el := SelectNodeLocal(el, 'fields');
|
|
if el <> nil then begin
|
|
for i := 0 to el.ChildrenCount -1 do begin
|
|
sw := TDASelectWhereField.Create(self);
|
|
fFields.Add(sw);
|
|
sw.ReadFromXml(el.Children[i]);
|
|
end;
|
|
end;
|
|
Result:= inherited ReadFromXml(xr);
|
|
end;
|
|
|
|
procedure TDASelectWhereBuilder.WriteToXml(sw: IXmlNode; const aExpression: TDAWhereExpression);
|
|
var
|
|
el: IXMLNode;
|
|
i: Integer;
|
|
begin
|
|
el := sw.Add('where');
|
|
el.Add('table').Value := fTableName;
|
|
el := el.Add('fields');
|
|
for i := 0 to fFields.Count -1 do
|
|
Fields[i].WriteToXml(el);
|
|
|
|
inherited WriteToXml(sw,aExpression);
|
|
end;
|
|
|
|
function ProcessDAWhereForUnions(aSourceTableID: Integer; var aDAWhereString: WideString): Boolean;
|
|
var
|
|
// 0 initial state
|
|
// 1 all OR
|
|
// 2 all AND
|
|
// 3 mixed
|
|
gFlag: Integer;
|
|
|
|
gFalseFound: Boolean;
|
|
gTrueFound: Boolean;
|
|
|
|
// Just replace TDAFieldExpression of the SourceTableName field to its real value
|
|
procedure ResolveSourceTableFieldExpression(var anExpression: TDAWhereExpression);
|
|
begin
|
|
if (SameText(TDAFieldExpression(anExpression).FieldName, def_SourceTableFieldName)) then
|
|
anExpression := TDAConstantExpression.Create(aSourceTableID, datInteger);
|
|
end;
|
|
|
|
procedure ProcessExpression(var aExpression: TDAWhereExpression);
|
|
var
|
|
lTempExpr: TDAWhereExpression;
|
|
begin
|
|
if aExpression = nil then Exit;
|
|
|
|
if aExpression is TDAFieldExpression then begin
|
|
ResolveSourceTableFieldExpression(aExpression);
|
|
end else
|
|
|
|
if aExpression is TDABinaryExpression then begin
|
|
|
|
lTempExpr := TDABinaryExpression(aExpression).Left;
|
|
ProcessExpression(lTempExpr);
|
|
TDABinaryExpression(aExpression).Left := lTempExpr;
|
|
|
|
lTempExpr := TDABinaryExpression(aExpression).Right;
|
|
ProcessExpression(lTempExpr);
|
|
TDABinaryExpression(aExpression).Right := lTempExpr;
|
|
|
|
end;
|
|
end;
|
|
|
|
// Returns:
|
|
// -1 unknown
|
|
// 0 false
|
|
// 1 true
|
|
function ScanExpressionIsTrueOrFalse(anExpression: TDAWhereExpression): integer;
|
|
var lBinExpr: TDABinaryExpression;
|
|
var lLeftValue, lRightValue: Variant;
|
|
var lResult : TVariantRelationship;
|
|
begin
|
|
result := -1;
|
|
lBinExpr := anExpression as TDABinaryExpression;
|
|
if not assigned(lBinExpr) then exit;
|
|
if not ((lBinExpr.Left is TDAConstantExpression) and (lBinExpr.Right is TDAConstantExpression)) then exit;
|
|
|
|
lLeftValue := (lBinExpr.Left as TDAConstantExpression).Value;
|
|
lRightValue := (lBinExpr.Right as TDAConstantExpression).Value;
|
|
|
|
lResult := VarCompareValue(lLeftValue, lRightValue);
|
|
|
|
if ((lBinExpr.Operator in [dboEqual, dboGreaterOrEqual, dboLessOrEqual]) and (lResult = vrEqual)) then
|
|
result := 1
|
|
else
|
|
if ((lBinExpr.Operator in [dboGreater, dboGreaterOrEqual]) and (lResult = vrGreaterThan)) then
|
|
result := 1
|
|
else
|
|
if ((lBinExpr.Operator in [dboLess, dboLessOrEqual]) and (lResult = vrLessThan)) then
|
|
result := 1
|
|
else
|
|
result := 0;
|
|
end;
|
|
|
|
// this sub proc goes throw all bin exp and operates with global variables
|
|
// declared in parent proc
|
|
procedure TestExpressionRecursive(anExpression: TDAWhereExpression);
|
|
var
|
|
lFound: Integer;
|
|
lInnerOp: TDABinaryOperator;
|
|
begin
|
|
if anExpression is TDABinaryExpression then begin
|
|
|
|
lInnerOp := TDABinaryExpression(anExpression).Operator;
|
|
case gFlag of
|
|
0: begin
|
|
if lInnerOp = dboOr then gFlag := 1;
|
|
if lInnerOp = dboAnd then gFlag := 2;
|
|
end;
|
|
1: begin
|
|
if lInnerOp = dboAnd then gFlag := 3;
|
|
end;
|
|
2: begin
|
|
if lInnerOp = dboOr then gFlag := 3;
|
|
end;
|
|
end;
|
|
if gFlag = 3 then exit;
|
|
|
|
lFound := ScanExpressionIsTrueOrFalse(anExpression);
|
|
case lFound of
|
|
-1:{Unknown} begin
|
|
TestExpressionRecursive(TDABinaryExpression(anExpression).Left);
|
|
TestExpressionRecursive(TDABinaryExpression(anExpression).Right);
|
|
end;
|
|
0: {found FALSE} begin
|
|
gFalseFound := true;
|
|
end;
|
|
1: {found TRUE} begin
|
|
gTrueFound := true;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// gFlag
|
|
// 0 initial state
|
|
// 1 all OR
|
|
// 2 all AND
|
|
// 3 mixed
|
|
|
|
// Rules I found
|
|
// If *ALL* binexp joined by "OR" and TRUE was found then get ALL records : -1
|
|
// If *ALL* binexp joined by "AND" and FALSE was found then get NONE records : 0
|
|
// All other cases need to apply where query : 1
|
|
function TestExpression(anExpression: TDAWhereExpression): Integer;
|
|
begin
|
|
// initialize
|
|
gFlag := 0;
|
|
gFalseFound := false;
|
|
gTrueFound := false;
|
|
result := 1; // apply query
|
|
|
|
TestExpressionRecursive(anExpression);
|
|
|
|
case gFlag of
|
|
|
|
0: begin
|
|
if gTrueFound then begin
|
|
result := -1;
|
|
exit;
|
|
end;
|
|
if gFalseFound then begin
|
|
result := 0;
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
1: begin
|
|
if gTrueFound then begin
|
|
result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
2: begin
|
|
if gFalseFound then begin
|
|
result := 0;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
var lTempExpr: TDAWhereExpression;
|
|
lResult : Integer;
|
|
begin
|
|
Result := True;
|
|
if aDAWhereString <> '' then
|
|
with TDAWhereBuilder.Create do try
|
|
Xml := aDAWhereString;
|
|
lTempExpr := Expression;
|
|
ProcessExpression(lTempExpr);
|
|
Expression := lTempExpr;
|
|
|
|
aDAWhereString := Xml;
|
|
lResult := TestExpression(Expression);
|
|
if lResult = -1 then aDAWhereString := '';
|
|
result := (0 <> lResult);
|
|
finally
|
|
free;
|
|
end;
|
|
end;
|
|
|
|
end.
|