987 lines
27 KiB
ObjectPascal
987 lines
27 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(anOwner: TDAWhereBuilder; aLeft, aRight: TDAWhereExpression; anOp: TDABinaryOperator); overload;
|
|
constructor Create(anOwner: TDAWhereBuilder); 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;
|
|
end;
|
|
|
|
TDAUnaryExpression = class(TDAWhereExpression)
|
|
private
|
|
fExpression: TDAWhereExpression;
|
|
fOperator: TDAUnaryOperator;
|
|
public
|
|
constructor Create(anOwner: TDAWhereBuilder; anExpression: TDAWhereExpression; anOp: TDAUnaryOperator); overload;
|
|
constructor Create(anOwner: TDAWhereBuilder); 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;
|
|
end;
|
|
|
|
TDAConstantExpression = class(TDAWhereExpression)
|
|
private
|
|
fType: TDADataType;
|
|
fValue: Variant;
|
|
public
|
|
class function SerializeObject(const v: Variant; dt: TDADataType): string;
|
|
class function DeserializeObject(const s: string; dt: TDADataType): Variant;
|
|
|
|
constructor Create(anOwner: TDAWhereBuilder; const aValue: Variant); overload;
|
|
constructor Create(anOwner: TDAWhereBuilder; const aValue: Variant; aType: TDADataType); overload;
|
|
constructor Create(anOwner: TDAWhereBuilder); overload;
|
|
|
|
property aType: TDADataType read fType write fType;
|
|
property Value: Variant read fValue write fValue;
|
|
|
|
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(anOwner: TDAWhereBuilder; const aValues: array of TDAWhereExpression); overload;
|
|
constructor Create(anOwner: TDAWhereBuilder); 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;
|
|
end;
|
|
|
|
TDAParameterExpression = class(TDAWhereExpression)
|
|
private
|
|
fParameterName: string;
|
|
public
|
|
constructor Create(anOwner: TDAWhereBuilder; const aParameterName: string); overload;
|
|
constructor Create(anOwner: TDAWhereBuilder); overload;
|
|
|
|
property ParameterName: string read fParameterName write fParameterName;
|
|
|
|
procedure ReadFromXml(xr: IXmlNode); override;
|
|
procedure WriteToXml(sw: IXmlNode); override;
|
|
end;
|
|
|
|
TDAFieldExpression = class(TDAWhereExpression)
|
|
private
|
|
fFieldName: string;
|
|
fTableName: string;
|
|
public
|
|
constructor Create(anOwner: TDAWhereBuilder; const aTableName, aFieldName: string); overload;
|
|
constructor Create(anOwner: TDAWhereBuilder); 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;
|
|
end;
|
|
|
|
TDANullExpression = class(TDAWhereExpression)
|
|
public
|
|
constructor Create(anOwner: TDAWhereBuilder);
|
|
|
|
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(anOwner: TDAWhereBuilder); overload;
|
|
constructor Create(anOwner: TDAWhereBuilder; const aName: string); overload;
|
|
constructor Create(anOwner: TDAWhereBuilder; 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;
|
|
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(AOwner:TDAWhereBuilder; AName: string): TDAWhereExpression;
|
|
|
|
type
|
|
TWhereFieldsArray = array of string;
|
|
|
|
function Where_ExtractFieldNames(const AWhereExpression: TDAWhereExpression): TWhereFieldsArray;
|
|
function Where_RemapFieldNames(const aXML: widestring; aMappings: TDAColumnMappingCollection): widestring;
|
|
|
|
implementation
|
|
|
|
uses Variants, TypInfo;
|
|
|
|
|
|
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): 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
|
|
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(AOwner:TDAWhereBuilder; AName: string): TDAWhereExpression;
|
|
begin
|
|
if AName = 'binaryoperation' then
|
|
Result := TDABinaryExpression.Create(aOwner)
|
|
else if AName = 'unaryoperation' then
|
|
Result := TDAUnaryExpression.Create(aOwner)
|
|
else if AName = 'constant' then
|
|
Result := TDAConstantExpression.Create(aOwner)
|
|
else if AName = 'list' then
|
|
Result := TDAListExpression.Create(aOwner)
|
|
else if AName = 'parameter' then
|
|
Result := TDAParameterExpression.Create(aOwner)
|
|
else if AName = 'field' then
|
|
Result := TDAFieldExpression.Create(aOwner)
|
|
else if AName = 'null' then
|
|
Result := TDANullExpression.Create(aOwner)
|
|
else if AName = 'macro' then
|
|
Result := TDAMacroExpression.Create(aOwner)
|
|
else
|
|
raise Exception.Create('Unknown element type: '+AName);
|
|
end;
|
|
|
|
{ TDABinaryExpression }
|
|
|
|
constructor TDABinaryExpression.Create(anOwner: TDAWhereBuilder; aLeft,
|
|
aRight: TDAWhereExpression; anOp: TDABinaryOperator);
|
|
begin
|
|
inherited Create(anOwner);
|
|
fLeft := aLeft;
|
|
fRight := aRight;
|
|
fOperator := anOp;
|
|
end;
|
|
|
|
constructor TDABinaryExpression.Create(anOwner: TDAWhereBuilder);
|
|
begin
|
|
inherited Create(anOwner);
|
|
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(Owner, xr.FirstChild);
|
|
Right := TDAWhereExpression.ParseExpression(Owner, xr.FirstChild.NextSibling);
|
|
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(anOwner: TDAWhereBuilder;
|
|
anExpression: TDAWhereExpression; anOp: TDAUnaryOperator);
|
|
begin
|
|
inherited Create(anOwner);
|
|
fExpression := anExpression;
|
|
fOperator := anOp;
|
|
end;
|
|
|
|
constructor TDAUnaryExpression.Create(anOwner: TDAWhereBuilder);
|
|
begin
|
|
inherited Create(anOwner);
|
|
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(Owner, xr.FirstChild);
|
|
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(anOwner: TDAWhereBuilder;
|
|
const aValue: Variant);
|
|
begin
|
|
inherited Create(anOwner);
|
|
fValue := aValue;
|
|
end;
|
|
|
|
constructor TDAConstantExpression.Create(anOwner: TDAWhereBuilder;
|
|
const aValue: Variant; aType: TDADataType);
|
|
begin
|
|
inherited Create(anOwner);
|
|
fValue := aValue;
|
|
fType := aType;
|
|
end;
|
|
|
|
constructor TDAConstantExpression.Create(anOwner: TDAWhereBuilder);
|
|
begin
|
|
inherited Create(anOwner);
|
|
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: 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: 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;
|
|
|
|
{ TDAListExpression }
|
|
|
|
procedure TDAListExpression.Add(aValue: TDAWhereExpression);
|
|
begin
|
|
FItems.Add(aValue);
|
|
end;
|
|
|
|
constructor TDAListExpression.Create(anOwner: TDAWhereBuilder;
|
|
const aValues: array of TDAWhereExpression);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
inherited Create(anOwner);
|
|
FItems := TList.Create;
|
|
for i := 0 to Length(aValues) -1 do
|
|
Add(aValues[i]);
|
|
end;
|
|
|
|
constructor TDAListExpression.Create(anOwner: TDAWhereBuilder);
|
|
begin
|
|
inherited Create(anOwner);
|
|
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(Owner, 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;
|
|
|
|
{ TDAParameterExpression }
|
|
|
|
constructor TDAParameterExpression.Create(anOwner: TDAWhereBuilder;
|
|
const aParameterName: string);
|
|
begin
|
|
inherited Create(anOwner);
|
|
fParameterName := aParameterName;
|
|
end;
|
|
|
|
constructor TDAParameterExpression.Create(anOwner: TDAWhereBuilder);
|
|
begin
|
|
inherited Create(anOwner);
|
|
end;
|
|
|
|
procedure TDAParameterExpression.ReadFromXml(xr: IXmlNode);
|
|
begin
|
|
fParameterName := xr.Value;
|
|
end;
|
|
|
|
procedure TDAParameterExpression.WriteToXml(sw: IXmlNode);
|
|
var
|
|
el: IXmlNode;
|
|
begin
|
|
el := sw.Add('parameter');
|
|
el.Value := fParameterName;
|
|
end;
|
|
|
|
{ TDAFieldExpression }
|
|
|
|
constructor TDAFieldExpression.Create(anOwner: TDAWhereBuilder;
|
|
const aTableName, aFieldName: string);
|
|
begin
|
|
inherited Create(anOwner);
|
|
fTableName := aTableName;
|
|
fFieldName := aFieldName;
|
|
end;
|
|
|
|
constructor TDAFieldExpression.Create(anOwner: TDAWhereBuilder);
|
|
begin
|
|
inherited Create(anOwner);
|
|
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.WriteToXml(sw: IXmlNode);
|
|
var
|
|
el: IXMLNode;
|
|
begin
|
|
el := sw.Add('field');
|
|
el.Value := fFieldName;
|
|
if fTableName <> '' then
|
|
el.AddAttribute('tablename', fTableName);
|
|
end;
|
|
|
|
{ TDANullExpression }
|
|
|
|
constructor TDANullExpression.Create(anOwner: TDAWhereBuilder);
|
|
begin
|
|
inherited Create(anOwner);
|
|
end;
|
|
|
|
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(anOwner: TDAWhereBuilder);
|
|
begin
|
|
inherited Create(anOwner);
|
|
FItems := TList.Create;
|
|
end;
|
|
|
|
constructor TDAMacroExpression.Create(anOwner: TDAWhereBuilder;
|
|
const aName: string);
|
|
begin
|
|
inherited Create(anOwner);
|
|
FItems := TList.Create;
|
|
fName := aName;
|
|
end;
|
|
|
|
constructor TDAMacroExpression.Create(anOwner: TDAWhereBuilder;
|
|
const aName: string; const aValues: array of TDAWhereExpression);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
inherited Create(anOwner);
|
|
FItems := TList.Create;
|
|
fName := 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(Owner, 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;
|
|
|
|
{ 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;
|
|
|
|
end.
|