david
2824855ea7
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 - Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
6167 lines
187 KiB
ObjectPascal
6167 lines
187 KiB
ObjectPascal
unit uDAInterfaces;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ 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
|
|
Classes, DB, uROClasses, SysUtils, uDASupportClasses,
|
|
DataAbstract3_Intf, DataAbstract4_Intf, uROXmlIntf, FMTBcd;
|
|
|
|
const
|
|
func_GetDriverObject = 'GetDriverObject';
|
|
ClientFieldPrefix = '##';
|
|
|
|
type
|
|
TDAObjecttype = (dotTable,dotProcedure, dotView);
|
|
TDAChangeType = (ctInsert, ctUpdate, ctDelete);
|
|
TDAChangeTypes = set of TDAChangeType;
|
|
TDAChangeStatus = (csPending, csResolved, csFailed);
|
|
|
|
TDASQLCondition = (cEqual,
|
|
cDifferent,
|
|
cMajor,
|
|
cLess,
|
|
cMajorOrEqual,
|
|
cLessOrEqual,
|
|
cLike,
|
|
cIn,
|
|
cContaining,
|
|
cIsNull,
|
|
cIsNotNull);
|
|
|
|
TDASQLOperator = (opAND,
|
|
opOR,
|
|
opNOT);
|
|
|
|
TDADefaultOperator = (doNone, doAnd, doOr);
|
|
|
|
TDABlobType = (dabtUnknown, dabtBlob, dabtMemo, dabtOraBlob, dabtOraClob, dabtGraphic, dabtTypedBinary);
|
|
|
|
TDAJoinType = (jtInner, jtLeftOuter, jtRightOuter, jtFullOuter, jtCross);
|
|
|
|
TDARelationshipType = (rtForeignKey, rtMasterDetail);
|
|
|
|
const
|
|
StrSQLCondition: array[TDASQLCondition] of string = (
|
|
'=', '<>', '>', '<', '>=', '<=', 'LIKE', 'IN', 'CONTAINING', 'IS NULL', 'IS NOT NULL');
|
|
|
|
StrSQLOperator: array[TDASQLOperator] of string = (
|
|
'AND', 'OR', 'NOT');
|
|
|
|
BlobTypeMappings : array[TDABlobType] of TFieldType =
|
|
(ftBlob, ftBlob, ftMemo, ftOraBlob, ftOraClob, ftGraphic,ftTypedBinary);
|
|
|
|
type
|
|
{ Forwards }
|
|
IDADriver = interface;
|
|
IDAStoredProcedure = interface;
|
|
IDADataset = interface;
|
|
IDAConnection = interface;
|
|
IDASQLCommand = interface;
|
|
IDADataDictionary = interface;
|
|
IDATestableObject = interface;
|
|
IDAConnectionPool = interface;
|
|
IDAConnectionManager = interface;
|
|
|
|
TDACustomField = class;
|
|
TDADataset = class;
|
|
|
|
{ Driver access }
|
|
TDAGetDriverObject = function: IDADriver; stdcall;
|
|
|
|
//TDriverErrorEvent = procedure(anErrorCode : integer; const anErrorMessage : string) of object;
|
|
|
|
EDADriverLoadException = class(Exception)
|
|
private
|
|
fErrorCode: integer;
|
|
|
|
public
|
|
constructor Create(anErrorCode: integer; const anErrorMessage: string);
|
|
|
|
property ErrorCode: integer read fErrorCode;
|
|
end;
|
|
EDADriverLoadExceptionClass = class of EDADriverLoadException;
|
|
TDADataAbstractException = EDADriverLoadException;
|
|
TDADataAbstractExceptionClass = class of TDADataAbstractException;
|
|
|
|
{ Misc. types }
|
|
TDASQLStatementType = (stSQL, stStoredProcedure, stAutoSQL);
|
|
|
|
TDACommandType = (cmdInsert, cmdDelete, cmdUpdate);
|
|
TDACommandTypes = set of TDACommandType;
|
|
|
|
TDAPersistFormat = (pfBinary, pfXML);
|
|
|
|
TDAParamType = (daptUnknown, daptInput, daptOutput, daptInputOutput, daptResult);
|
|
|
|
TDADataType = (datUnknown,
|
|
datString,
|
|
datDateTime,
|
|
datFloat,
|
|
datCurrency,
|
|
datAutoInc,
|
|
datInteger,
|
|
datLargeInt,
|
|
datBoolean,
|
|
datMemo,
|
|
datBlob,
|
|
datWideString,
|
|
datWideMemo,
|
|
datLargeAutoInc,
|
|
datByte,
|
|
datShortInt,
|
|
datWord,
|
|
datSmallInt,
|
|
datCardinal,
|
|
datLargeUInt,
|
|
datGuid,
|
|
datXml,
|
|
datDecimal,
|
|
datSingleFloat);
|
|
|
|
{ Forwards }
|
|
TDASQLCommand = class;
|
|
TDAStatementCollection = class;
|
|
TDASQLCommandCollection = class;
|
|
TDAParamCollection = class;
|
|
TDAJoinConditionCollection = class;
|
|
TDAUnionSourceTableCollection = class;
|
|
|
|
{ TDAColumnMapping }
|
|
TDAColumnMapping = class(TInterfacedCollectionItem)
|
|
private
|
|
fDatasetField: string;
|
|
fTableField: string;
|
|
fSQLOrigin: string;
|
|
function GetSQLOrigin: string;
|
|
function StoreSQLOrigin: Boolean;
|
|
procedure SetDatasetField(const Value: string);
|
|
procedure SetSQLOrigin(const Value: string);
|
|
procedure SetTableField(const Value: string);
|
|
|
|
public
|
|
procedure Assign(aSource: TPersistent); override;
|
|
procedure AssignFieldMapping(aSource: TPersistent);
|
|
|
|
published
|
|
property DatasetField: string read fDatasetField write SetDatasetField;
|
|
property TableField: string read fTableField write SetTableField;
|
|
property SQLOrigin: string read GetSQLOrigin write SetSQLOrigin stored StoreSQLOrigin;
|
|
end;
|
|
|
|
{ TDAColumnMappingCollection }
|
|
TDAColumnMappingCollection = class(TSearcheableCollection)
|
|
private
|
|
function GetColumnMappings(Index: integer): TDAColumnMapping;
|
|
procedure SetColumnMappings(Index: integer;
|
|
const Value: TDAColumnMapping);
|
|
|
|
protected
|
|
function SetItemName(anItem: TCollectionItem; const aName: string): string; override;
|
|
function GetItemName(anItem: TCollectionItem): string; override;
|
|
|
|
public
|
|
constructor Create(aOwner: TPersistent);
|
|
|
|
procedure AssignColumnMapping(aSource: TPersistent);
|
|
|
|
function Add: TDAColumnMapping; reintroduce;
|
|
function FindMappingByDatasetField(const aDatasetField: string): TDAColumnMapping;
|
|
function MappingByDatasetField(const aDatasetField: string): TDAColumnMapping;
|
|
function MappingByTableField(const aTableField: string): TDAColumnMapping;
|
|
|
|
property ColumnMappings[Index: integer]: TDAColumnMapping read GetColumnMappings write SetColumnMappings; default;
|
|
end;
|
|
|
|
{ TDAStatement }
|
|
TDAStatement = class(TCollectionItem)
|
|
private
|
|
fSQL: string;
|
|
fStatementType: TDASQLStatementType;
|
|
fConnection: string;
|
|
fColumnMappings: TDAColumnMappingCollection;
|
|
fTargetTable: string;
|
|
fName: string;
|
|
fConnectionType: string;
|
|
fDefault: boolean;
|
|
|
|
procedure SetColumnMappings(const Value: TDAColumnMappingCollection);
|
|
function GetStatementCollection: TDAStatementCollection;
|
|
procedure SetSQL(const Value: string);
|
|
function GetNeedsParams: boolean;
|
|
function StoreSQL: Boolean;
|
|
|
|
protected
|
|
|
|
public
|
|
constructor Create(Collection: TCollection); override;
|
|
destructor Destroy; override;
|
|
|
|
procedure Assign(aSource: TPersistent); override;
|
|
|
|
property StatementCollection: TDAStatementCollection read GetStatementCollection;
|
|
property NeedsParams: boolean read GetNeedsParams;
|
|
published
|
|
property Connection: string read fConnection write fConnection;
|
|
property ConnectionType: string read fConnectionType write fConnectionType;
|
|
property Default: boolean read fDefault write fDefault default false;
|
|
property TargetTable: string read fTargetTable write fTargetTable;
|
|
property Name: string read fName write fName;
|
|
property SQL: string read fSQL write SetSQL stored StoreSQL;
|
|
property StatementType: TDASQLStatementType read fStatementType write fStatementType;
|
|
property ColumnMappings: TDAColumnMappingCollection read fColumnMappings write SetColumnMappings;
|
|
end;
|
|
|
|
{ TDAStatementCollection }
|
|
TDAStatementCollection = class(TSearcheableCollection)
|
|
private
|
|
fSQLCommand: TDASQLCommand;
|
|
|
|
function GetStatements(Index: integer): TDAStatement;
|
|
procedure SetStatements(Index: integer; const Value: TDAStatement);
|
|
|
|
protected
|
|
function SetItemName(anItem: TCollectionItem; const aName: string): string; override;
|
|
function GetItemName(anItem: TCollectionItem): string; override;
|
|
|
|
public
|
|
constructor Create(aOwner: TPersistent; aSQLCommand: TDASQLCommand);
|
|
|
|
function Add: TDAStatement; reintroduce;
|
|
function FindItem(const aName: string; const aStatementName: string=''; const aConnectionType: string = ''; aReturnDefault: Boolean = false): TDAStatement; reintroduce;
|
|
|
|
function StatementByName(const aName: string): TDAStatement;
|
|
|
|
property SQLCommand: TDASQLCommand read fSQLCommand;
|
|
property Statements[Index: integer]: TDAStatement read GetStatements write SetStatements; default;
|
|
end;
|
|
|
|
{ TDAUpdateRule }
|
|
TDAUpdateFailureBehavior = (fbRaiseException, fbLogAndContinue, fbIgnoreAndContinue);
|
|
|
|
TDAUpdateRule = class(TCollectionItem)
|
|
private
|
|
fDatasetName: string;
|
|
fName: string;
|
|
fFailureBehavior: TDAUpdateFailureBehavior;
|
|
fDoInsert: boolean;
|
|
fDoUpdate: boolean;
|
|
fDoDelete: boolean;
|
|
function GetChangeTypes: TDAChangeTypes;
|
|
|
|
protected
|
|
function GetDisplayName : string; override;
|
|
|
|
public
|
|
constructor Create(aCollection : TCollection); override;
|
|
|
|
procedure Assign(aSource: TPersistent); override;
|
|
|
|
property ChangeTypes: TDAChangeTypes read GetChangeTypes;
|
|
|
|
published
|
|
property Name : string read fName write fName;
|
|
property DoUpdate : boolean read fDoUpdate write fDoUpdate default True;
|
|
property DoInsert : boolean read fDoInsert write fDoInsert default True;
|
|
property DoDelete : boolean read fDoDelete write fDoDelete default True;
|
|
property DatasetName : string read fDatasetName write fDatasetName;
|
|
|
|
property FailureBehavior : TDAUpdateFailureBehavior read fFailureBehavior write fFailureBehavior;
|
|
end;
|
|
|
|
{ TDAUpdateRuleCollection }
|
|
TDAUpdateRuleCollection = class(TSearcheableCollection)
|
|
private
|
|
function GetUpdateRules(Index: integer): TDAUpdateRule;
|
|
protected
|
|
public
|
|
constructor Create(aOwner : TComponent);
|
|
|
|
function Add: TDAUpdateRule; reintroduce;
|
|
function UpdateRuleByName(const aName : string) : TDAUpdateRule;
|
|
|
|
property UpdateRules[Index : integer] : TDAUpdateRule read GetUpdateRules; default;
|
|
end;
|
|
|
|
{ TDABaseField }
|
|
TDABaseField = class(TInterfacedCollectionItem)
|
|
private
|
|
fDictionaryEntry: string;
|
|
fSize: integer;
|
|
fDescription,
|
|
fName: string;
|
|
fDataType: TDADataType;
|
|
fValue: Variant;
|
|
fBlobType: TDABlobType;
|
|
fGeneratorName : string;
|
|
FDecimalPrecision: Integer;
|
|
FDecimalScale: Integer;
|
|
//procedure FixSize;
|
|
|
|
protected
|
|
function MergeDatadictionaries: Boolean;
|
|
function GetBlobSize: Integer; virtual;
|
|
function GetName: string; virtual;
|
|
procedure SetName(const Value: string); virtual;
|
|
function GetDataType: TDADataType;
|
|
procedure SetDataType(Value: TDADataType);
|
|
function GetSize: integer;
|
|
procedure SetSize(Value: integer);
|
|
function GetValue: Variant; virtual;
|
|
procedure SetValue(const aValue: Variant); virtual;
|
|
function GetDescription: string;
|
|
procedure SetDescription(const Value: string);
|
|
function StoreBlobType : boolean;
|
|
function GetBlobType: TDABlobType;
|
|
procedure SetBlobType(const Value: TDABlobType); virtual;
|
|
function GetGeneratorName: string;
|
|
procedure SetGeneratorName(const aValue: string);
|
|
|
|
function GetAsBoolean: boolean; virtual;
|
|
function GetAsCurrency: currency; virtual;
|
|
function GetAsDateTime: TDateTime; virtual;
|
|
function GetAsFloat: double; virtual;
|
|
function GetAsInteger: integer; virtual;
|
|
function GetAsString: string; virtual;
|
|
function GetAsVariant: variant; virtual;
|
|
function GetAsLargeInt: int64; virtual;
|
|
function GetAsWideString: Widestring; virtual;
|
|
function GetAsByte: Byte; virtual;
|
|
function GetAsCardinal: Cardinal; virtual;
|
|
function GetAsDecimal: TBcd; virtual;
|
|
function GetAsGuid: TGUID; virtual;
|
|
function GetAsLargeUInt: Int64; virtual;
|
|
function GetAsShortInt: ShortInt; virtual;
|
|
function GetAsSingle: Single; virtual;
|
|
function GetAsSmallInt: SmallInt; virtual;
|
|
function GetAsWord: Word; virtual;
|
|
function GetAsXml: IXMLNode; virtual;
|
|
procedure SetAsByte(const Value: Byte); virtual;
|
|
procedure SetAsCardinal(const Value: Cardinal); virtual;
|
|
procedure SetAsDecimal(const Value: TBcd); virtual;
|
|
procedure SetAsGuid(const Value: TGUID); virtual;
|
|
procedure SetAsLargeUInt(const Value: Int64); virtual;
|
|
procedure SetAsShortInt(const Value: ShortInt); virtual;
|
|
procedure SetAsSingle(const Value: Single); virtual;
|
|
procedure SetAsSmallInt(const Value: SmallInt); virtual;
|
|
procedure SetAsWord(const Value: Word); virtual;
|
|
procedure SetAsXml(const Value: IXMLNode); virtual;
|
|
procedure SetAsBoolean(const aValue: boolean); virtual;
|
|
procedure SetAsCurrency(const aValue: currency); virtual;
|
|
procedure SetAsDateTime(const aValue: TDateTime); virtual;
|
|
procedure SetAsString(const aValue: string); virtual;
|
|
procedure SetAsVariant(const aValue: variant); virtual;
|
|
procedure SetAsFloat(const aValue: double); virtual;
|
|
procedure SetAsInteger(const aValue: integer); virtual;
|
|
procedure SetAsLargeInt(const aValue: Int64); virtual;
|
|
procedure SetAsWideString(const aValue: Widestring); virtual;
|
|
function GetIsNull: boolean; virtual;
|
|
|
|
function StoreDataType: Boolean;
|
|
function StoreDescription: Boolean;
|
|
function StoreGeneratorName: Boolean;
|
|
function StoreSize: Boolean;
|
|
function StoreDecimalPrecision: Boolean;
|
|
function StoreDecimalScale: Boolean;
|
|
|
|
function GetDictionaryEntry: string;
|
|
procedure SetDictionaryEntry(const Value: string);
|
|
function FindDictionaryField: TDACustomField;
|
|
function GetDictionaryField: TDACustomField;
|
|
|
|
// Internal
|
|
function GetDisplayName: string; override;
|
|
procedure SetDisplayName(const Value: string); override;
|
|
function GetDecimalPrecision: Integer; virtual;
|
|
procedure SetDecimalPrecision(const Value: Integer);virtual;
|
|
function GetDecimalScale: Integer;virtual;
|
|
procedure SetDecimalScale(const Value: Integer);virtual;
|
|
function IsCompatibleV4: boolean; virtual;
|
|
public
|
|
property Value: Variant read GetValue write SetValue;
|
|
|
|
procedure Assign(Source: TPersistent); override;
|
|
procedure AssignField(Source: TDABaseField); virtual;
|
|
|
|
function HasValidDictionaryField: Boolean;
|
|
|
|
procedure Clear;
|
|
|
|
function GetNamePath: string; override;
|
|
|
|
property AsBoolean: boolean read GetAsBoolean write SetAsBoolean;
|
|
property AsCurrency: currency read GetAsCurrency write SetAsCurrency;
|
|
property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime; //null->0
|
|
property AsFloat: double read GetAsFloat write SetAsFloat; //null->0
|
|
property AsInteger: integer read GetAsInteger write SetAsInteger; //null->0
|
|
property AsString: string read GetAsString write SetAsString; //null->''
|
|
property AsVariant: variant read GetAsVariant write SetAsVariant;
|
|
property AsLargeInt: Int64 read GetAsLargeInt write SetAsLargeInt;
|
|
property AsWideString: WideString read GetAsWideString write SetAsWideString;
|
|
property BlobSize: Integer read GetBlobSize;
|
|
property IsNull: boolean read GetIsNull;
|
|
property AsByte: Byte read GetAsByte write SetAsByte;
|
|
property AsShortInt: ShortInt read GetAsShortInt write SetAsShortInt;
|
|
property AsWord: Word read GetAsWord write SetAsWord;
|
|
property AsSmallInt: SmallInt read GetAsSmallInt write SetAsSmallInt;
|
|
property AsCardinal: Cardinal read GetAsCardinal write SetAsCardinal;
|
|
property AsLargeUInt: Int64 read GetAsLargeUInt write SetAsLargeUInt;
|
|
property AsGuid: TGUID read GetAsGuid write SetAsGuid;
|
|
property AsDecimal: TBcd read GetAsDecimal write SetAsDecimal;
|
|
property AsXml: IXMLNode read GetAsXml write SetAsXml;
|
|
property AsSingle: Single read GetAsSingle write SetAsSingle;
|
|
|
|
property DictionaryEntry: string read GetDictionaryEntry write SetDictionaryEntry;
|
|
published
|
|
property Name: string read GetName write SetName;
|
|
property DataType: TDADataType read GetDataType write SetDataType default datUnknown;
|
|
property Size: integer read GetSize write SetSize default 0;
|
|
property Description: string read GetDescription write SetDescription;
|
|
property BlobType: TDABlobType read GetBlobType write SetBlobType default dabtUnknown;
|
|
property GeneratorName : string read GetGeneratorName write SetGeneratorName;
|
|
property DecimalPrecision: Integer read GetDecimalPrecision write SetDecimalPrecision stored StoreDecimalPrecision;
|
|
property DecimalScale: Integer read GetDecimalScale write SetDecimalScale stored StoreDecimalScale;
|
|
end;
|
|
|
|
{ TDACustomField }
|
|
TDAFieldNotifyEvent = procedure(Sender: TDACustomField) of object;
|
|
TDAFieldGetTextEvent = procedure(Sender: TDACustomField; var Text: string; DisplayText: boolean) of object;
|
|
TDAFieldSetTextEvent = procedure(Sender: TDACustomField; const Text: string) of object;
|
|
|
|
TDACustomFieldCollection = class;
|
|
|
|
TDACustomField = class(TDABaseField)
|
|
private
|
|
fField: TField;
|
|
fTableField: string;
|
|
fCustomAttributes: TStringList;
|
|
|
|
fRequired: boolean;
|
|
fInPrimaryKey: boolean;
|
|
fRegExpression: string;
|
|
fDefaultValue: string;
|
|
fDisplayWidth: integer;
|
|
fDisplayLabel: string;
|
|
fReadOnly: boolean;
|
|
fVisible: boolean;
|
|
fEditMask: string;
|
|
fLogChanges: boolean;
|
|
fCalculated: boolean;
|
|
fOnChange: TDAFieldNotifyEvent;
|
|
fOnValidate: TDAFieldNotifyEvent;
|
|
fDisplayFormat: string;
|
|
fBusinessClassID: string;
|
|
fAlignment : TAlignment;
|
|
fEditFormat : string;
|
|
fLookupCache: boolean;
|
|
fLookupKeyFields: string;
|
|
fLookupResultField: string;
|
|
fKeyFields: string;
|
|
fLookupSource: TDataSource;
|
|
fLookup: boolean;
|
|
fServerAutoRefresh: boolean;
|
|
fSQLOrigin: string;
|
|
fServerCalculated: Boolean;
|
|
fExpression: string;
|
|
|
|
function GetDisplayLabel: string;
|
|
|
|
function StoreDisplayLabel: Boolean;
|
|
|
|
function StoreProperties : boolean;
|
|
|
|
function GetDefaultValue: string;
|
|
function GetDisplayWidth: integer;
|
|
function GetEditMask: string;
|
|
function GetReadOnly: boolean;
|
|
function GetVisible: boolean;
|
|
//procedure SetBusinessRulesID(const Value: string);
|
|
//function GetBusinessRulesID: string;
|
|
function GetDisplayFormat: string;
|
|
function GetAlignment: TAlignment;
|
|
function GetEditFormat: string;
|
|
procedure SetAlignment(const Value: TAlignment);
|
|
procedure SetEditFormat(const Value: string);
|
|
|
|
procedure SetKeyFields(const Value: string);
|
|
procedure SetLookupCache(const Value: boolean);
|
|
procedure SetLookupKeyFields(const Value: string);
|
|
procedure SetLookupResultField(const Value: string);
|
|
procedure SetLookupSource(const Value: TDataSource);
|
|
procedure SetCalculated(const Value: boolean);
|
|
procedure SetLookup(const Value: boolean);
|
|
function GetFieldCollection: TDACustomFieldCollection;
|
|
{function GetNotNull: boolean;
|
|
procedure SetNotNull(const Value: boolean);}
|
|
function GetServerAutoRefresh: boolean;
|
|
procedure SetServerAutoRefresh(const Value: boolean);
|
|
function GetLogChanges: boolean;
|
|
function GetOldValue: Variant;
|
|
function GetSQLOrigin: string;
|
|
function GetBusinessClassID: string;
|
|
procedure SetBusinessClassID(const Value: string);
|
|
procedure SetServerCalculated(const Value: Boolean);
|
|
procedure SetExpression(const Value: string);
|
|
function StoredServerCalculated: Boolean;
|
|
function StoredExpression: Boolean;
|
|
|
|
protected
|
|
function GetOwner: TPersistent; override;
|
|
|
|
procedure SetName(const Value: string); override;
|
|
|
|
function GetInPrimaryKey: boolean;
|
|
function GetRegExpression: string;
|
|
function GetRequired: boolean;
|
|
procedure SetInPrimaryKey(const Value: boolean);
|
|
procedure SetRegExpression(const Value: string);
|
|
function GetBlobSize: Integer; override;
|
|
function GetValue: Variant; override;
|
|
procedure SetValue(const Value: Variant); override;
|
|
function GetTableField: string;
|
|
procedure SetTableField(const Value: string);
|
|
function GetCustomAttributes: TStrings;
|
|
procedure SetCustomAttributes(const Value: TStrings);
|
|
procedure SetDisplayFormat(const Value: string);
|
|
procedure SetBlobType(const Value: TDABlobType); override;
|
|
|
|
procedure SetRequired(const aValue: boolean);
|
|
procedure SetDisplayLabel(const aValue: string);
|
|
procedure SetVisible(const aValue: boolean);
|
|
procedure SetDisplayWidth(const aValue: integer);
|
|
procedure SetEditMask(const aValue: string);
|
|
procedure SetReadOnly(const aValue: boolean);
|
|
|
|
// Event hooks
|
|
procedure InternalOnChange(Sender: TField);
|
|
procedure InternalOnValidate(Sender: TField);
|
|
|
|
function GetAsBoolean: boolean; override;
|
|
function GetAsCurrency: currency; override;
|
|
function GetAsDateTime: TDateTime; override;
|
|
function GetAsFloat: double; override;
|
|
function GetAsInteger: integer; override;
|
|
function GetAsString: string; override;
|
|
function GetAsVariant: variant; override;
|
|
function GetAsLargeInt: int64; override;
|
|
function GetAsWideString: Widestring; override;
|
|
function GetAsByte: Byte; override;
|
|
function GetAsCardinal: Cardinal; override;
|
|
function GetAsDecimal: TBcd; override;
|
|
function GetAsGuid: TGUID; override;
|
|
function GetAsLargeUInt: Int64; override;
|
|
function GetAsShortInt: ShortInt; override;
|
|
function GetAsSingle: Single; override;
|
|
function GetAsSmallInt: SmallInt; override;
|
|
function GetAsWord: Word; override;
|
|
function GetAsXml: IXMLNode; override;
|
|
procedure SetAsByte(const Value: Byte); override;
|
|
procedure SetAsCardinal(const Value: Cardinal); override;
|
|
procedure SetAsDecimal(const Value: TBcd); override;
|
|
procedure SetAsGuid(const Value: TGUID); override;
|
|
procedure SetAsLargeUInt(const Value: Int64); override;
|
|
procedure SetAsShortInt(const Value: ShortInt); override;
|
|
procedure SetAsSingle(const Value: Single); override;
|
|
procedure SetAsSmallInt(const Value: SmallInt); override;
|
|
procedure SetAsWord(const Value: Word); override;
|
|
procedure SetAsXml(const Value: IXMLNode); override;
|
|
procedure SetAsBoolean(const aValue: boolean); override;
|
|
procedure SetAsCurrency(const aValue: currency); override;
|
|
procedure SetAsDateTime(const aValue: TDateTime); override;
|
|
procedure SetAsString(const aValue: string); override;
|
|
procedure SetAsVariant(const aValue: variant); override;
|
|
procedure SetAsFloat(const aValue: double); override;
|
|
procedure SetAsInteger(const aValue: integer); override;
|
|
procedure SetAsLargeInt(const aValue: Int64); override;
|
|
procedure SetAsWideString(const aValue: Widestring); override;
|
|
function GetIsNull: boolean; override;
|
|
function GetDecimalPrecision: Integer; override;
|
|
procedure SetDecimalPrecision(const Value: Integer);override;
|
|
function GetDecimalScale: Integer;override;
|
|
procedure SetDecimalScale(const Value: Integer);override;
|
|
function IsCompatibleV4: boolean; override;
|
|
public
|
|
constructor Create(Collection: TCollection); override;
|
|
destructor Destroy; override;
|
|
|
|
function GetNamePath: string; override;
|
|
|
|
procedure Bind(aField: TField);
|
|
procedure Unbind;
|
|
|
|
procedure SaveToStream(const aStream: IROStream); overload;
|
|
procedure LoadFromStream(const aStream: IROStream); overload;
|
|
procedure SaveToStream(const aStream: TStream); overload;
|
|
procedure LoadFromStream(const aStream: TStream); overload;
|
|
procedure SaveToFile(const aFileName: string);
|
|
procedure LoadFromFile(const aFileName: string);
|
|
|
|
property FieldCollection : TDACustomFieldCollection read GetFieldCollection;
|
|
|
|
procedure FocusControl;
|
|
|
|
property TableField: string read GetTableField write SetTableField;
|
|
property SQLOrigin: string read GetSQLOrigin write fSQLOrigin;
|
|
|
|
procedure Assign(Source: TPersistent); override;
|
|
procedure AssignField(Source: TDABaseField); override;
|
|
|
|
property OldValue : Variant read GetOldValue;
|
|
property BindedField: TField read FField;
|
|
public
|
|
property OnChange: TDAFieldNotifyEvent read fOnChange write fOnChange;
|
|
property OnValidate: TDAFieldNotifyEvent read fOnValidate write fOnValidate;
|
|
|
|
property InPrimaryKey: boolean read GetInPrimaryKey write SetInPrimaryKey default False;
|
|
|
|
property Calculated: boolean read fCalculated write SetCalculated default False;
|
|
property Expression: string read fExpression write SetExpression stored StoredExpression;
|
|
property ServerCalculated: Boolean read fServerCalculated write SetServerCalculated stored StoredServerCalculated default False;
|
|
property Lookup : boolean read fLookup write SetLookup default False;
|
|
|
|
property LookupSource : TDataSource read fLookupSource write SetLookupSource;
|
|
property LookupKeyFields : string read fLookupKeyFields write SetLookupKeyFields;
|
|
property LookupResultField : string read fLookupResultField write SetLookupResultField;
|
|
property KeyFields : string read fKeyFields write SetKeyFields;
|
|
property LookupCache : boolean read fLookupCache write SetLookupCache default False;
|
|
|
|
published
|
|
|
|
property LogChanges: boolean read GetLogChanges write fLogChanges stored StoreProperties default true;
|
|
|
|
property RegExpression: string read GetRegExpression write SetRegExpression stored StoreProperties;
|
|
property DefaultValue: string read GetDefaultValue write fDefaultValue stored StoreProperties;
|
|
property Required: boolean read GetRequired write SetRequired stored StoreProperties default FALSE;
|
|
property DisplayWidth: integer read GetDisplayWidth write SetDisplayWidth stored StoreProperties default 0;
|
|
property DisplayLabel: string read GetDisplayLabel write SetDisplayLabel stored StoreDisplayLabel;
|
|
property EditMask: string read GetEditMask write SetEditMask stored StoreProperties;
|
|
property Visible: boolean read GetVisible write SetVisible stored StoreProperties default TRUE;
|
|
property ReadOnly: boolean read GetReadOnly write SetReadOnly stored StoreProperties default FALSE;
|
|
property CustomAttributes: TStrings read GetCustomAttributes write SetCustomAttributes stored StoreProperties;
|
|
property DisplayFormat: string read GetDisplayFormat write SetDisplayFormat stored StoreProperties;
|
|
//property BusinessRulesID : string read GetBusinessRulesID write SetBusinessRulesID stored StoreProperties;
|
|
property BusinessClassID : string read GetBusinessClassID write SetBusinessClassID stored StoreProperties;
|
|
property EditFormat : string read GetEditFormat write SetEditFormat stored StoreProperties;
|
|
property Alignment : TAlignment read GetAlignment write SetAlignment stored StoreProperties default taLeftJustify;
|
|
property ServerAutoRefresh : boolean read GetServerAutoRefresh write SetServerAutoRefresh default FALSE;
|
|
end;
|
|
|
|
TDAField = class(TDACustomField)
|
|
protected
|
|
function GetDisplayName: string; override;
|
|
published
|
|
property DictionaryEntry;
|
|
|
|
property InPrimaryKey;
|
|
property Calculated;
|
|
property Expression;
|
|
property ServerCalculated;
|
|
|
|
property OnChange;
|
|
property OnValidate;
|
|
|
|
property Lookup;
|
|
|
|
property LookupSource;
|
|
property LookupKeyFields;
|
|
property LookupResultField;
|
|
property KeyFields;
|
|
property LookupCache;
|
|
end;
|
|
|
|
TDADataDictionaryField = class(TDACustomField)
|
|
end;
|
|
|
|
TDAFieldClass = class of TDACustomField;
|
|
|
|
{ TDACustomFieldCollection }
|
|
TDACustomFieldCollection = class(TSearcheableInterfacedCollection)
|
|
private
|
|
fDataDictionary: IDADataDictionary;
|
|
fFieldEventsDisabled: boolean;
|
|
fFieldBeforeUpdate,
|
|
fFieldAfterUpdate: TDAFieldNotifyEvent;
|
|
fIsCompatibleV4: boolean;
|
|
function GetFields(Index: integer): TDACustomField;
|
|
procedure SetFields(Index: integer; const Value: TDACustomField);
|
|
public
|
|
constructor Create(aOwner: TPersistent; aFieldClass: TDAFieldClass);
|
|
|
|
procedure Bind(aDataset: TDataset);
|
|
procedure Unbind;
|
|
|
|
property FieldEventsDisabled:boolean read fFieldEventsDisabled write fFieldEventsDisabled default false;
|
|
|
|
function Add: TDAField; reintroduce; overload;
|
|
function Add(const aName: string; aType: TDADataType; aSize: integer = 0): TDACustomField; overload;
|
|
|
|
procedure Assign(Source: TPersistent); override;
|
|
procedure AssignFieldCollection(Source: TDACustomFieldCollection);
|
|
|
|
function FieldByName(const aName: string): TDACustomField;
|
|
function FindField(const aName: string): TDACustomField;
|
|
|
|
property DataDictionary: IDADataDictionary read fDataDictionary write fDataDictionary;
|
|
|
|
property Fields[Index: integer]: TDACustomField read GetFields write SetFields; default;
|
|
|
|
property OnFieldBeforeUpdate: TDAFieldNotifyEvent read fFieldBeforeUpdate write fFieldBeforeUpdate;
|
|
property OnFieldAfterUpdate: TDAFieldNotifyEvent read fFieldAfterUpdate write fFieldAfterUpdate;
|
|
property IsCompatibleV4: boolean read fIsCompatibleV4 write fIsCompatibleV4;
|
|
end;
|
|
|
|
TDAFieldCollection = class(TDACustomFieldCollection)
|
|
private
|
|
function GetFields(Index: integer): TDAField;
|
|
procedure SetFields(Index: integer; const Value: TDAField);
|
|
public
|
|
constructor Create(aOwner: TPersistent);
|
|
|
|
function FieldByName(const aName: string): TDAField; reintroduce;
|
|
function FindField(const aName: string): TDAField;
|
|
property Fields[Index: integer]: TDAField read GetFields write SetFields; default;
|
|
end;
|
|
|
|
TDADriverForeignKey = class(TInterfacedCollectionItem)
|
|
private
|
|
fValues:array[0..3] of string;
|
|
fName: string;
|
|
function GetValue(const Index: Integer): string;
|
|
procedure SetValue(const Index: Integer; const Value: string);
|
|
published
|
|
property Name: string read fName write fName;
|
|
property FKTable: string index 0 read GetValue write SetValue;
|
|
property PKTable: string index 1 read GetValue write SetValue;
|
|
property FKField: string index 2 read GetValue write SetValue;
|
|
property PKField: string index 3 read GetValue write SetValue;
|
|
end;
|
|
|
|
TDADriverForeignKeyCollection = class(TInterfacedCollection)
|
|
private
|
|
function GetForeignKeys(Index: integer): TDADriverForeignKey;
|
|
procedure SetForeignKeys(Index: integer; const Value: TDADriverForeignKey);
|
|
public
|
|
constructor Create(aOwner: TPersistent);
|
|
function Add: TDADriverForeignKey; reintroduce; overload;
|
|
|
|
//procedure Assign(Source: TPersistent); override;
|
|
//procedure AssignFieldCollection(Source: TDACustomFieldCollection);
|
|
|
|
property ForeignKeys[Index: integer]: TDADriverForeignKey read GetForeignKeys write SetForeignKeys; default;
|
|
end;
|
|
|
|
TDADataDictionaryFieldCollection = class(TDACustomFieldCollection)
|
|
end;
|
|
|
|
{ TDAParam }
|
|
TDAParam = class(TDABaseField)
|
|
private
|
|
fParamType: TDAParamType;
|
|
|
|
function GetParamType: TDAParamType;
|
|
procedure SetParamType(Value: TDAParamType);
|
|
|
|
public
|
|
procedure SaveToStream(const aStream: IROStream);
|
|
procedure LoadFromStream(const aStream: IROStream);
|
|
procedure SaveToFile(const aFileName: string);
|
|
procedure LoadFromFile(const aFileName: string);
|
|
procedure AssignField(Source: TDABaseField); override;
|
|
|
|
published
|
|
property Value stored true;
|
|
property AsString stored false;
|
|
property ParamType: TDAParamType read GetParamType write SetParamType default daptUnknown;
|
|
end;
|
|
|
|
{ TDAParamCollection }
|
|
TDAParamCollection = class(TSearcheableInterfacedCollection) // They are used also by the driver commands/datasets
|
|
private
|
|
function GetParams(Index: integer): TDAParam;
|
|
procedure SetParams(Index: integer; const Value: TDAParam);
|
|
function GetHasInputParams: boolean;
|
|
|
|
protected
|
|
public
|
|
constructor Create(aOwner: TPersistent);
|
|
|
|
procedure WriteValues(OutputParams: TParams);
|
|
procedure ReadValues(InputParams: TParams);
|
|
|
|
function Add: TDAParam; reintroduce;
|
|
|
|
function ParamByName(const aName: string): TDAParam;
|
|
function FindParam(const aParamName: string): TDAParam;
|
|
|
|
procedure Assign(Source: TPersistent); override;
|
|
procedure AssignParamCollection(Source: TDAParamCollection);
|
|
|
|
property Params[Index: integer]: TDAParam read GetParams write SetParams; default;
|
|
property HasInputParams:boolean read GetHasInputParams;
|
|
end;
|
|
|
|
{ TDASQLCommand }
|
|
TDASQLCommand = class(TCollectionItem)
|
|
private
|
|
fName: string;
|
|
fDescription: string;
|
|
fStatements: TDAStatementCollection;
|
|
fParams: TDAParamCollection;
|
|
fCustomAttributes: TStrings;
|
|
fIsPublic: Boolean;
|
|
|
|
procedure SetName(const Value: string);
|
|
procedure SetCustomAttributes(const Value: TStrings);
|
|
|
|
protected
|
|
function GetDisplayName: string; override;
|
|
procedure SetDisplayName(const Value: string); override;
|
|
function GetParams: TDAParamCollection; virtual;
|
|
procedure SetParams(const Value: TDAParamCollection); virtual;
|
|
function GetStatements(): TDAStatementCollection; virtual;
|
|
procedure SetStatements(const Value: TDAStatementCollection); virtual;
|
|
function GetSQLCommandCollection: TDASQLCommandCollection; virtual;
|
|
|
|
public
|
|
constructor Create(Collection: TCollection); override;
|
|
destructor Destroy; override;
|
|
|
|
function ParamByName(const aName: string): TDAParam;
|
|
|
|
procedure Assign(aSource: TPersistent); override;
|
|
|
|
property SQLCommandCollection: TDASQLCommandCollection read GetSQLCommandCollection;
|
|
|
|
published
|
|
property IsPublic: Boolean read fIsPublic write fIsPublic default True;
|
|
property Params: TDAParamCollection read GetParams write SetParams;
|
|
property Statements: TDAStatementCollection read GetStatements write SetStatements;
|
|
property Name: string read fName write SetName;
|
|
property Description: string read fDescription write fDescription;
|
|
property CustomAttributes: TStrings read fCustomAttributes write SetCustomAttributes;
|
|
end;
|
|
|
|
TDASQLCommandClass = class of TDASQLCommand;
|
|
|
|
{ TDASQLCommandCollection }
|
|
TDASQLCommandCollection = class(TSearcheableCollection)
|
|
private
|
|
function GetSQLCommands(Index: integer): TDASQLCommand;
|
|
procedure SetSQLCommands(Index: integer; const Value: TDASQLCommand);
|
|
|
|
protected
|
|
function GetItemClass: TDASQLCommandClass; virtual;
|
|
|
|
public
|
|
constructor Create(aOwner: TComponent);
|
|
|
|
function Add: TDASQLCommand; reintroduce;
|
|
|
|
function SQLCommandByName(const aName: string): TDASQLCommand;
|
|
|
|
property SQLCommands[Index: integer]: TDASQLCommand read GetSQLCommands write SetSQLCommands; default;
|
|
end;
|
|
|
|
TROSEScriptLanguage = (rslPascalScript);
|
|
|
|
TDABusinessRuleScript = class(TPersistent)
|
|
private
|
|
fScriptLanguage: TROSEScriptLanguage;
|
|
fScript: string;
|
|
fDescription: string;
|
|
published
|
|
property Script: string read fScript write fScript;
|
|
property ScriptLanguage: TROSEScriptLanguage read fScriptLanguage write fScriptLanguage default rslPascalScript;
|
|
property Description: string read fDescription write fDescription;
|
|
end;
|
|
|
|
TDAClientBusinessRuleScript = class(TDABusinessRuleScript)
|
|
private
|
|
fRunOnClientAndServer: boolean;
|
|
fCompileOnServer: boolean;
|
|
published
|
|
constructor Create();
|
|
property CompileOnServer: boolean read fCompileOnServer write fCompileOnServer default true;
|
|
property RunOnClientAndServer: boolean read fRunOnClientAndServer write fRunOnClientAndServer default true;
|
|
end;
|
|
|
|
{ TDADatasetRelationship }
|
|
TDADatasetRelationship = class(TCollectionItem)
|
|
private
|
|
fDetailFields: string;
|
|
fMasterFields: string;
|
|
fDetailDatasetName: string;
|
|
fMasterDatasetName: string;
|
|
fName: string;
|
|
fDescription: string;
|
|
fRelationshipType: TDARelationshipType;
|
|
protected
|
|
function GetDisplayName : string; override;
|
|
public
|
|
constructor Create(Collection: TCollection); override;
|
|
published
|
|
procedure Assign(Source : TPersistent); override;
|
|
|
|
property Name : string read fName write fName;
|
|
property MasterDatasetName : string read fMasterDatasetName write fMasterDatasetName;
|
|
property MasterFields : string read fMasterFields write fMasterFields;
|
|
property DetailDatasetName : string read fDetailDatasetName write fDetailDatasetName;
|
|
property DetailFields : string read fDetailFields write fDetailFields;
|
|
property Description: string read fDescription write fDescription;
|
|
property RelationshipType: TDARelationshipType read fRelationshipType write fRelationshipType;
|
|
end;
|
|
|
|
{ TDADatasetRelationshipList }
|
|
TDADatasetRelationshipList = class(TList)
|
|
private
|
|
function GetItems(Index: integer): TDADatasetRelationship;
|
|
protected
|
|
public
|
|
function Add(aRelationship : TDADatasetRelationship) : integer; reintroduce;
|
|
|
|
property Items[Index : integer] : TDADatasetRelationship read GetItems; default;
|
|
end;
|
|
|
|
{ TDADatasetRelationshipCollection }
|
|
TDADatasetRelationshipCollection = class(TSearcheableCollection)
|
|
private
|
|
function GetRelationShips(Index: integer): TDADatasetRelationship;
|
|
protected
|
|
public
|
|
constructor Create(aOwner : TComponent);
|
|
procedure GetDetails(const aMasterDatasetName: string; aList: TDADatasetRelationshipList);
|
|
|
|
function Add: TDADatasetRelationship; overload;
|
|
function RelationShipByName(const aName : string) : TDADatasetRelationship;
|
|
|
|
property RelationShips[Index : integer] : TDADatasetRelationship read GetRelationShips; default;
|
|
end;
|
|
|
|
{ TDADataset }
|
|
TDADataset = class(TDASQLCommand)
|
|
private
|
|
fFields: TDAFieldCollection;
|
|
fBusinessClassID: string;
|
|
fBusinessRulesServer: TDABusinessRuleScript;
|
|
fBusinessRulesClient: TDAClientBusinessRuleScript;
|
|
fReadOnly: Boolean;
|
|
|
|
procedure SetFields(const Value: TDAFieldCollection);
|
|
procedure SetBusinessRulesClient(const Value: TDAClientBusinessRuleScript);
|
|
procedure SetBusinessRulesServer(const Value: TDABusinessRuleScript);
|
|
|
|
protected
|
|
public
|
|
constructor Create(Collection: TCollection); override;
|
|
destructor Destroy; override;
|
|
|
|
procedure Assign(aSource: TPersistent); override;
|
|
|
|
function FieldByName(const aName: string): TDAField;
|
|
function FindField(const aName: string): TDAField;
|
|
published
|
|
property Fields: TDAFieldCollection read fFields write SetFields;
|
|
property BusinessClassID : string read fBusinessClassID write fBusinessClassID;
|
|
property ReadOnly: Boolean read fReadOnly write fReadOnly default False;
|
|
|
|
property BusinessRulesClient: TDAClientBusinessRuleScript read fBusinessRulesClient write SetBusinessRulesClient;
|
|
property BusinessRulesServer: TDABusinessRuleScript read fBusinessRulesServer write SetBusinessRulesServer;
|
|
end;
|
|
|
|
{ TDADatasetCollection }
|
|
TDADatasetCollection = class(TDASQLCommandCollection)
|
|
private
|
|
function GetDatasets(Index: integer): TDADataset;
|
|
procedure SetDatasets(Index: integer; const Value: TDADataset);
|
|
protected
|
|
function GetItemClass: TDASQLCommandClass; override;
|
|
|
|
public
|
|
function Add: TDADataset; reintroduce;
|
|
|
|
function DatasetByName(const aName: string): TDADataset;
|
|
function FindDatasetByName(const aName: string): TDADataset;
|
|
|
|
property Datasets[Index: integer]: TDADataset read GetDatasets write SetDatasets; default;
|
|
end;
|
|
|
|
{ TDAJoinSourceTable }
|
|
TDAJoinSourceTable = class(TCollectionItem)
|
|
private
|
|
fName: String;
|
|
fJoinType: TDAJoinType;
|
|
fJoinConditions: TDAJoinConditionCollection;
|
|
protected
|
|
function GetDisplayName : string; override;
|
|
procedure SetName(const Value: string);
|
|
public
|
|
constructor Create(Collection: TCollection); override;
|
|
procedure Assign(aSource: TPersistent); override;
|
|
published
|
|
property Name: string read fName write SetName;
|
|
property JoinType: TDAJoinType read fJoinType write fJoinType;
|
|
property JoinConditions: TDAJoinConditionCollection read fJoinConditions;
|
|
end;
|
|
|
|
{ TDAJoinSourceTableCollection }
|
|
TDAJoinSourceTableCollection = class(TSearcheableCollection)
|
|
private
|
|
function GetJoinSourceTables(Index: integer): TDAJoinSourceTable;
|
|
procedure SetJoinSourceTables(Index: integer; const Value: TDAJoinSourceTable);
|
|
public
|
|
constructor Create(aOwner: TPersistent);
|
|
function Add: TDAJoinSourceTable; reintroduce;
|
|
function JoinSourceTableByName(const aName: string): TDAJoinSourceTable;
|
|
property JoinSourceTables[Index:Integer]: TDAJoinSourceTable read GetJoinSourceTables write SetJoinSourceTables;
|
|
end;
|
|
|
|
{ TDAJoinCondition }
|
|
TDAJoinCondition = class(TCollectionItem)
|
|
private
|
|
fFromTableName: String;
|
|
fFromFieldName: String;
|
|
fToTableName: String;
|
|
fToFieldName: String;
|
|
published
|
|
property FromTableName: String read fFromTableName write fFromTableName;
|
|
property FromFieldName: String read fFromFieldName write fFromFieldName;
|
|
property ToTableName: String read fToTableName write fToTableName;
|
|
property ToFieldName: String read fToFieldName write fToFieldName;
|
|
end;
|
|
|
|
{ TDAJoinConditionCollection }
|
|
TDAJoinConditionCollection = class(TOwnedCollection)
|
|
private
|
|
public
|
|
constructor Create(aOwner: TPersistent);
|
|
function Add: TDAJoinCondition; reintroduce;
|
|
end;
|
|
|
|
|
|
{ TDAJoinDataTable }
|
|
TDAJoinDataTable = class(TDADataset)
|
|
private
|
|
fMasterTable: String;
|
|
fJoinSourceTables: TDAJoinSourceTableCollection;
|
|
procedure SetJoinSourceTables(const Value: TDAJoinSourceTableCollection);
|
|
protected
|
|
function GetParams: TDAParamCollection; override;
|
|
procedure SetParams(const Value: TDAParamCollection); override;
|
|
function GetStatements(): TDAStatementCollection; override;
|
|
procedure SetStatements(const Value: TDAStatementCollection); override;
|
|
function GetSQLCommandCollection: TDASQLCommandCollection; override;
|
|
public
|
|
constructor Create(Collection: TCollection); override;
|
|
destructor Destroy; override;
|
|
procedure Assign(aSource: TPersistent); override;
|
|
property Params;
|
|
property Statements;
|
|
published
|
|
property JoinSourceTables: TDAJoinSourceTableCollection read fJoinSourceTables write SetJoinSourceTables;
|
|
property MasterTable: String read fMasterTable write fMasterTable;
|
|
end;
|
|
|
|
TDAJoinDataTableClass = class of TDAJoinDataTable;
|
|
|
|
{ TDAJoinedTableCollection }
|
|
TDAJoinDataTableCollection = class(TSearcheableCollection)
|
|
private
|
|
function GetJoinDataTables(Index: integer): TDAJoinDataTable;
|
|
procedure SetJoinDataTables(Index: integer; const Value: TDAJoinDataTable);
|
|
protected
|
|
//function GetItemClass: TDAJoinedTableClass; override;
|
|
public
|
|
constructor Create(aOwner : TComponent);
|
|
function Add: TDAJoinDataTable; reintroduce;
|
|
function JoinTableByName(const aName: string): TDAJoinDataTable;
|
|
function FindJoinTableByName(const aName: string): TDAJoinDataTable;
|
|
property JoinTables[Index: integer]: TDAJoinDataTable read GetJoinDataTables write SetJoinDataTables; default;
|
|
end;
|
|
|
|
{TDAUnionSourceTable}
|
|
TDAUnionSourceTable = class(TCollectionItem)
|
|
private
|
|
fName: string;
|
|
fColumnMappings: TDAColumnMappingCollection;
|
|
fReadOnly: Boolean;
|
|
procedure SetColumnMappings(const Value: TDAColumnMappingCollection);
|
|
public
|
|
constructor Create(Collection: TCollection); override;
|
|
destructor Destroy; override;
|
|
procedure Assign(Source: TPersistent); override;
|
|
published
|
|
property Name: string read fName write fName;
|
|
property ColumnMappings: TDAColumnMappingCollection read fColumnMappings write SetColumnMappings;
|
|
property IsReadOnly: Boolean read fReadOnly write fReadOnly;
|
|
end;
|
|
|
|
{TDAUnionSourceTableCollection}
|
|
TDAUnionSourceTableCollection = class(TSearcheableCollection)
|
|
private
|
|
function GetUnionSourceTables(Index: integer): TDAUnionSourceTable;
|
|
protected
|
|
public
|
|
constructor Create(aOwner : TPersistent);
|
|
|
|
function Add: TDAUnionSourceTable; reintroduce;
|
|
function UnionSourceTableByName(const aName : string) : TDAUnionSourceTable;
|
|
|
|
property UnionSourceTables[Index : integer] : TDAUnionSourceTable read GetUnionSourceTables; default;
|
|
end;
|
|
|
|
{TDAUnionDataTable}
|
|
TDAUnionDataTable = class(TDADataset)
|
|
private
|
|
fDefaultSourceTable: string;
|
|
fSourceTables: TDAUnionSourceTableCollection;
|
|
procedure SetSourceTables(Value: TDAUnionSourceTableCollection);
|
|
protected
|
|
public
|
|
constructor Create(Collection: TCollection); override;
|
|
destructor Destroy; override;
|
|
property Params;
|
|
property Statements;
|
|
published
|
|
property SourceTables: TDAUnionSourceTableCollection read fSourceTables write SetSourceTables;
|
|
property DefaultSourceTable: String read fDefaultSourceTable write fDefaultSourceTable;
|
|
end;
|
|
|
|
{ TDAUnionDataTableCollection }
|
|
TDAUnionDataTableCollection = class(TSearcheableCollection)
|
|
private
|
|
function GetUnionDataTables(Index: integer): TDAUnionDataTable;
|
|
procedure SetUnionDataTables(Index: integer; const Value: TDAUnionDataTable);
|
|
protected
|
|
//function GetItemClass: TDAJoinedTableClass; override;
|
|
public
|
|
constructor Create(aOwner : TComponent);
|
|
function Add: TDAUnionDataTable; reintroduce;
|
|
function UnionDataTableByName(const aName: string): TDAUnionDataTable;
|
|
function FindUnionDataTableByName(const aName: string): TDAUnionDataTable;
|
|
property UnionDataTables[Index: integer]: TDAUnionDataTable read GetUnionDataTables write SetUnionDataTables; default;
|
|
end;
|
|
|
|
{ TDAConnection }
|
|
TDAConnection = class(TCollectionItem)
|
|
private
|
|
fDescription: string;
|
|
fConnectionString: string;
|
|
fConnectionType: string;
|
|
fName: string;
|
|
fDefault: boolean;
|
|
fTag: integer;
|
|
procedure SetDefault(const Value: boolean);
|
|
procedure SetName(const Value: string);
|
|
|
|
protected
|
|
function GetDisplayName: string; override;
|
|
procedure SetDisplayName(const Value: string); override;
|
|
|
|
function GetConnectionString: string; virtual;
|
|
procedure SetConnectionString(const aValue: string); virtual;
|
|
|
|
public
|
|
procedure Assign(aSource: TPersistent); override;
|
|
|
|
published
|
|
property Name: string read fName write SetName;
|
|
property ConnectionString: string read GetConnectionString write SetConnectionString;
|
|
property Description: string read fDescription write fDescription;
|
|
property ConnectionType: string read fConnectionType write fConnectionType;
|
|
property Default: boolean read fDefault write SetDefault default False;
|
|
property Tag: integer read fTag write fTag default 0;
|
|
end;
|
|
|
|
{ TDAConnectionCollection }
|
|
TDAConnectionCollection = class(TSearcheableCollection)
|
|
private
|
|
function GetConnections(Index: integer): TDAConnection;
|
|
procedure SetConnections(Index: integer; const Value: TDAConnection);
|
|
procedure ClearDefaults(iExceptFor: TDAConnection);
|
|
protected
|
|
function ItemName: string; override;
|
|
|
|
public
|
|
constructor Create(aOwner: TPersistent);
|
|
|
|
function Add: TDAConnection; reintroduce;
|
|
function ConnectionByName(const aName: string): TDAConnection;
|
|
function FindConnection(const aName: string; const aType: string): TDAConnection;
|
|
|
|
function GetDefaultConnection : TDAConnection;
|
|
|
|
property Connections[Index: integer]: TDAConnection read GetConnections write SetConnections; default;
|
|
property OnItemRenamed;
|
|
property OnItemRemoved;
|
|
end;
|
|
|
|
EDADriverAlreadyLoaded = class(EDADriverLoadException);
|
|
EDASchemaModelerOnly = class(EDADriverLoadException);
|
|
|
|
IDADataDictionary = interface
|
|
['{34078D79-6310-494C-BA92-0FC187B275BE}']
|
|
procedure SetFields(const Value: TDADataDictionaryFieldCollection);
|
|
function GetFields: TDADataDictionaryFieldCollection;
|
|
property Fields: TDADataDictionaryFieldCollection read GetFields write SetFields;
|
|
end;
|
|
|
|
IDAHasDataDictionary = interface
|
|
['{A25ADACE-BBD7-4A04-84A9-B9B699389E3D}']
|
|
function GetDataDictionary: IDADataDictionary;
|
|
property DataDictionary: IDADataDictionary read GetDataDictionary;
|
|
end;
|
|
{ IDADriverManager
|
|
Provides access to all the functionality needed to load, unload and verify drivers.
|
|
Access to this interface is obtained using a TDADriverManager component.
|
|
There can only be one driver manager loaded at any give time in one application. }
|
|
IDADriverManager = interface
|
|
['{5B6B8C91-F91A-4A25-8B6F-CF7959275682}']
|
|
// Properties readers/writers
|
|
function GetDrivers(Index: integer): IDADriver;
|
|
function GetDriverCount: integer;
|
|
|
|
// Methods
|
|
procedure LoadDriver(const aFileName: string);
|
|
procedure UnloadDriver(anIndex: integer);
|
|
|
|
procedure LoadDrivers;overload;
|
|
procedure LoadDrivers(const aDriverList: IROStrings; aIgnoreDuplicates: boolean = false; aIgnoreErrors: boolean = false);overload;
|
|
procedure UnloadAllDrivers;
|
|
|
|
function ListDrivers(const aDirectory: string; out FileNames: IROStrings): integer;
|
|
|
|
function FindDriver(const aDriverID: string; out Driver: IDADriver): boolean;
|
|
function DriverByDriverID(const aDriverID: string): IDADriver;
|
|
|
|
// Properties
|
|
property Drivers[Index: integer]: IDADriver read GetDrivers; default;
|
|
property DriverCount: integer read GetDriverCount;
|
|
end;
|
|
|
|
TDAAvailableDriverOption = (doAuxDriver, doServerName, doDatabaseName, doLogin, doCustom);
|
|
TDAAvailableDriverOptions = set of TDAAvailableDriverOption;
|
|
|
|
TDADriverHelpType = (dhConnectionWizard);
|
|
|
|
{ IDADriver
|
|
An object implementing this interface is returned by the Data Abstract drivers. You get a reference to
|
|
it by calling the DLL's exported function GetDriverObject. If the DLL doesn't support this method, it is
|
|
not a Data Abstract driver. Once you retrieve a reference to this object you can query it for additional
|
|
interfaces such as IDAConnectionPool and obtain access to additional functionality. Not all drivers implement
|
|
the same number of interfaces. }
|
|
|
|
TDATraceSource = (tsUnknown, tsConnection, tsDataset, tsCommand);
|
|
TDATraceOption = (toPrepare,
|
|
toExecute,
|
|
toFetch,
|
|
toError,
|
|
toStmt,
|
|
toConnect,
|
|
toTransact,
|
|
toBlob,
|
|
toService,
|
|
toMisc,
|
|
toParams);
|
|
TDATraceOptions = set of TDATraceOption;
|
|
|
|
TDALogTraceEvent = procedure(Sender: TObject; const Text: string; Tag: integer) of object;
|
|
|
|
IDADriver = interface
|
|
['{1829ABED-299B-4698-9803-DBABCF5443FA}']
|
|
// Properties readers/writers
|
|
function GetDriverID: string; safecall;
|
|
function GetDescription: string; safecall;
|
|
function GetMajVersion: byte; safecall;
|
|
function GetMinVersion: byte; safecall;
|
|
|
|
// Methods
|
|
procedure Initialize; safecall;
|
|
procedure Finalize; safecall;
|
|
|
|
function NewConnection(const aName: string = '';const aConnectionType: string = ''): IDAConnection; safecall; overload; {deprecated;}
|
|
function NewConnection(const aConnectionManager: IDAConnectionManager; aConnectionDefinition: TDAConnection): IDAConnection; safecall; overload;
|
|
|
|
procedure SetTraceOptions(TraceActive: boolean; TraceOptions: TDATraceOptions; Callback: TDALogTraceEvent); safecall;
|
|
|
|
function GetAvailableDriverOptions: TDAAvailableDriverOptions; safecall;
|
|
function GetDefaultCustomParameters: string; safecall;
|
|
|
|
// Properties
|
|
property DriverID: string read GetDriverID;
|
|
property Description: string read GetDescription;
|
|
property MajVersion: byte read GetMajVersion;
|
|
property MinVersion: byte read GetMinVersion;
|
|
|
|
procedure GetAuxDrivers(out List: IROStrings); safecall;
|
|
procedure GetAuxParams(const AuxDriver: string; out List: IROStrings); safecall;
|
|
function GetDefaultConnectionType(const AuxDriver: string): string; safecall;
|
|
end;
|
|
|
|
IDADriver30 = interface(IDADriver)
|
|
['{F14A6526-CE1F-4A6B-BC4D-3892BA712FE2}']
|
|
function GetDriverHelp(aType: TDADriverHelpType): string;
|
|
end;
|
|
|
|
IDADriver40 = interface(IDADriver30)
|
|
['{82903957-974A-4E1F-B91C-C07F608A96A9}']
|
|
function GetProviderDefaultCustomParameters(Provider: string): string; safecall;
|
|
end;
|
|
|
|
IDACanQueryDatabaseNames = interface
|
|
['{67870220-37E2-4510-BD6A-627EADED75ED}']
|
|
function GetDatabaseNames: IROStrings;
|
|
end;
|
|
|
|
IDAFileBasedDatabase = interface
|
|
['{C37EA8EE-9AC7-44F3-863C-EFB1581D4D57}']
|
|
function GetFileExtensions: IROStrings;
|
|
end;
|
|
|
|
IDADirectoryBasedDatabase = interface
|
|
['{40C102F0-B86E-4CD6-AB3D-4B0903723A5D}']
|
|
end;
|
|
|
|
{ IDAConnectionObjectAccess
|
|
Provides access to the internal connection component and facilitates access to its
|
|
properties in form of a collection of properties. This interface is useful when you want
|
|
to complete control of the internal object. In order to use this interface you need
|
|
to use ShareMem or FastShareMem. }
|
|
IDAConnectionObjectAccess = interface
|
|
['{FF8F2319-4EAE-4A2B-8713-A6E6B3F5E48A}']
|
|
// Properties readers/writers
|
|
function GetConnectionObject: TObject; safecall;
|
|
function GetConnectionProperties(const aPropertyName: string): Variant; safecall;
|
|
procedure SetConnectionProperties(const aPropertyName: string; const aValue: Variant); safecall;
|
|
|
|
// Properties
|
|
property ConnectionObject: TObject read GetConnectionObject;
|
|
property ConnectionProperties[const aPropertyName: string]: Variant read GetConnectionProperties write SetConnectionProperties;
|
|
end;
|
|
|
|
TDAQuoteCharArray = array[0..1] of char;
|
|
|
|
TDABeforeOpenDatasetEvent = procedure(const Sender: IDADataset) of object;
|
|
TDAAfterOpenDatasetEvent = procedure(const Sender: IDADataset; ActualSQL: string; ElapsedMilliseconds: Cardinal) of object;
|
|
TDAOpenDatasetErrorEvent = procedure(const Sender: IDADataset; ActualSQL: string; Error: Exception) of object;
|
|
|
|
TDABeforeExecuteCommandEvent = procedure(const Sender: IDASQLCommand) of object;
|
|
TDAAfterExecuteCommandEvent = procedure(const Sender: IDASQLCommand; ActualSQL: string; ElapsedMilliseconds: Cardinal) of object;
|
|
TDAExecuteCommandErrorEvent = procedure(const Sender: IDASQLCommand; ActualSQL: string; Error: Exception) of object;
|
|
|
|
{ TDAWhereBuilder }
|
|
|
|
TDAWhereBuilder = class;
|
|
TDAWhereExpression = class(TObject)
|
|
private
|
|
fOwner: TDAWhereBuilder;
|
|
public
|
|
constructor Create(anOwner: TDAWhereBuilder);
|
|
|
|
property Owner: TDAWhereBuilder read fOwner;
|
|
|
|
class function ParseExpression(aOwner: TDAWhereBuilder; xr: IXmlNode): TDAWhereExpression;
|
|
|
|
procedure ReadFromXml(xr: IXmlNode); virtual; abstract;
|
|
procedure WriteToXml(sw: IXmlNode); virtual; abstract;
|
|
end;
|
|
|
|
TDABinaryOperator = (dboAnd, dboOr, dboXor, dboLess, dboLessOrEqual, dboGreater,
|
|
dboGreaterOrEqual, dboNotEqual, dboEqual, dboLike, dboIn, dboAddition, dboSubtraction,
|
|
dboMultiply, dboDivide);
|
|
TDAUnaryOperator = (duoNot, duoMinus);
|
|
|
|
TDAWhereBuilder = class
|
|
private
|
|
fExpression: TDAWhereExpression;
|
|
FColumnMapping: TDAColumnMappingCollection;// for TDAESQLCommand
|
|
fParams: TDAParamCollection;
|
|
function getXml: WideString;
|
|
procedure setXml(const aValue: WideString);
|
|
procedure SetColumnMapping(const Value: TDAColumnMappingCollection);
|
|
procedure SetParams(const Value: TDAParamCollection);
|
|
protected
|
|
function ReadFromXml(xr: IXmlNode): TDAWhereExpression; virtual;
|
|
procedure WriteToXml(sw: IXmlNode; const aExpression: TDAWhereExpression); virtual;
|
|
public
|
|
constructor Create;
|
|
|
|
destructor Destroy; override;
|
|
|
|
property Expression: TDAWhereExpression read fExpression write FExpression;
|
|
|
|
property Xml: WideString read GetXml write SetXml;
|
|
function NewBinaryExpression(aLeft, aRight: TDAWhereExpression; anOp: TDABinaryOperator): TDAWhereExpression;
|
|
function NewUnaryExpression(anExpression: TDAWhereExpression; anOp: TDAUnaryOperator): TDAWhereExpression;
|
|
function NewConstant(const aValue: Variant; aType: TDADataType): TDAWhereExpression;
|
|
function NewList(const aValues: array of TDAWhereExpression): TDAWhereExpression;
|
|
function NewParameter(const aParameterName: string): TDAWhereExpression;
|
|
function NewField(const aTableName,aFieldName: string): TDAWhereExpression;
|
|
function NewNull: TDAWhereExpression;
|
|
function NewMacro(const aName: string): TDAWhereExpression; overload;
|
|
function NewMacro(const aName: string; const aValues: array of TDAWhereExpression): TDAWhereExpression; overload;
|
|
procedure Clear;
|
|
function IsEmpty:Boolean;
|
|
property ColumnMapping: TDAColumnMappingCollection read FColumnMapping write SetColumnMapping;
|
|
property Params: TDAParamCollection read fParams write SetParams;
|
|
function ExpressionToXmlNode(const aExpression: TDAWhereExpression): IXMLNode;
|
|
function XMLToExpression(const aXML: widestring):TDAWhereExpression;
|
|
end;
|
|
|
|
TDAQueryBuilder = class;
|
|
TDASQLWhereBuilder = class(TDAWhereBuilder)
|
|
private
|
|
FId: Integer;
|
|
FConnection: IDAConnection;
|
|
FQueryBuilder: TDAQueryBuilder;
|
|
function GenerateParamName: String;
|
|
function GenerateParameter(const aParameterName: string):string;
|
|
function GetMappingTableField(const aDataSetField: string): string;
|
|
protected
|
|
function GenerateFieldName(aTablename, aFieldName: string):string; virtual;
|
|
function ProcessExpression(AExpression: TDAWhereExpression): string;
|
|
function ProcessBinaryExpression(AExpression: TDAWhereExpression): string; virtual; abstract;
|
|
function ProcessUnaryExpression(AExpression: TDAWhereExpression): string; virtual; abstract;
|
|
function ProcessConstantExpression(AExpression: TDAWhereExpression): string; virtual;
|
|
function ProcessListExpression(AExpression: TDAWhereExpression): string; virtual;
|
|
function ProcessParameterExpression(AExpression: TDAWhereExpression): string; virtual;
|
|
function ProcessFieldExpression(AExpression: TDAWhereExpression): string; virtual;
|
|
function ProcessNullExpression(AExpression: TDAWhereExpression): string; virtual; abstract;
|
|
function ProcessMacroExpression(AExpression: TDAWhereExpression): string; virtual;
|
|
public
|
|
constructor Create(AConnection: IDAConnection); overload;
|
|
constructor Create(AQueryBuilder: TDAQueryBuilder); overload;
|
|
function CreateWhereClause: string;
|
|
property Connection: IDAConnection read FConnection;
|
|
property QueryBuilder: TDAQueryBuilder read FQueryBuilder;
|
|
end;
|
|
{ TDAQueryBuilder }
|
|
|
|
TDATableFieldCollectionItem = class(TCollectionItem)
|
|
private
|
|
FFieldName: string;
|
|
FTableName: string;
|
|
public
|
|
procedure Assign(Source: TPersistent); override;
|
|
property TableName: string read FTableName write FTableName;
|
|
property FieldName: string read FFieldName write FFieldName;
|
|
end;
|
|
|
|
TDASelectItem = TDATableFieldCollectionItem;
|
|
TDASelectCollection = TCollection;
|
|
|
|
TDAGroupByItem = TDATableFieldCollectionItem;
|
|
TDAGroupByCollection = TCollection;
|
|
|
|
TDAOrderByItem = TDATableFieldCollectionItem;
|
|
TDAOrderByCollection = TCollection;
|
|
|
|
TDAQueryBuilderOption = (qboSelectDistinct, qboGenerateSimpleSelect, qboGenerateDynamicWhereStatement);
|
|
TDAQueryBuilderOptions = set of TDAQueryBuilderOption;
|
|
|
|
TDAQueryBuilder = class(TPersistent)
|
|
private
|
|
// IDAConnection
|
|
FMainTable: TDAJoinDataTable;
|
|
FSelectCollection: TDASelectCollection;
|
|
FGroupByCollection: TDAGroupByCollection;
|
|
FOrderByCollection: TDAOrderByCollection;
|
|
FWhere: TDASQLWhereBuilder;
|
|
FOptions: TDAQueryBuilderOptions;
|
|
FConnection: IDAConnection;
|
|
FColumnMapping: TDAColumnMappingCollection;
|
|
procedure SetColumnMapping(const Value: TDAColumnMappingCollection);
|
|
function GetWhereBuilder: TDASQLWhereBuilder;
|
|
protected
|
|
function GetMappingTableField(const aDataSetField: string): string;
|
|
procedure Validate; virtual;
|
|
function CreateWhereBuilder: TDASQLWhereBuilder; virtual; abstract;
|
|
function CreateSelectClause: string; virtual;
|
|
function CreateTableClause: string; virtual;abstract;
|
|
function CreateGroupByClause: string; virtual;
|
|
function CreateOrderByClause: string; virtual;
|
|
function GenerateFieldName(aTablename, aFieldName: string; aProcessMapping: Boolean = True):string; virtual;
|
|
function QuoteFieldNameIfNeeded(const aTableName, aFieldName: string): string; virtual;
|
|
function QuoteIdentifierIfNeeded(const iIdentifier: string): string; virtual;
|
|
function QuoteIdentifier(const iIdentifier: string): string; virtual;
|
|
function IdentifierNeedsQuoting(const iIdentifier: string):boolean;virtual;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
function GenerateSelectSQL: string; virtual;
|
|
function CreateWhereClause: string; virtual;
|
|
procedure Assign(Source: TPersistent); override;
|
|
procedure Clear;
|
|
procedure AddSelect(ATable, AField: string);
|
|
procedure AddGroupBy(ATable, AField: string);
|
|
procedure AddOrderBy(ATable, AField: string);
|
|
procedure AddJoin(AJoinTable, AJoinFieldName, AJoinToTableName, AJoinToFieldName: string; AJoinType: TDAJoinType = jtInner); overload;
|
|
procedure AddJoin(AJoinTable: string; AJoinFieldNames: array of string; AJoinToTableName: string; AJoinToFieldNames: array of string; AJoinType: TDAJoinType = jtInner); overload;
|
|
procedure AddCrossJoin(ATable: string);
|
|
property Select: TDASelectCollection read FSelectCollection;
|
|
property MainTable: TDAJoinDataTable read FMainTable;
|
|
property Where: TDASQLWhereBuilder read GetWhereBuilder;
|
|
property GroupBy: TDAGroupByCollection read FGroupByCollection;
|
|
property OrderBy: TDAOrderByCollection read FOrderByCollection;
|
|
property Options: TDAQueryBuilderOptions read FOptions write FOptions;
|
|
property Connection: IDAConnection read FConnection write FConnection;
|
|
property ColumnMapping: TDAColumnMappingCollection read FColumnMapping write SetColumnMapping;
|
|
end;
|
|
|
|
IDABaseConnection = interface
|
|
['{B96CFC5B-CE8A-4B6F-994E-2A82509B0F18}']
|
|
end;
|
|
|
|
{ IDAConnection
|
|
Provides access to a connection object in a database and vendor independent manner.
|
|
Objects implementing IDAConnection are returned by the driver.
|
|
Each connection object might also implement additional interfaces that are specific to the
|
|
underlying database or the data-access framework. These additional interfaces are defined in
|
|
separate units. To find out what interfaces a connection implements you can check the source code
|
|
of the relative uDAxxxDriver.pas unit. }
|
|
IDAConnection = interface(IDABaseConnection)
|
|
['{6D9C806F-65A5-43B3-8F07-4ED782A13A0A}']
|
|
// Properties readers/writers
|
|
function GetConnectionPool: IDAConnectionPool; safecall;
|
|
procedure SetConnectionPool(const Value: IDAConnectionPool); safecall;
|
|
function GetConnectionString: string; safecall;
|
|
procedure SetConnectionString(Value: string); safecall;
|
|
function GetConnected: boolean; safecall;
|
|
procedure SetConnected(Value: boolean); safecall;
|
|
function GetName: string; safecall;
|
|
function GetOnAfterExecuteCommand: TDAAfterExecuteCommandEvent; safecall;
|
|
function GetOnAfterOpenDataset: TDAAfterOpenDatasetEvent; safecall;
|
|
function GetOnBeforeExecuteCommand: TDABeforeExecuteCommandEvent; safecall;
|
|
function GetOnBeforeOpenDataset: TDABeforeOpenDatasetEvent; safecall;
|
|
function GetOnExecuteCommandError: TDAExecuteCommandErrorEvent; safecall;
|
|
function GetOnOpenDatasetError: TDAOpenDatasetErrorEvent; safecall;
|
|
procedure SetOnAfterExecuteCommand(const Value: TDAAfterExecuteCommandEvent); safecall;
|
|
procedure SetOnAfterOpenDataset(const Value: TDAAfterOpenDatasetEvent); safecall;
|
|
procedure SetOnBeforeExecuteCommand(const Value: TDABeforeExecuteCommandEvent); safecall;
|
|
procedure SetOnBeforeOpenDataset(const Value: TDABeforeOpenDatasetEvent); safecall;
|
|
procedure SetOnExecuteCommandError(const Value: TDAExecuteCommandErrorEvent); safecall;
|
|
procedure SetOnOpenDatasetError(const Value: TDAOpenDatasetErrorEvent); safecall;
|
|
function GetConnectionType: string; safecall;
|
|
|
|
// Transaction support
|
|
function BeginTransaction: integer; safecall;
|
|
procedure CommitTransaction; safecall;
|
|
procedure RollbackTransaction; safecall;
|
|
function GetInTransaction: boolean; safecall;
|
|
|
|
// UserID/Password
|
|
function GetUserID: string; safecall;
|
|
procedure SetUserID(const Value: string); safecall;
|
|
function GetPassword: string; safecall;
|
|
procedure SetPassword(const Value: string); safecall;
|
|
|
|
// Connection
|
|
procedure Open(const aUserID: string = ''; const aPassword: string = ''); safecall;
|
|
procedure Close; safecall;
|
|
|
|
// Metadata
|
|
procedure GetTableNames(out List: IROStrings); safecall;
|
|
procedure GetViewNames(out List: IROStrings); safecall;
|
|
procedure GetStoredProcedureNames(out List: IROStrings); safecall;
|
|
procedure GetTableFields(const aTableName: string; out Fields: TDAFieldCollection); safecall;
|
|
procedure GetQueryFields(const aSQL: string; aParamsIfNeeded: TDAParamCollection; out Fields: TDAFieldCollection); safecall;
|
|
procedure GetViewFields(const aViewName: string; out Fields: TDAFieldCollection); safecall;
|
|
procedure GetStoredProcedureParams(const aStoredProcedureName: string; out Params: TDAParamCollection); safecall;
|
|
procedure GetForeignKeys(out ForeignKeys: TDADriverForeignKeyCollection); safecall;
|
|
|
|
function GetQuoteChars: TDAQuoteCharArray; safecall;
|
|
function IdentifierNeedsQuoting(const iIdentifier: string): boolean; safecall;
|
|
function QuoteIdentifierIfNeeded(const iIdentifier: string): string; safecall;
|
|
function QuoteIdentifier(const iIdentifier: string): string; safecall;
|
|
function QuoteFieldNameIfNeeded(const aTableName, aFieldName: string): string; safecall;
|
|
function QuoteFieldName(const aTableName, aFieldName: string): string; safecall;
|
|
function GetSPSelectSyntax(HasArguments: Boolean): string; safecall;
|
|
|
|
// Commands and datasets
|
|
function NewCommand(const Text: string; CommandType: TDASQLStatementType; const aCommandName: string = ''): IDASQLCommand; safecall;
|
|
function NewDataset(const SQL: string; const aDatasetName: string = ''): IDADataset; safecall;
|
|
function GetLastAutoInc(const GeneratorName: string = ''): integer; safecall;
|
|
|
|
function isAlive: Boolean; safecall;
|
|
// Properties
|
|
property ConnectionString: string read GetConnectionString write SetConnectionString;
|
|
property Connected: boolean read GetConnected write SetConnected;
|
|
property Name: string read GetName;
|
|
property InTransaction: boolean read GetInTransaction;
|
|
property UserID: string read GetUserID write SetUserID;
|
|
property Password: string read GetPassword write SetPassword;
|
|
property ConnectionPool: IDAConnectionPool read GetConnectionPool write SetConnectionPool;
|
|
property ConnectionType: string read GetConnectionType;
|
|
|
|
property OnBeforeOpenDataset: TDABeforeOpenDatasetEvent read GetOnBeforeOpenDataset write SetOnBeforeOpenDataset;
|
|
property OnAfterOpenDataset: TDAAfterOpenDatasetEvent read GetOnAfterOpenDataset write SetOnAfterOpenDataset;
|
|
property OnOpenDatasetError: TDAOpenDatasetErrorEvent read GetOnOpenDatasetError write SetOnOpenDatasetError;
|
|
property OnBeforeExecuteCommand: TDABeforeExecuteCommandEvent read GetOnBeforeExecuteCommand write SetOnBeforeExecuteCommand;
|
|
property OnAfterExecuteCommand: TDAAfterExecuteCommandEvent read GetOnAfterExecuteCommand write SetOnAfterExecuteCommand;
|
|
property OnExecuteCommandError: TDAExecuteCommandErrorEvent read GetOnExecuteCommandError write SetOnExecuteCommandError;
|
|
// QueryBuilder
|
|
function GetQueryBuilder: TDAQueryBuilder; safecall;
|
|
function GetWhereBuilder: TDASQLWhereBuilder; safecall;
|
|
function GetUseMacroProcessor: Boolean; safecall;
|
|
procedure SetUseMacroProcessor(Value:Boolean); safecall;
|
|
property UseMacroProcessor: Boolean read GetUseMacroProcessor write SetUseMacroProcessor;
|
|
end;
|
|
|
|
IDAHETConnection = interface(IDABaseConnection)
|
|
['{9471FB7A-F5C6-4420-A2E6-F2DD7C6535A7}']
|
|
function GetConnectionForObject(const aObjectName: string; aOpenConnection: boolean = false): IDAConnection;
|
|
end;
|
|
|
|
{ IDATestableObject }
|
|
IDATestableObject = interface
|
|
['{DC2C3CD1-9031-4B0A-97B9-563580611C25}']
|
|
procedure Test; safecall;
|
|
end;
|
|
|
|
{ IDAUseGenerators }
|
|
IDAUseGenerators = interface
|
|
['{7963D550-361E-486A-AAD6-EFD12896F719}']
|
|
function GetNextAutoinc(const GeneratorName: string): integer; safecall;
|
|
end;
|
|
|
|
IDACanQueryGeneratorsNames = interface
|
|
['{E7C4A441-16B2-42BA-92DD-BD0F3EC39250}']
|
|
function GetGeneratorNames: IROStrings;
|
|
end;
|
|
|
|
{ IDAConnectionManager }
|
|
IDAConnectionManager = interface
|
|
['{C2C2B1DB-7D0A-4772-8DDF-5E5150A84827}']
|
|
function GetDefaultConnectionName: string;
|
|
function NewConnection(const aConnectionName: string;
|
|
OpenConnection: boolean = TRUE;
|
|
const UserID: string = '';
|
|
const Password: string = ''): IDAConnection;
|
|
|
|
procedure Clear;
|
|
end;
|
|
IDAConnectionPool = interface
|
|
['{6E132C7B-A6AD-4ECB-B901-80000AC4B912}']
|
|
procedure ReleaseConnection(const Conn: IDAConnection);
|
|
end;
|
|
|
|
{ IDASchema }
|
|
IDASchema = interface
|
|
['{19C63BF1-9CAA-43B7-B49C-E3FE82F5A02E}']
|
|
function GetDatasetText(const aConnection: IDAConnection; const aName: string): string;
|
|
function GetCommandText(const aConnection: IDAConnection; const aName: string): string;
|
|
|
|
function NewDataset(const aConnection: IDAConnection; const aName: string;
|
|
aStatementName: string='';
|
|
OpenIt: boolean = false): IDADataset; overload;
|
|
function NewDataset(const aConnection: IDAConnection; const aName: string;
|
|
const ParamNames: array of string;
|
|
const ParamValues: array of Variant;
|
|
OpenIt: boolean = TRUE;
|
|
aStatementName: string=''): IDADataset; overload;
|
|
function NewDataset(const aConnection: IDAConnection; const aName: string;
|
|
aDynSelectFields: array of string;
|
|
aWhereClause: WideString;
|
|
aStatementName: string='';
|
|
OpenIt: boolean = false; AlwaysGenerateDynamicWhereStatement: Boolean=False): IDADataset; overload;
|
|
function NewDataset(const aConnection: IDAConnection; const aName: string;
|
|
const ParamNames: array of string;
|
|
const ParamValues: array of Variant;
|
|
aDynSelectFields: array of string;
|
|
aWhereClause: WideString;
|
|
OpenIt: boolean = TRUE;
|
|
aStatementName: string=''): IDADataset; overload;
|
|
|
|
function NewCommand(const aConnection: IDAConnection; const aName: string;
|
|
aStatementName: string=''): IDASQLCommand; overload;
|
|
function NewCommand(const aConnection: IDAConnection; const aName: string;
|
|
const ParamNames: array of string;
|
|
const ParamValues: array of Variant;
|
|
ExecuteIt: boolean = TRUE;
|
|
aStatementName: string=''): IDASQLCommand; overload;
|
|
|
|
procedure Clear;
|
|
function MergeDataDictionaries: Boolean;
|
|
end;
|
|
|
|
{ TDAWhere
|
|
Represents an abstraction of the WHERE condition of a SQL statement in an IDADataset. }
|
|
TDAWhere = class
|
|
private
|
|
fFields: TDAFieldCollection;
|
|
fClause: string;
|
|
fOnChange: TNotifyEvent;
|
|
fChanged,
|
|
fClientFields: boolean;
|
|
fLastWasCondition: Boolean;
|
|
fDefaultOperator: TDADefaultOperator;
|
|
|
|
function GetEmpty: boolean;
|
|
function GetNotEmpty: boolean;
|
|
function GetProperName(aField: TDACustomField) : string;
|
|
|
|
protected
|
|
public
|
|
constructor Create(const aFields: TDAFieldCollection; aClientFields : boolean);
|
|
|
|
procedure Clear;
|
|
|
|
procedure AddOperator(aOperator: TDASQLOperator);
|
|
function AddCondition(const FieldName: string;
|
|
Condition: TDASQLCondition;
|
|
const Value: Variant;
|
|
SkipIfEmptyValue: boolean = TRUE): boolean;overload;
|
|
function AddCondition(const FieldName: string;
|
|
Condition: TDASQLCondition): boolean;overload;
|
|
procedure AddValueGroup(const FieldName: string;
|
|
const Values: array of Variant);
|
|
procedure AddSpaces(Count: integer = 1);
|
|
procedure AddText(const someText: string; MapClientFields : boolean = TRUE);
|
|
|
|
procedure OpenBraket; deprecated;
|
|
procedure CloseBraket; deprecated;
|
|
procedure OpenBracket;
|
|
procedure CloseBracket;
|
|
|
|
function AddConditions(const FieldNames : array of string;
|
|
const Conditions : array of TDASQLCondition;
|
|
const Values: array of Variant;
|
|
const Operator: TDASQLOperator) : integer;
|
|
|
|
property OnChange: TNotifyEvent read fOnChange write fOnChange;
|
|
|
|
property Clause: string read fClause;
|
|
property Fields: TDAFieldCollection read fFields write fFields;
|
|
property Empty : boolean read GetEmpty;
|
|
property NotEmpty : boolean read GetNotEmpty;
|
|
|
|
property ClientFields : boolean read fClientFields;
|
|
property DefaultOperator: TDADefaultOperator read fDefaultOperator write fDefaultOperator;
|
|
property LastWasCondition: Boolean read fLastWasCondition write fLastWasCondition;
|
|
property Changed: Boolean read fChanged write fChanged;
|
|
end;
|
|
|
|
{ IDASQLCommand
|
|
Base interface for SQL commands. It defines the common functionality shared by queries and stored procedures
|
|
that is providing access to a parameter list and being able to execute a statement which affects a certain
|
|
number of records. }
|
|
IDASQLCommand = interface
|
|
['{F57D2647-2DDE-4F69-86C5-CFACD6AC601F}']
|
|
// Properties readers/writers
|
|
function GetParams: TDAParamCollection; safecall;
|
|
function GetPrepared: boolean; safecall;
|
|
procedure SetPrepared(Value: boolean); safecall;
|
|
function GetWhere: TDAWhere; safecall; deprecated;
|
|
function GetDynamicWhere: TDAWhereBuilder; safecall;
|
|
procedure SetDynamicWhere(const Value: TDAWhereBuilder);safecall;
|
|
function SQLContainsDynamicWhere:boolean; safecall;
|
|
function GetSQL: string; safecall;
|
|
procedure SetSQL(const Value: string); safecall;
|
|
function GetDataset: TDataset; safecall;
|
|
function GetName: string; safecall;
|
|
function GetOnAfterExecute: TDAAfterExecuteCommandEvent; safecall;
|
|
function GetOnBeforeExecute: TDABeforeExecuteCommandEvent; safecall;
|
|
procedure SetOnAfterExecute(const Value: TDAAfterExecuteCommandEvent); safecall;
|
|
procedure SetOnBeforeExecute(const Value: TDABeforeExecuteCommandEvent); safecall;
|
|
function GetOnExecuteError: TDAExecuteCommandErrorEvent; safecall;
|
|
procedure SetOnExecuteError(const Value: TDAExecuteCommandErrorEvent); safecall;
|
|
|
|
// Methods
|
|
procedure RefreshParams; safecall;
|
|
function Execute: integer; safecall;
|
|
|
|
function ParamByName(const aName: string): TDAParam; safecall;
|
|
|
|
// Properties
|
|
property Name: string read GetName;
|
|
property Dataset: TDataSet read GetDataset;
|
|
property SQL: string read GetSQL write SetSQL;
|
|
property Params: TDAParamCollection read GetParams;
|
|
property Prepared: boolean read GetPrepared write SetPrepared;
|
|
{$WARN SYMBOL_DEPRECATED OFF}
|
|
property Where: TDAWhere read GetWhere;
|
|
{$WARN SYMBOL_DEPRECATED ON}
|
|
property DynamicWhere: TDAWhereBuilder read GetDynamicWhere write SetDynamicWhere;
|
|
|
|
property OnBeforeExecute: TDABeforeExecuteCommandEvent read GetOnBeforeExecute write SetOnBeforeExecute;
|
|
property OnAfterExecute: TDAAfterExecuteCommandEvent read GetOnAfterExecute write SetOnAfterExecute;
|
|
property OnExecuteError: TDAExecuteCommandErrorEvent read GetOnExecuteError write SetOnExecuteError;
|
|
end;
|
|
|
|
{ IDAMustSetParams
|
|
Implemented only by few SQL commands when we need to call PSSetParams after the parameter values
|
|
are written. For internal use only. See TDAEDataset.DoSetActive }
|
|
IDAMustSetParams = interface
|
|
['{575A8055-0200-44F1-AC5A-EF8604CBB489}']
|
|
procedure SetParamValues(Params: TDAParamCollection); safecall;
|
|
procedure GetParamValues(Params: TDAParamCollection); safecall;
|
|
end;
|
|
|
|
{ IDADataset
|
|
Provides access to a row set generated from a SQL select or a call to a stored procedure which
|
|
returns rows. IDADataset objects are created using the method IDAConnection.NewDataset.
|
|
Objects implementing this interface are equivalent to TDataset and in most cases simply wrap one. }
|
|
IDADataset = interface(IDASQLCommand)
|
|
['{8A3E5056-A8B9-4455-B82C-67E48CC39EA5}']
|
|
// Properties readers/writers
|
|
function GetRecordCount: integer; safecall;
|
|
function GetFieldCount: integer; safecall;
|
|
function GetFields: TDAFieldCollection; safecall;
|
|
function GetActive: boolean; safecall;
|
|
procedure SetActive(Value: boolean); safecall;
|
|
function GetEOF: boolean; safecall;
|
|
function GetFieldValues(Index: integer): Variant; safecall;
|
|
function GetNames(Index: integer): string; safecall;
|
|
function GetIsEmpty : boolean; safecall;
|
|
function GetLogicalName : string; safecall;
|
|
procedure SetLogicalName(aName : string); safecall;
|
|
|
|
function GetOnAfterOpen: TDAAfterOpenDatasetEvent; safecall;
|
|
function GetOnBeforeOpen: TDABeforeOpenDatasetEvent; safecall;
|
|
procedure SetOnAfterOpen(const Value: TDAAfterOpenDatasetEvent); safecall;
|
|
procedure SetOnBeforeOpen(const Value: TDABeforeOpenDatasetEvent); safecall;
|
|
function GetOnOpenError: TDAOpenDatasetErrorEvent; safecall;
|
|
procedure SetOnOpenError(const Value: TDAOpenDatasetErrorEvent); safecall;
|
|
|
|
// Methods
|
|
procedure Open; safecall;
|
|
procedure Close; safecall;
|
|
|
|
procedure EnableControls; safecall;
|
|
procedure DisableControls; safecall;
|
|
|
|
|
|
procedure Next; safecall;
|
|
|
|
function FieldByName(const aName: string): TDAField; safecall;
|
|
function FindField(const aName: string): TDAField; safecall;
|
|
|
|
function GetCurrentRecIdValue: integer;
|
|
procedure SetCurrentRecIdValue(Value: integer);
|
|
|
|
function GetRowRecIDValue: integer;
|
|
|
|
procedure EnableConstraints; safecall;
|
|
procedure DisableConstraints; safecall;
|
|
|
|
function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; safecall;
|
|
function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; safecall;
|
|
|
|
property RowRecIdValue: integer read GetRowRecIdValue;
|
|
property CurrentRecIdValue: integer read GetCurrentRecIdValue write SetCurrentRecIdValue;
|
|
// Properties
|
|
property IsEmpty : boolean read GetIsEmpty;
|
|
(* property BOF: boolean read GetBOF;*)
|
|
property EOF: boolean read GetEOF;
|
|
property RecordCount: integer read GetRecordCount;
|
|
property Fields: TDAFieldCollection read GetFields;
|
|
property Active: boolean read GetActive write SetActive;
|
|
property FieldCount: integer read GetFieldCount;
|
|
property FieldValues[Index: integer]: Variant read GetFieldValues;
|
|
property Names[Index: integer]: string read GetNames;
|
|
property LogicalName : string read GetLogicalName write SetLogicalName;
|
|
|
|
property OnBeforeOpen: TDABeforeOpenDatasetEvent read GetOnBeforeOpen write SetOnBeforeOpen;
|
|
property OnAfterOpen: TDAAfterOpenDatasetEvent read GetOnAfterOpen write SetOnAfterOpen;
|
|
property OnOpenError: TDAOpenDatasetErrorEvent read GetOnOpenError write SetOnOpenError;
|
|
|
|
end;
|
|
|
|
IDADatasetEx = interface(IDADataset)
|
|
['{BB588B03-620E-43AD-B77E-EFD35F303112}']
|
|
function GetBOF: boolean; safecall;
|
|
procedure Refresh; safecall;
|
|
function GetBookMark: pointer; safecall;
|
|
procedure GotoBookmark(Bookmark: TBookmark); safecall;
|
|
procedure FreeBookmark(Bookmark: TBookmark); safecall;
|
|
|
|
function GetState : TDatasetState; safecall;
|
|
property State : TDatasetState read GetState;
|
|
end;
|
|
|
|
{ IDAEditableDataset }
|
|
IDAEditableDataset = interface(IDADatasetEx)
|
|
['{D3E2147F-65B3-4D9D-8614-7270011FA7D5}']
|
|
procedure Edit; safecall;
|
|
procedure Insert; safecall;
|
|
procedure Post; safecall;
|
|
procedure Cancel; safecall;
|
|
procedure Append; safecall;
|
|
procedure Delete; safecall;
|
|
|
|
procedure Prior; safecall;
|
|
procedure First; safecall;
|
|
procedure Last; safecall;
|
|
|
|
procedure AddRecord(const FieldNames : array of string; const FieldValues : array of Variant); safecall;
|
|
|
|
procedure EnableEventHandlers; safecall;
|
|
procedure DisableEventHandlers; safecall;
|
|
end;
|
|
|
|
{ IDAStoredProcedure
|
|
Provides access to stored database procedures.
|
|
IDAStoredProcedure objects are created using the method IDAConnection.NewStoredProcedure.}
|
|
IDAStoredProcedure = interface(IDASQLCommand)
|
|
['{6D9C806F-65A5-43B3-8F07-4ED782A13A0A}']
|
|
// Properties readers/writers
|
|
function GetStoredProcedureName: string; safecall;
|
|
procedure SetStoredProcedureName(const Name: string); safecall;
|
|
|
|
// Methods
|
|
function Execute: integer; safecall;
|
|
|
|
// Properties
|
|
property StoredProcedureName: string read GetStoredProcedureName write SetStoredProcedureName;
|
|
end;
|
|
|
|
{ IDADatasetPersist }
|
|
IDADatasetPersist = interface
|
|
['{D6F850CD-9204-4953-A54F-1E622AA993B6}']
|
|
function Persist(const aQuery: IDADataset; MaxRecords: integer; out Data: IROStream): integer;
|
|
end;
|
|
|
|
{ IDADatasetResolver }
|
|
IDADatasetResolver = interface
|
|
['{D6F850CD-9204-4953-A54F-1E622AA993B6}']
|
|
procedure Resolve(const Data: IROStream; const aQuery: IDADataset; MaxErrors: integer);
|
|
end;
|
|
|
|
{ IDALoginInfoAware }
|
|
IDALoginInfoAware = interface
|
|
['{755615F0-4208-459A-B1C4-97EA5A3DB346}']
|
|
function GetLoginInfo : TDALoginInfo;
|
|
procedure SetLoginInfo(aValue : TDALoginInfo);
|
|
|
|
property LoginInfo : TDALoginInfo read GetLoginInfo write SetLoginInfo;
|
|
end;
|
|
|
|
{ TDALoginInfoAware }
|
|
TDALoginInfoAware = class(TInterfacedObject, IDALoginInfoAware)
|
|
private
|
|
fLoginInfo : TDALoginInfo;
|
|
|
|
protected
|
|
{ IDALoginInfoAware }
|
|
function GetLoginInfo : TDALoginInfo;
|
|
procedure SetLoginInfo(aValue : TDALoginInfo);
|
|
|
|
{ IInterface }
|
|
function _AddRef: Integer; stdcall;
|
|
function _Release: Integer; stdcall;
|
|
|
|
end;
|
|
|
|
{ IDASimpleClonedCursorsSupport }
|
|
IDASimpleClonedCursorsSupport = interface
|
|
['{39D05665-5B13-4EC3-B31E-D39CBEA52AC6}']
|
|
function GetSimpleCloneSource : TObject;
|
|
end;
|
|
|
|
IDAMemDatasetBatchAdding = interface
|
|
['{73A4A297-2938-46EB-8D0C-2F8FB58046E2}']
|
|
function AllocRecordBuffer: PChar;
|
|
procedure FreeRecordBuffer(var Buffer: PChar);
|
|
function GetFieldNativeBuffer(Buffer: PChar; Field: TField): Pointer;
|
|
function MakeBlobFromString(Blob:String): pointer;
|
|
procedure AppendBuffer(Buffer: Pchar);
|
|
procedure SetNullMask(Buffer: PChar; Field: TField; const Value: boolean);
|
|
procedure SetAnsiString(NativeBuf: Pointer; Field: TField; const Value: Ansistring);
|
|
procedure SetWideString(NativeBuf: Pointer; Field: TField; const Value: Widestring);
|
|
procedure FinalizeBatchAdding;
|
|
end;
|
|
|
|
{ TDADataSource }
|
|
TDABaseDataSource = class(TDataSource)
|
|
end;
|
|
|
|
const
|
|
DADataTypeNames: array[Low(TDADataType)..High(TDADataType)] of string = ('Unknown',
|
|
'String',
|
|
'DateTime',
|
|
'Float',
|
|
'Currency',
|
|
'AutoInc',
|
|
'Integer',
|
|
'LargeInt',
|
|
'Boolean',
|
|
'Memo',
|
|
'Blob',
|
|
'WideString',
|
|
'WideMemo',
|
|
'LargeAutoInc',
|
|
'Byte',
|
|
'ShortInt',
|
|
'Word',
|
|
'SmallInt',
|
|
'Cardinal',
|
|
'LargeUInt',
|
|
'Guid',
|
|
'Xml',
|
|
'Decimal',
|
|
'SingleFloat');
|
|
DADataTypesMappings: array[TDADataType] of TFieldType = (
|
|
ftUnknown, ftString, ftDateTime, ftFloat, ftCurrency, ftAutoInc, ftInteger,
|
|
ftLargeInt, ftBoolean, ftMemo, ftBlob, ftWideString,
|
|
{$IFNDEF DELPHI10UP}ftMemo{$ELSE}ftWideMemo{$ENDIF DELPHI10UP},
|
|
ftLargeInt, ftSmallint, ftSmallint, ftWord, ftSmallint, ftInteger, ftLargeint,
|
|
ftGuid, ftWideString, ftFMTBcd, ftFloat);
|
|
|
|
function VCLTypeToDAType(aFieldType: TFieldType): TDADataType;
|
|
function DATypeToVCLType(aDAType: TDADataType): TFieldType;
|
|
|
|
{ Cross-platform GetTickCount }
|
|
function ROGetTickCount: Cardinal;
|
|
|
|
{ Variant converters }
|
|
function GetVarBoolean(const Value: Variant): boolean;
|
|
function GetVarCurrency(const Value: Variant): currency;
|
|
function GetVarDateTime(const Value: Variant): TDateTime;
|
|
function GetVarFloat(const Value: Variant): double;
|
|
function GetVarInteger(const Value: Variant): integer;
|
|
function GetVarString(const Value: Variant): string;
|
|
function GetVarInt64(const Value: Variant): Int64;
|
|
function GetVarWideString(const Value: Variant): WideString;
|
|
function GetVarByte(const Value: Variant): Byte;
|
|
function GetVarShortInt(const Value: Variant): ShortInt;
|
|
function GetVarWord(const Value: Variant): Word;
|
|
function GetVarSmallInt(const Value: Variant): SmallInt;
|
|
function GetVarCardinal(const Value: Variant): Cardinal;
|
|
function GetVarLargeUInt(const Value: Variant): Int64;
|
|
function GetVarGuid(const Value: Variant): TGuid;
|
|
function GetVarXml(const Value: Variant): IXMLNode;
|
|
function GetVarDecimal(const Value: Variant): TBCD;
|
|
function GetVarSingleFloat(const Value: Variant): Single;
|
|
function TestDefaultValue(const DefaultValue: string; DataType: TDADataType): Boolean;
|
|
|
|
{ Misc }
|
|
function NewDatasetParam(anArray : TDADatasetParamArray; Name : string; Value : Variant) : TDADatasetParam;
|
|
function NewDatasetRequestInfo(anArray : TDADatasetRequestInfoArray;
|
|
DatasetName : string;
|
|
ParamNames : array of string;
|
|
ParamValues : array of variant;
|
|
IncludeSchema : boolean = FALSE;
|
|
MaxRecords : integer = -1) : TDADatasetRequestInfo;
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$IFDEF DataAbstract_Trial}
|
|
Forms, Dialogs, //Windows,
|
|
{$ENDIF DataAbstract_Trial}
|
|
TypInfo, Variants,
|
|
uDARes, uROBinaryHelpers, {uDAClasses, uDADataTable,} uDAWhere
|
|
{$IFDEF MSWINDOWS}
|
|
,Windows
|
|
{$ENDIF}
|
|
{$IFDEF LINUX}
|
|
,Libc
|
|
{$ENDIF LINUX};
|
|
|
|
{ Cross-platform GetTickCount }
|
|
{$IFDEF LINUX}
|
|
// This has been grabbed from IdGlobal.pas. Needs to be tested under Kylix just in case
|
|
function ROGetTickCount: Cardinal;
|
|
var
|
|
tv: timeval;
|
|
begin
|
|
gettimeofday(tv, nil);
|
|
{$RANGECHECKS OFF}
|
|
Result := int64(tv.tv_sec) * 1000 + tv.tv_usec div 1000;
|
|
{$RANGECHECKS ON}
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF MSWINDOWS}
|
|
function ROGetTickCount: Cardinal;
|
|
begin
|
|
result := Windows.GetTickCount;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{ Variant converters }
|
|
function GetVarBoolean(const Value: Variant): boolean;
|
|
begin
|
|
if VarIsNull(Value) then
|
|
result := FALSE
|
|
else
|
|
result := Value;
|
|
end;
|
|
|
|
function GetVarCurrency(const Value: Variant): currency;
|
|
begin
|
|
if VarIsNull(Value) then
|
|
result := 0
|
|
else
|
|
result := Value;
|
|
end;
|
|
|
|
function GetVarDateTime(const Value: Variant): TDateTime;
|
|
begin
|
|
if VarIsNull(Value) then
|
|
result := 0
|
|
else
|
|
result := Value;
|
|
end;
|
|
|
|
function GetVarFloat(const Value: Variant): double;
|
|
begin
|
|
if VarIsNull(Value) then
|
|
result := 0
|
|
else
|
|
result := Value;
|
|
end;
|
|
|
|
function GetVarInteger(const Value: Variant): integer;
|
|
begin
|
|
if VarIsNull(Value) then
|
|
result := 0
|
|
else
|
|
result := Value;
|
|
end;
|
|
|
|
function GetVarString(const Value: Variant): string;
|
|
begin
|
|
if VarIsNull(Value) then
|
|
result := ''
|
|
else
|
|
result := Value;
|
|
end;
|
|
|
|
function GetVarInt64(const Value: Variant): Int64;
|
|
begin
|
|
if VarIsNull(Value) then
|
|
result := 0
|
|
else
|
|
result := Value;
|
|
end;
|
|
|
|
function GetVarWideString(const Value: Variant): WideString;
|
|
begin
|
|
if VarIsnull(Value) then
|
|
Result := ''
|
|
else
|
|
Result := Value;
|
|
end;
|
|
|
|
function GetVarByte(const Value: Variant): Byte;
|
|
begin
|
|
if VarIsnull(Value) then
|
|
Result := 0
|
|
else
|
|
Result := Value;
|
|
end;
|
|
|
|
function GetVarShortInt(const Value: Variant): ShortInt;
|
|
begin
|
|
if VarIsnull(Value) then
|
|
Result := 0
|
|
else
|
|
Result := Value;
|
|
end;
|
|
|
|
function GetVarWord(const Value: Variant): Word;
|
|
begin
|
|
if VarIsnull(Value) then
|
|
Result := 0
|
|
else
|
|
Result := Value;
|
|
end;
|
|
|
|
function GetVarSmallInt(const Value: Variant): SmallInt;
|
|
begin
|
|
if VarIsnull(Value) then
|
|
Result := 0
|
|
else
|
|
Result := Value;
|
|
end;
|
|
|
|
function GetVarCardinal(const Value: Variant): Cardinal;
|
|
begin
|
|
if VarIsnull(Value) then
|
|
Result := 0
|
|
else
|
|
Result := Value;
|
|
end;
|
|
|
|
function GetVarLargeUInt(const Value: Variant): Int64;
|
|
begin
|
|
if VarIsnull(Value) then
|
|
Result := 0
|
|
else
|
|
Result := Value;
|
|
end;
|
|
|
|
function GetVarGuid(const Value: Variant): TGuid;
|
|
begin
|
|
if VarIsnull(Value) then
|
|
FillChar(Result, sizeof(Result), 0)
|
|
else
|
|
Result := StringToGuid(Value);
|
|
end;
|
|
|
|
function GetVarXml(const Value: Variant): IXMLNode;
|
|
var
|
|
lDoc: IXMLDocument;
|
|
begin
|
|
if VarIsnull(Value) then
|
|
Result := nil
|
|
else begin
|
|
lDoc := NewROXmlDocument;
|
|
lDoc.New;
|
|
lDoc.XML := Value;
|
|
Result := lDoc.DocumentNode;
|
|
end;
|
|
end;
|
|
|
|
function GetVarDecimal(const Value: Variant): TBCD;
|
|
begin
|
|
Result := VariantToBCD(Value);
|
|
end;
|
|
|
|
function GetVarSingleFloat(const Value: Variant): Single;
|
|
begin
|
|
if VarIsnull(Value) then
|
|
Result := 0
|
|
else
|
|
Result := Value;
|
|
end;
|
|
|
|
|
|
function TestDefaultValue(const DefaultValue: string; DataType: TDADataType): Boolean;
|
|
var
|
|
aDecimal: TDecimal;
|
|
begin
|
|
try
|
|
case DataType of
|
|
datString: ;
|
|
datDateTime: VarAsType(DefaultValue, varDate);
|
|
datFloat: VarAsType(DefaultValue, varDouble);
|
|
datDecimal: if not VarByteArrayToDecimal(DefaultValue,aDecimal) then VarAsType(DefaultValue, VarFMTBcd);
|
|
datCurrency: VarAsType(DefaultValue, varCurrency);
|
|
datAutoInc,
|
|
datInteger: VarAsType(DefaultValue, varInteger);
|
|
datLargeInt: VarAsType(DefaultValue, varInt64);
|
|
datBoolean: VarAsType(DefaultValue, varBoolean);
|
|
datMemo: VarAsType(DefaultValue, varString);
|
|
datBlob: begin Result := False; exit; end;
|
|
datWideString: VarAsType(DefaultValue, varOleStr);
|
|
datWideMemo: VarAsType(DefaultValue, varOleStr);
|
|
else
|
|
begin
|
|
result := false;
|
|
exit;
|
|
end;
|
|
end;
|
|
result := true;
|
|
except
|
|
result := false;
|
|
end;
|
|
end;
|
|
|
|
{ EDADriverLoadException }
|
|
|
|
constructor EDADriverLoadException.Create(anErrorCode: integer;
|
|
const anErrorMessage: string);
|
|
begin
|
|
inherited Create(anErrorMessage);
|
|
|
|
fErrorCode := anErrorCode;
|
|
end;
|
|
|
|
function VCLTypeToDAType(aFieldType: TFieldType): TDADataType;
|
|
begin
|
|
result := datUnknown;
|
|
case aFieldType of
|
|
ftUnknown: result := datUnknown;
|
|
|
|
ftAutoInc: result := datAutoInc;
|
|
|
|
ftGuid: Result:= datGuid;
|
|
|
|
ftFixedChar,
|
|
ftString: result := datString;
|
|
|
|
ftLargeint: result := datLargeInt;
|
|
|
|
ftSmallint: Result := datSmallInt;
|
|
ftWord: Result:= datWord;
|
|
ftInteger: result := datInteger;
|
|
|
|
ftFloat: result := datFloat;
|
|
ftBCD,
|
|
ftFMTBcd: Result := datDecimal;
|
|
ftCurrency: result := datCurrency;
|
|
|
|
ftTimeStamp,
|
|
ftDate,
|
|
ftTime,
|
|
ftDateTime: result := datDateTime;
|
|
|
|
ftMemo,
|
|
ftFmtMemo: result := datMemo;
|
|
|
|
ftBytes, ftTypedBinary,
|
|
ftVarBytes,
|
|
ftBlob,
|
|
ftGraphic,
|
|
ftOraBlob,
|
|
ftOraClob: result := datBlob;
|
|
|
|
ftBoolean: result := datBoolean;
|
|
ftWideString: Result := datWideString;
|
|
{$IFDEF DELPHI10UP}
|
|
ftWideMemo: Result:= datWideMemo;
|
|
{$ENDIF DELPHI10UP}
|
|
else
|
|
RaiseError(err_FieldTypeNotSupported, [GetEnumName(TypeInfo(TFieldType), Ord(aFieldType)), Ord(aFieldType)]);
|
|
end;
|
|
end;
|
|
|
|
function DATypeToVCLType(aDAType: TDADataType): TFieldType;
|
|
begin
|
|
result := DADataTypesMappings[aDAType];
|
|
end;
|
|
|
|
{ Misc }
|
|
function NewDatasetParam(anArray : TDADatasetParamArray; Name : string; Value : Variant) : TDADatasetParam;
|
|
begin
|
|
result := anArray.Add;
|
|
result.Name := Name;
|
|
result.Value := Value;
|
|
end;
|
|
|
|
function NewDatasetRequestInfo(anArray : TDADatasetRequestInfoArray;
|
|
DatasetName : string;
|
|
ParamNames : array of string;
|
|
ParamValues : array of variant;
|
|
IncludeSchema : boolean = FALSE;
|
|
MaxRecords : integer = -1) : TDADatasetRequestInfo;
|
|
var i : integer;
|
|
begin
|
|
if (Length(ParamNames)<>Length(ParamValues))
|
|
then raise EROUserError.Create('ParamNames and ParamValues arrays don''t contain the same number of items');
|
|
|
|
result := anArray.Add;
|
|
|
|
result.DatasetName := DatasetName;
|
|
result.MaxRecords := MaxRecords;
|
|
result.IncludeSchema := IncludeSchema;
|
|
|
|
if (Length(ParamNames)>0) then begin
|
|
result.Params := TDADatasetParamArray.Create;
|
|
for i := 0 to (Length(ParamNames)-1) do
|
|
NewDatasetParam(result.Params, ParamNames[i], ParamValues[i]);
|
|
end
|
|
else result.Params := NIL;
|
|
end;
|
|
|
|
{ TDAStatementCollection }
|
|
|
|
function TDAStatementCollection.Add: TDAStatement;
|
|
begin
|
|
result := TDAStatement(inherited Add);
|
|
end;
|
|
|
|
function TDAStatementCollection.FindItem(const aName: string; const aStatementName: string=''; const aConnectionType: string = ''; aReturnDefault: Boolean = false): TDAStatement;
|
|
var
|
|
i: integer;
|
|
lDef, lStatement:TDAStatement;
|
|
begin
|
|
result := nil;
|
|
lDef := nil;
|
|
for i := 0 to (Count - 1) do begin
|
|
lStatement := Items[i] as TDAStatement;
|
|
if lStatement.Default then lDef := lStatement;
|
|
if
|
|
((aConnectionType <> '') and (SameText(lStatement.ConnectionType, aConnectionType))) or
|
|
SameText(lStatement.Connection, aName) and
|
|
((aStatementName = '') or SameText(lStatement.Name, aStatementName)) then begin
|
|
result := lStatement;
|
|
exit;
|
|
end;
|
|
end;
|
|
if aReturnDefault then result := lDef;
|
|
end;
|
|
|
|
constructor TDAStatementCollection.Create(aOwner: TPersistent; aSQLCommand: TDASQLCommand);
|
|
begin
|
|
inherited Create(aOwner, TDAStatement);
|
|
FAllowEmptyName := True;
|
|
fSQLCommand := aSQLCommand;
|
|
end;
|
|
|
|
function TDAStatementCollection.GetItemName(
|
|
anItem: TCollectionItem): string;
|
|
begin
|
|
result := GetPropValue(anItem, 'Connection', TRUE);
|
|
end;
|
|
|
|
function TDAStatementCollection.GetStatements(
|
|
Index: integer): TDAStatement;
|
|
begin
|
|
result := TDAStatement(inherited Items[Index])
|
|
end;
|
|
|
|
function TDAStatementCollection.SetItemName(anItem: TCollectionItem;
|
|
const aName: string): string;
|
|
begin
|
|
SetPropValue(anItem, 'Connection', aName);
|
|
end;
|
|
|
|
procedure TDAStatementCollection.SetStatements(Index: integer;
|
|
const Value: TDAStatement);
|
|
begin
|
|
Statements[Index].Assign(Value);
|
|
end;
|
|
|
|
function TDAStatementCollection.StatementByName(
|
|
const aName: string): TDAStatement;
|
|
begin
|
|
result := TDAStatement(inherited ItemByName(aName));
|
|
end;
|
|
|
|
{ TDABaseField }
|
|
|
|
procedure TDABaseField.Assign(Source: TPersistent);
|
|
begin
|
|
if (Source is TDABaseField) then begin
|
|
AssignField(TDABaseField(Source));
|
|
end
|
|
else begin
|
|
inherited;
|
|
end;
|
|
end;
|
|
|
|
procedure TDABaseField.AssignField(Source: TDABaseField);
|
|
begin
|
|
fSize := Source.fSize;
|
|
fDescription := Source.fDescription;
|
|
fName := Source.fName;
|
|
fDataType := Source.fDataType;
|
|
fValue := Source.fValue;
|
|
fBlobType := Source.fBlobType;
|
|
fGeneratorName := Source.GeneratorName;
|
|
FDecimalPrecision := Source.FDecimalPrecision;
|
|
FDecimalScale := Source.FDecimalScale;
|
|
end;
|
|
|
|
{procedure TDABaseField.FixSize;
|
|
begin
|
|
if (fDataType <> datString) then fSize := 0;
|
|
end;}
|
|
|
|
function TDABaseField.GetDataType: TDADataType;
|
|
begin
|
|
if not HasValidDictionaryField then begin
|
|
result := fDataType
|
|
end
|
|
else begin
|
|
result := GetDictionaryField().DataType;
|
|
end;
|
|
end;
|
|
|
|
function TDABaseField.GetDescription: string;
|
|
begin
|
|
if not HasValidDictionaryField then begin
|
|
result := fDescription;
|
|
end
|
|
else begin
|
|
result := GetDictionaryField().Description;
|
|
end;
|
|
end;
|
|
|
|
function TDABaseField.GetName: string;
|
|
begin
|
|
result := fName
|
|
end;
|
|
|
|
function TDABaseField.GetSize: integer;
|
|
begin
|
|
if (DataType <> datString) and (DataType <> datWideString) then begin
|
|
result := 0;
|
|
end
|
|
else begin
|
|
if not HasValidDictionaryField then begin
|
|
result := fSize
|
|
end
|
|
else begin
|
|
result := GetDictionaryField().Size;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TDABaseField.GetValue: Variant;
|
|
begin
|
|
result := fValue
|
|
end;
|
|
|
|
procedure TDABaseField.SetDataType(Value: TDADataType);
|
|
begin
|
|
fDataType := Value;
|
|
//FixSize();
|
|
end;
|
|
|
|
procedure TDABaseField.SetDescription(const Value: string);
|
|
begin
|
|
fDescription := Value;
|
|
end;
|
|
|
|
procedure TDABaseField.SetName(const Value: string);
|
|
var
|
|
lOldName: string;
|
|
begin
|
|
lOldName := fName;
|
|
fName := Value;
|
|
if lOldName <> '' then
|
|
(Collection as TSearcheableCollection).TriggerOnItemRenamed(lOldName, fName);
|
|
end;
|
|
|
|
procedure TDABaseField.SetSize(Value: integer);
|
|
begin
|
|
fSize := Value;
|
|
//FixSize();
|
|
end;
|
|
|
|
procedure TDABaseField.SetValue(const aValue: Variant);
|
|
begin
|
|
fValue := aValue
|
|
end;
|
|
|
|
function TDABaseField.GetAsBoolean: boolean;
|
|
begin
|
|
result := GetVarBoolean(Value);
|
|
//if VarIsNull(Value) then result := FALSE else result := Value;
|
|
end;
|
|
|
|
function TDABaseField.GetAsCurrency: currency;
|
|
begin
|
|
result := GetVarCurrency(Value);
|
|
//if VarIsNull(Value) then result := 0 else result := Value;
|
|
end;
|
|
|
|
function TDABaseField.GetAsDateTime: TDateTime;
|
|
begin
|
|
result := GetVarDateTime(Value);
|
|
//if VarIsNull(Value) then result := 0 else result := Value;
|
|
end;
|
|
|
|
function TDABaseField.GetAsFloat: double;
|
|
begin
|
|
result := GetVarFloat(Value);
|
|
//if VarIsNull(Value) then result := 0 else result := Value;
|
|
end;
|
|
|
|
function TDABaseField.GetAsInteger: integer;
|
|
begin
|
|
result := GetVarInteger(Value);
|
|
//if VarIsNull(Value) then result := 0 else result := Value;
|
|
end;
|
|
|
|
function TDABaseField.GetAsString: string;
|
|
begin
|
|
result := GetVarString(Value);
|
|
//if VarIsNull(Value) then result := '' else result := Value;
|
|
end;
|
|
|
|
function TDABaseField.GetAsVariant: variant;
|
|
begin
|
|
result := Value
|
|
end;
|
|
|
|
procedure TDABaseField.SetAsBoolean(const aValue: boolean);
|
|
begin
|
|
Value := aValue;
|
|
end;
|
|
|
|
procedure TDABaseField.SetAsCurrency(const aValue: currency);
|
|
begin
|
|
Value := aValue;
|
|
end;
|
|
|
|
procedure TDABaseField.SetAsDateTime(const aValue: TDateTime);
|
|
begin
|
|
Value := aValue;
|
|
end;
|
|
|
|
procedure TDABaseField.SetAsFloat(const aValue: double);
|
|
begin
|
|
Value := aValue;
|
|
end;
|
|
|
|
procedure TDABaseField.SetAsString(const aValue: string);
|
|
begin
|
|
Value := aValue;
|
|
end;
|
|
|
|
procedure TDABaseField.SetAsVariant(const aValue: variant);
|
|
begin
|
|
Value := aValue;
|
|
end;
|
|
|
|
procedure TDABaseField.SetAsInteger(const aValue: integer);
|
|
begin
|
|
Value := aValue;
|
|
end;
|
|
|
|
function TDABaseField.GetDisplayName: string;
|
|
begin
|
|
//result := Format('%s %-20s [%s, %d]', [GetName, '', GetEnumName(TypeInfo(TDADataType), Ord(DataType)), Size]);
|
|
result := GetName;
|
|
end;
|
|
|
|
function TDABaseField.GetNamePath: string;
|
|
begin
|
|
if (Collection <> nil) then
|
|
result := Collection.GetNamePath + Name
|
|
else
|
|
result := inherited GetNamePath;
|
|
|
|
result := inherited GetNamePath;
|
|
end;
|
|
|
|
function TDABaseField.GetDictionaryEntry: string;
|
|
begin
|
|
result := fDictionaryEntry
|
|
end;
|
|
|
|
procedure TDABaseField.SetDictionaryEntry(const Value: string);
|
|
begin
|
|
fDictionaryEntry := Value
|
|
end;
|
|
|
|
function TDABaseField.FindDictionaryField: TDACustomField;
|
|
var
|
|
lOwner: TObject;
|
|
lHasDict: IDAHasDataDictionary;
|
|
lDictionary: IDADataDictionary;
|
|
begin
|
|
result := nil;
|
|
if DictionaryEntry = '' then exit;
|
|
|
|
lDictionary := TDACustomFieldCollection(Collection).DataDictionary;
|
|
|
|
{ No Dictionary assigned? then try getting dictionary from owning Schema }
|
|
if not Assigned(lDictionary) then begin
|
|
lOwner := TDACustomFieldCollection(Collection).Owner;
|
|
if not (lOwner is TDADataSet) then exit;
|
|
|
|
lOwner := TDADatasetCollection(TDADataSet(lOwner).Collection).Owner;
|
|
// if not (lOwner is TDASchema) then exit;
|
|
|
|
// lDictionary := TDASchema(lOwner).DataDictionary;
|
|
if Supports(lOwner, IDAHasDataDictionary, lHasDict) then
|
|
lDictionary := lHasDict.DataDictionary;
|
|
end;
|
|
|
|
if Assigned(lDictionary) then
|
|
result := lDictionary.Fields.FindField(DictionaryEntry);
|
|
end;
|
|
|
|
function TDABaseField.GetDictionaryField: TDACustomField;
|
|
begin
|
|
result := FindDictionaryField();
|
|
if not Assigned(result) then
|
|
RaiseError('Dictionary entry %s not found for field %s', [DictionaryEntry, Name])
|
|
end;
|
|
|
|
function TDABaseField.HasValidDictionaryField: Boolean;
|
|
begin
|
|
result := (DictionaryEntry <> '') and
|
|
Assigned(FindDictionaryField());
|
|
end;
|
|
|
|
function TDABaseField.IsCompatibleV4: boolean;
|
|
begin
|
|
Result:=False;
|
|
end;
|
|
|
|
function TDABaseField.StoreDataType: Boolean;
|
|
begin
|
|
result := MergeDatadictionaries or not HasValidDictionaryField();
|
|
end;
|
|
|
|
|
|
function TDABaseField.StoreDecimalPrecision: Boolean;
|
|
begin
|
|
Result:= (MergeDatadictionaries or (FDecimalPrecision <>0)) and not IsCompatibleV4;
|
|
end;
|
|
|
|
function TDABaseField.StoreDecimalScale: Boolean;
|
|
begin
|
|
Result:= (MergeDatadictionaries or (FDecimalScale <>0)) and not IsCompatibleV4;
|
|
end;
|
|
|
|
function TDABaseField.StoreGeneratorName: Boolean;
|
|
begin
|
|
result := MergeDatadictionaries or not HasValidDictionaryField();
|
|
end;
|
|
|
|
function TDABaseField.StoreDescription: Boolean;
|
|
begin
|
|
result := MergeDatadictionaries or not HasValidDictionaryField();
|
|
end;
|
|
|
|
function TDABaseField.StoreSize: Boolean;
|
|
begin
|
|
result := MergeDatadictionaries or (((DataType = datString) or (DataType = datWideString)) and (not HasValidDictionaryField()));
|
|
end;
|
|
|
|
function TDABaseField.GetBlobType: TDABlobType;
|
|
begin
|
|
if HasValidDictionaryField
|
|
then result := GetDictionaryField().BlobType
|
|
else result := fBlobType
|
|
end;
|
|
|
|
function TDABaseField.GetGeneratorName: string;
|
|
begin
|
|
if not HasValidDictionaryField then begin
|
|
result := fGeneratorName
|
|
end
|
|
else begin
|
|
result := GetDictionaryField().GeneratorName;
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
procedure TDABaseField.SetBlobType(const Value: TDABlobType);
|
|
begin
|
|
fBlobType := Value;
|
|
end;
|
|
|
|
function TDABaseField.StoreBlobType: boolean;
|
|
begin
|
|
result := HasValidDictionaryField;
|
|
end;
|
|
|
|
procedure TDABaseField.Clear;
|
|
begin
|
|
Value := Null;
|
|
end;
|
|
|
|
procedure TDABaseField.SetGeneratorName(const aValue: string);
|
|
begin
|
|
fGeneratorName := aValue
|
|
end;
|
|
|
|
procedure TDABaseField.SetDisplayName(const Value: string);
|
|
begin
|
|
inherited;
|
|
fName := Value;
|
|
end;
|
|
|
|
function TDABaseField.GetAsLargeInt: int64;
|
|
begin
|
|
Result := GetVarInt64(Value);
|
|
end;
|
|
|
|
procedure TDABaseField.SetAsLargeInt(const aValue: Int64);
|
|
begin
|
|
Value := aValue;
|
|
end;
|
|
|
|
function TDABaseField.GetAsWideString: Widestring;
|
|
begin
|
|
Result := GetVarWideString(Value);
|
|
end;
|
|
|
|
procedure TDABaseField.SetAsWideString(const aValue: Widestring);
|
|
begin
|
|
Value := aValue;
|
|
end;
|
|
|
|
function TDABaseField.GetIsNull: boolean;
|
|
begin
|
|
result := VarIsNull(Value);
|
|
end;
|
|
|
|
|
|
function TDABaseField.GetBlobSize: Integer;
|
|
var
|
|
v: Variant;
|
|
begin
|
|
v := GetValue;
|
|
if VarIsArray(v) then result := VarArrayHighBound(V, 1) - VarArrayLowBound(V, 1) + 1
|
|
else if VarIsStr(v) then result := Length(v) else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TDABaseField.GetAsByte: Byte;
|
|
begin
|
|
result := GetVarByte(Value);
|
|
end;
|
|
|
|
function TDABaseField.GetAsCardinal: Cardinal;
|
|
begin
|
|
result := GetVarCardinal(Value);
|
|
end;
|
|
|
|
function TDABaseField.GetAsDecimal: TBcd;
|
|
begin
|
|
result := GetVarDecimal(Value);
|
|
end;
|
|
|
|
function TDABaseField.GetAsGuid: TGUID;
|
|
begin
|
|
result := GetVarGuid(Value);
|
|
end;
|
|
|
|
function TDABaseField.GetAsLargeUInt: Int64;
|
|
begin
|
|
Result := GetVarInt64(Value);
|
|
end;
|
|
|
|
function TDABaseField.GetAsShortInt: ShortInt;
|
|
begin
|
|
result := GetVarShortInt(Value);
|
|
end;
|
|
|
|
function TDABaseField.GetAsSingle: Single;
|
|
begin
|
|
result := GetVarSingleFloat(Value);
|
|
end;
|
|
|
|
function TDABaseField.GetAsSmallInt: SmallInt;
|
|
begin
|
|
result := GetVarSmallInt(Value);
|
|
end;
|
|
|
|
function TDABaseField.GetAsWord: Word;
|
|
begin
|
|
result := GetVarWord(Value);
|
|
end;
|
|
|
|
function TDABaseField.GetAsXml: IXMLNode;
|
|
begin
|
|
result := GetVarXml(Value);
|
|
end;
|
|
|
|
procedure TDABaseField.SetAsByte(const Value: Byte);
|
|
begin
|
|
self.Value := Value;
|
|
end;
|
|
|
|
procedure TDABaseField.SetAsCardinal(const Value: Cardinal);
|
|
begin
|
|
self.Value := Value;
|
|
end;
|
|
|
|
procedure TDABaseField.SetAsDecimal(const Value: TBcd);
|
|
begin
|
|
self.Value := BCDToVariant(Value);
|
|
end;
|
|
|
|
procedure TDABaseField.SetAsGuid(const Value: TGUID);
|
|
begin
|
|
self.Value := GuidToString(Value);
|
|
end;
|
|
|
|
procedure TDABaseField.SetAsLargeUInt(const Value: Int64);
|
|
begin
|
|
self.Value := Value;
|
|
end;
|
|
|
|
procedure TDABaseField.SetAsShortInt(const Value: ShortInt);
|
|
begin
|
|
self.Value := Value;
|
|
end;
|
|
|
|
procedure TDABaseField.SetAsSingle(const Value: Single);
|
|
begin
|
|
self.Value := Value;
|
|
end;
|
|
|
|
procedure TDABaseField.SetAsSmallInt(const Value: SmallInt);
|
|
begin
|
|
self.Value := Value;
|
|
end;
|
|
|
|
procedure TDABaseField.SetAsWord(const Value: Word);
|
|
begin
|
|
self.Value := Value;
|
|
end;
|
|
|
|
procedure TDABaseField.SetAsXml(const Value: IXMLNode);
|
|
begin
|
|
if Value = nil then
|
|
Self.Value := null
|
|
else
|
|
self.Value := Value.XML;
|
|
end;
|
|
|
|
procedure TDABaseField.SetDecimalPrecision(const Value: Integer);
|
|
begin
|
|
FDecimalPrecision := Value;
|
|
end;
|
|
|
|
function TDABaseField.GetDecimalPrecision: Integer;
|
|
begin
|
|
if not HasValidDictionaryField then begin
|
|
result := FDecimalPrecision
|
|
end
|
|
else begin
|
|
result := GetDictionaryField().DecimalPrecision;
|
|
end;
|
|
end;
|
|
|
|
function TDABaseField.GetDecimalScale: Integer;
|
|
begin
|
|
if not HasValidDictionaryField then begin
|
|
result := FDecimalScale
|
|
end
|
|
else begin
|
|
result := GetDictionaryField().DecimalScale;
|
|
end;
|
|
end;
|
|
|
|
procedure TDABaseField.SetDecimalScale(const Value: Integer);
|
|
begin
|
|
FDecimalScale := Value;
|
|
end;
|
|
|
|
function TDABaseField.MergeDatadictionaries: Boolean;
|
|
var
|
|
lOwner: TObject;
|
|
lSchema: IDASchema;
|
|
begin
|
|
result := false;
|
|
if DictionaryEntry = '' then exit;
|
|
|
|
lOwner := TDACustomFieldCollection(Collection).Owner;
|
|
if not (lOwner is TDADataSet) then exit;
|
|
|
|
lOwner := TDADatasetCollection(TDADataSet(lOwner).Collection).Owner;
|
|
|
|
if Supports(lOwner, IDASchema, lSchema) then
|
|
result := lSchema.MergeDataDictionaries;
|
|
end;
|
|
|
|
{ TDACustomField }
|
|
|
|
constructor TDACustomField.Create(Collection: TCollection);
|
|
begin
|
|
inherited;
|
|
|
|
fServerAutoRefresh := FALSE;
|
|
fCustomAttributes := TStringList.Create;
|
|
fVisible := TRUE;
|
|
fLogChanges := TRUE;
|
|
end;
|
|
|
|
destructor TDACustomField.Destroy;
|
|
begin
|
|
fCustomAttributes.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TDACustomField.GetInPrimaryKey: boolean;
|
|
begin
|
|
result := fInPrimaryKey
|
|
end;
|
|
|
|
function TDACustomField.GetRegExpression: string;
|
|
begin
|
|
if not HasValidDictionaryField
|
|
then result := fRegExpression
|
|
else result := GetDictionaryField().RegExpression;
|
|
end;
|
|
|
|
function TDACustomField.GetDefaultValue: string;
|
|
begin
|
|
if not HasValidDictionaryField
|
|
then result := fDefaultValue
|
|
else result := GetDictionaryField().DefaultValue;
|
|
end;
|
|
|
|
function TDACustomField.GetRequired: boolean;
|
|
begin
|
|
if not HasValidDictionaryField
|
|
then result := fRequired
|
|
else result := GetDictionaryField().Required;
|
|
end;
|
|
|
|
function TDACustomField.GetDisplayLabel: string;
|
|
begin
|
|
if not HasValidDictionaryField
|
|
then result := fDisplayLabel
|
|
else result := GetDictionaryField().DisplayLabel;
|
|
|
|
if (result='') then result := Name;
|
|
end;
|
|
|
|
function TDACustomField.GetDisplayWidth: integer;
|
|
begin
|
|
if not HasValidDictionaryField
|
|
then result := fDisplayWidth
|
|
else result := GetDictionaryField().DisplayWidth;
|
|
end;
|
|
|
|
function TDACustomField.GetEditMask: string;
|
|
begin
|
|
if not HasValidDictionaryField
|
|
then result := fEditMask
|
|
else result := GetDictionaryField().EditMask;
|
|
end;
|
|
|
|
function TDACustomField.GetReadOnly: boolean;
|
|
begin
|
|
if not HasValidDictionaryField
|
|
then result := fReadOnly
|
|
else result := GetDictionaryField().ReadOnly;
|
|
end;
|
|
|
|
function TDACustomField.GetVisible: boolean;
|
|
begin
|
|
if not HasValidDictionaryField
|
|
then result := fVisible
|
|
else result := GetDictionaryField().Visible;
|
|
end;
|
|
|
|
function TDACustomField.GetDisplayFormat: string;
|
|
begin
|
|
if not HasValidDictionaryField
|
|
then result := fDisplayFormat
|
|
else result := GetDictionaryField().DisplayFormat;
|
|
end;
|
|
|
|
function TDACustomField.GetAlignment: TAlignment;
|
|
begin
|
|
if not HasValidDictionaryField
|
|
then result := fAlignment
|
|
else result := GetDictionaryField().Alignment;
|
|
end;
|
|
|
|
function TDACustomField.GetEditFormat: string;
|
|
begin
|
|
if not HasValidDictionaryField
|
|
then result := fEditFormat
|
|
else result := GetDictionaryField().EditFormat;
|
|
end;
|
|
|
|
procedure TDACustomField.SetInPrimaryKey(const Value: boolean);
|
|
begin
|
|
fInPrimaryKey := Value
|
|
end;
|
|
|
|
procedure TDACustomField.SetRegExpression(const Value: string);
|
|
begin
|
|
fRegExpression := Value
|
|
end;
|
|
|
|
procedure TDACustomField.LoadFromFile(const aFileName: string);
|
|
begin
|
|
if (fField<>nil) then begin
|
|
if (fField is TBlobField) then TBlobField(fField).LoadFromFile(aFileName)
|
|
end
|
|
else RaiseError(err_FieldIsNotBound);
|
|
end;
|
|
|
|
procedure TDACustomField.SaveToFile(const aFileName: string);
|
|
begin
|
|
if (fField<>nil) then begin
|
|
if (fField is TBlobField) then TBlobField(fField).SaveToFile(aFileName)
|
|
end
|
|
else RaiseError(err_FieldIsNotBound);
|
|
end;
|
|
|
|
procedure TDACustomField.LoadFromStream(const aStream: IROStream);
|
|
begin
|
|
LoadFromStream(aStream.Stream);
|
|
end;
|
|
|
|
procedure TDACustomField.SaveToStream(const aStream: IROStream);
|
|
begin
|
|
SaveToStream(aStream.Stream);
|
|
end;
|
|
|
|
function TDACustomField.GetValue: Variant;
|
|
begin
|
|
if Assigned(fField) then begin
|
|
if fField.IsNull then Result := Null else
|
|
{$IFNDEF FPC}
|
|
if fField is TWideStringField then result := TWideStringField(fField).Value else
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI10UP}
|
|
if fField is TWideMemoField then result := TWideMemoField(fField).Value else
|
|
{$ENDIF DELPHI10UP}
|
|
result := fField.Value;
|
|
end
|
|
else result := Null;
|
|
end;
|
|
|
|
procedure TDACustomField.SetValue(const Value: Variant);
|
|
var
|
|
aDecimal: TDecimal;
|
|
begin
|
|
if Assigned(fField) then begin
|
|
{$IFNDEF FPC}
|
|
if (fField is TWideStringField) and not VarIsNull( Value ) then
|
|
TWideStringField(fField).Value := Value else
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI10UP}
|
|
if (fField is TWideMemoField) and not VarIsNull( Value ) then
|
|
fField.AsWideString := Value else
|
|
{$ENDIF DELPHI10UP}
|
|
if (fField is TLargeintField) and not VarIsNull( Value ) then
|
|
TLargeintField(fField).Value := Value else
|
|
if VarByteArrayToDecimal(Value,aDecimal) then
|
|
SetAsDecimal(DecimalToBCD(aDecimal)) else
|
|
fField.Value := Value
|
|
end
|
|
else RaiseError(err_FieldIsNotBound);
|
|
end;
|
|
|
|
procedure TDACustomField.Bind(aField: TField);
|
|
begin
|
|
fField := aField;
|
|
|
|
if Assigned(fField) then begin
|
|
fField.DisplayLabel := DisplayLabel;
|
|
fField.DisplayWidth := DisplayWidth;
|
|
{$IFNDEF FPC}
|
|
fField.EditMask := EditMask;
|
|
{$ENDIF FPC}
|
|
fField.ReadOnly := ReadOnly;
|
|
fField.Required := Required;
|
|
fField.Visible := Visible;
|
|
fField.Alignment := Alignment;
|
|
|
|
if (fField is TNumericField) then begin
|
|
TNumericField(fField).DisplayFormat := DisplayFormat;
|
|
TNumericField(fField).EditFormat := EditFormat;
|
|
end
|
|
|
|
else if (fField is TDateTimeField) then begin
|
|
TDateTimeField(fField).DisplayFormat := DisplayFormat
|
|
end
|
|
{$IFNDEF FPC}
|
|
else if (fField is TFMTBCDField) then begin
|
|
TFMTBCDField(fField).Precision := DecimalPrecision;
|
|
TFMTBCDField(fField).Size := DecimalScale;
|
|
end
|
|
|
|
else if (fField is TBCDField) then begin
|
|
TBCDField(fField).Precision := DecimalPrecision;
|
|
TBCDField(fField).Size := DecimalScale;
|
|
end
|
|
{$ENDIF FPC}
|
|
else if (fField is TBlobField) then begin
|
|
{$IFDEF DELPHI10UP}
|
|
if TBlobField(fField).BlobType <> ftWideMemo then
|
|
{$ENDIF}
|
|
TBlobField(fField).BlobType := BlobTypeMappings[BlobType];
|
|
end;
|
|
|
|
fField.OnValidate := InternalOnValidate;
|
|
fField.OnChange := InternalOnChange;
|
|
|
|
{fField.Lookup := Lookup;
|
|
if (LookupSource<>NIL) then
|
|
with TDADataSource(LookupSource) do
|
|
if Assigned(DataTable)
|
|
then fField.LookupDataSet := DataTable.Dataset;
|
|
|
|
fField.LookupKeyFields := LookupKeyFields;
|
|
fField.LookupCache := LookupCache;
|
|
fField.LookupResultField := LookupResultField;
|
|
fField.KeyFields := KeyFields;}
|
|
end;
|
|
end;
|
|
|
|
procedure TDACustomField.Unbind;
|
|
begin
|
|
if (fField=NIL) then Exit;
|
|
|
|
fField.OnChange := nil;
|
|
fField.OnSetText := nil;
|
|
fField.OnGetText := nil;
|
|
fField.OnValidate := nil;
|
|
|
|
fField := nil;
|
|
end;
|
|
|
|
function TDACustomField.GetTableField: string;
|
|
begin
|
|
result := fTableField
|
|
end;
|
|
|
|
procedure TDACustomField.SetTableField(const Value: string);
|
|
begin
|
|
fTableField := Value;
|
|
end;
|
|
|
|
procedure TDACustomField.SetName(const Value: string);
|
|
var
|
|
updatesc: boolean;
|
|
begin
|
|
updatesc := (fTableField = '') or (fTableField = Name);
|
|
|
|
inherited;
|
|
|
|
if updatesc then fTableField := Value;
|
|
end;
|
|
|
|
function TDACustomField.GetCustomAttributes: TStrings;
|
|
begin
|
|
result := fCustomAttributes
|
|
end;
|
|
|
|
procedure TDACustomField.SetCustomAttributes(const Value: TStrings);
|
|
begin
|
|
fCustomAttributes.Assign(Value);
|
|
end;
|
|
|
|
procedure TDACustomField.Assign(Source: TPersistent);
|
|
begin
|
|
if (Source is TDACustomField) then begin
|
|
AssignField(TDACustomField(Source));
|
|
end
|
|
else begin
|
|
inherited;
|
|
end;
|
|
end;
|
|
|
|
procedure TDACustomField.AssignField(Source: TDABaseField);
|
|
var
|
|
lSource: TDACustomField;
|
|
begin
|
|
inherited;
|
|
lSource := TDACustomField(Source);
|
|
|
|
fField := nil; { Assigned DAField will always be unbound }
|
|
fTableField := lSource.fTableField;
|
|
fRequired := lSource.fRequired;
|
|
fInPrimaryKey := lSource.fInPrimaryKey;
|
|
fRegExpression := lSource.fRegExpression;
|
|
fDefaultValue := lSource.fDefaultValue;
|
|
fDictionaryEntry := lSource.fDictionaryEntry;
|
|
fDisplayWidth := lSource.fDisplayWidth;
|
|
fDisplayLabel := lSource.fDisplayLabel;
|
|
fDisplayFormat := lSource.DisplayFormat;
|
|
|
|
fReadOnly := lSource.fReadOnly;
|
|
fVisible := lSource.fVisible;
|
|
fEditMask := lSource.fEditMask;
|
|
fLogChanges := lSource.fLogChanges;
|
|
fCalculated := lSource.fCalculated;
|
|
fServerCalculated := lSource.fServerCalculated;
|
|
|
|
fEditFormat := lSource.EditFormat;
|
|
fAlignment := lSource.Alignment;
|
|
|
|
fOnChange := lSource.OnChange;
|
|
{fOnGetText := lSource.OnGetText;
|
|
fOnSetText := lSource.OnSetText;}
|
|
fOnValidate := lSource.OnValidate;
|
|
|
|
fLookupCache := lSource.LookupCache;
|
|
fLookupKeyFields := lSource.LookupKeyFields;
|
|
fLookupResultField := lSource.LookupResultField;
|
|
fKeyFields := lSource.KeyFields;
|
|
fLookupSource := lSource.LookupSource;
|
|
fLookup := lSource.Lookup;
|
|
|
|
//fCustomAttributes.Assign(lSource.fCustomAttributes);
|
|
fCustomAttributes.Text := lSource.fCustomAttributes.Text;
|
|
|
|
fServerAutoRefresh := lSource.ServerAutoRefresh;
|
|
fGeneratorName := lSource.GeneratorName;
|
|
|
|
fBusinessClassID := lSource.BusinessClassID;
|
|
end;
|
|
|
|
procedure TDACustomField.InternalOnChange(Sender: TField);
|
|
begin
|
|
if not (Collection as TDACustomFieldCollection).FieldEventsDisabled then
|
|
begin
|
|
if assigned(TDACustomFieldCollection(Collection).OnFieldAfterUpdate) then
|
|
TDACustomFieldCollection(Collection).OnFieldAfterUpdate(Self);
|
|
if Assigned(fOnChange) then
|
|
fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TDACustomField.InternalOnValidate(Sender: TField);
|
|
begin
|
|
if not (Collection as TDACustomFieldCollection).FieldEventsDisabled then
|
|
begin
|
|
if assigned(TDACustomFieldCollection(Collection).OnFieldBeforeUpdate) then
|
|
TDACustomFieldCollection(Collection).OnFieldBeforeUpdate(Self);
|
|
if Assigned(fOnValidate) then
|
|
fOnValidate(Self);
|
|
end;
|
|
end;
|
|
|
|
function TDACustomField.IsCompatibleV4: boolean;
|
|
begin
|
|
if Assigned(FieldCollection) then
|
|
Result := FieldCollection.IsCompatibleV4
|
|
else
|
|
Result := inherited IsCompatibleV4;
|
|
end;
|
|
|
|
procedure TDACustomField.SetDisplayLabel(const aValue: string);
|
|
begin
|
|
fDisplayLabel := aValue;
|
|
if Assigned(fField) then fField.DisplayLabel := aValue;
|
|
end;
|
|
|
|
procedure TDACustomField.SetRequired(const aValue: boolean);
|
|
begin
|
|
fRequired := aValue;
|
|
if Assigned(fField) then fField.Required := aValue;
|
|
end;
|
|
|
|
procedure TDACustomField.SetVisible(const aValue: boolean);
|
|
begin
|
|
fVisible := aValue;
|
|
if Assigned(fField) then fField.Visible := aValue;
|
|
end;
|
|
|
|
procedure TDACustomField.SetDisplayWidth(const aValue: integer);
|
|
begin
|
|
fDisplayWidth := aValue;
|
|
if Assigned(fField) then fField.DisplayWidth := aValue;
|
|
end;
|
|
|
|
procedure TDACustomField.SetEditMask(const aValue: string);
|
|
begin
|
|
fEditMask := aValue;
|
|
{$IFNDEF FPC}
|
|
if Assigned(fField) then fField.EditMask := aValue;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TDACustomField.SetReadOnly(const aValue: boolean);
|
|
begin
|
|
fReadOnly := aValue;
|
|
if Assigned(fField) then fField.ReadOnly := aValue;
|
|
end;
|
|
|
|
procedure TDACustomField.SetDisplayFormat(const Value: string);
|
|
begin
|
|
fDisplayFormat := Value;
|
|
if Assigned(fField) then begin
|
|
if (fField is TNumericField) then
|
|
TNumericField(fField).DisplayFormat := Value
|
|
else if (fField is TDateTimeField) then
|
|
TDateTimeField(fField).DisplayFormat := Value;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TDACustomField.StoredExpression: Boolean;
|
|
begin
|
|
Result:= not IsCompatibleV4;
|
|
end;
|
|
|
|
function TDACustomField.StoreDisplayLabel: Boolean;
|
|
begin
|
|
result := MergeDatadictionaries or (not HasValidDictionaryField()) and (fDisplayLabel <> '') and (fDisplayLabel <> Name);
|
|
end;
|
|
|
|
|
|
function TDACustomField.StoredServerCalculated: Boolean;
|
|
begin
|
|
Result:= not IsCompatibleV4;
|
|
end;
|
|
|
|
function TDAField.GetDisplayName: string;
|
|
begin
|
|
result := Format('%s [%s, %d', [fName, GetEnumName(TypeInfo(TDADataType), Ord(DataType)), Size]);
|
|
|
|
if Required then
|
|
result := result+', REQUIRED';
|
|
|
|
result := result+']'
|
|
end;
|
|
|
|
function TDACustomField.GetOwner: TPersistent;
|
|
begin
|
|
result := Collection;
|
|
end;
|
|
|
|
function TDACustomField.GetNamePath: string;
|
|
begin
|
|
if (Collection <> nil) and (Collection.Owner <> nil) and (Collection.Owner is TComponent) then
|
|
result := TComponent(Collection.Owner).Name + '.' + FName
|
|
else
|
|
result := FName;
|
|
end;
|
|
|
|
procedure TDACustomField.SetAlignment(const Value: TAlignment);
|
|
begin
|
|
fAlignment := Value;
|
|
if Assigned(fField) then fField.Alignment := Value;
|
|
end;
|
|
|
|
procedure TDACustomField.SetEditFormat(const Value: string);
|
|
begin
|
|
fEditFormat := Value;
|
|
|
|
if Assigned(fField) then begin
|
|
if (fField is TNumericField) then TNumericField(fField).EditFormat := Value
|
|
end;
|
|
end;
|
|
|
|
procedure TDACustomField.SetKeyFields(const Value: string);
|
|
begin
|
|
fKeyFields := Value;
|
|
if Assigned(fField)
|
|
then fField.KeyFields := Value;
|
|
end;
|
|
|
|
procedure TDACustomField.SetLookupCache(const Value: boolean);
|
|
begin
|
|
fLookupCache := Value;
|
|
if Assigned(fField)
|
|
then fField.LookupCache := Value;
|
|
end;
|
|
|
|
procedure TDACustomField.SetLookupKeyFields(const Value: string);
|
|
begin
|
|
fLookupKeyFields := Value;
|
|
if Assigned(fField)
|
|
then fField.LookupKeyFields := Value;
|
|
end;
|
|
|
|
procedure TDACustomField.SetLookupResultField(const Value: string);
|
|
begin
|
|
fLookupResultField := Value;
|
|
if Assigned(fField)
|
|
then fField.LookupResultField := Value;
|
|
end;
|
|
|
|
procedure TDACustomField.SetLookupSource(const Value: TDataSource);
|
|
begin
|
|
if Assigned(Value) and not (Value is TDABaseDataSource) then raise Exception.Create('LookupSource must be a TDADataSource');
|
|
|
|
fLookupSource := Value;
|
|
if Assigned(fField) then
|
|
if Assigned(Value)
|
|
then fField.LookupDataSet := Value.DataSet
|
|
else fField.LookupDataSet := nil;
|
|
end;
|
|
|
|
procedure TDACustomField.SetCalculated(const Value: boolean);
|
|
begin
|
|
fCalculated := Value;
|
|
if Value then begin
|
|
fLookup := FALSE;
|
|
fServerCalculated := false;
|
|
end;
|
|
end;
|
|
|
|
procedure TDACustomField.SetLookup(const Value: boolean);
|
|
begin
|
|
fLookup := Value;
|
|
if Value then begin
|
|
fCalculated := FALSE;
|
|
end;
|
|
end;
|
|
|
|
function TDACustomField.GetFieldCollection: TDACustomFieldCollection;
|
|
begin
|
|
result := TDACustomFieldCollection(Collection);
|
|
end;
|
|
|
|
procedure TDACustomField.SetBlobType(const Value: TDABlobType);
|
|
begin
|
|
inherited;
|
|
|
|
if Assigned(fField) and (fField is TBlobField)
|
|
then TBlobField(fField).BlobType := BlobTypeMappings[Value];
|
|
end;
|
|
|
|
function TDACustomField.GetServerAutoRefresh: boolean;
|
|
begin
|
|
result := fServerAutoRefresh
|
|
end;
|
|
|
|
procedure TDACustomField.SetServerAutoRefresh(const Value: boolean);
|
|
begin
|
|
fServerAutoRefresh := Value;
|
|
end;
|
|
|
|
function TDACustomField.GetLogChanges: boolean;
|
|
begin
|
|
if not HasValidDictionaryField
|
|
then result := fLogChanges
|
|
else result := GetDictionaryField().fLogChanges;
|
|
result := Result and not (fCalculated or fLookup)
|
|
end;
|
|
|
|
function TDACustomField.StoreProperties: boolean;
|
|
begin
|
|
result := MergeDatadictionaries or not HasValidDictionaryField();
|
|
end;
|
|
|
|
function TDACustomField.GetOldValue: Variant;
|
|
begin
|
|
if Assigned(fField)
|
|
then result := fField.OldValue
|
|
else result := Unassigned;
|
|
end;
|
|
|
|
function TDACustomField.GetSQLOrigin: string;
|
|
begin
|
|
if fSQLOrigin=''
|
|
then result := TableField
|
|
else result := fSQLOrigin;
|
|
end;
|
|
|
|
procedure TDACustomField.FocusControl;
|
|
begin
|
|
if Assigned(fField)
|
|
then fField.FocusControl;
|
|
end;
|
|
|
|
{procedure TDACustomField.SetBusinessRulesID(const Value: string);
|
|
begin
|
|
BusinessClassID := Value;
|
|
end;
|
|
|
|
function TDACustomField.GetBusinessRulesID: string;
|
|
begin
|
|
result := BusinessClassID;
|
|
end;}
|
|
|
|
function TDACustomField.GetBusinessClassID: string;
|
|
begin
|
|
if not HasValidDictionaryField
|
|
then result := fBusinessClassID
|
|
else result := GetDictionaryField().BusinessClassID;
|
|
end;
|
|
|
|
procedure TDACustomField.SetBusinessClassID(const Value: string);
|
|
begin
|
|
fBusinessClassID := Value;
|
|
end;
|
|
|
|
procedure TDACustomField.LoadFromStream(const aStream: TStream);
|
|
begin
|
|
if (fField<>nil) then begin
|
|
if (fField is TBlobField) then TBlobField(fField).LoadFromStream(aStream)
|
|
end
|
|
else RaiseError(err_FieldIsNotBound);
|
|
end;
|
|
|
|
procedure TDACustomField.SaveToStream(const aStream: TStream);
|
|
begin
|
|
if (fField<>nil) then begin
|
|
if (fField is TBlobField) then TBlobField(fField).SaveToStream(aStream)
|
|
end
|
|
else RaiseError(err_FieldIsNotBound);
|
|
end;
|
|
|
|
function TDACustomField.GetBlobSize: Integer;
|
|
begin
|
|
if fField is TBlobField then
|
|
result := TBlobField(fField).BlobSize
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
procedure TDACustomField.SetServerCalculated(const Value: Boolean);
|
|
begin
|
|
fServerCalculated := Value;
|
|
if Value then begin
|
|
Readonly := True;
|
|
LogChanges := False;
|
|
Calculated := False;
|
|
InPrimaryKey := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TDACustomField.SetExpression(const Value: string);
|
|
begin
|
|
fExpression := Value;
|
|
if value <> '' then
|
|
Calculated := true; // will unset lookup & server calculated
|
|
end;
|
|
|
|
function TDACustomField.GetAsBoolean: boolean;
|
|
begin
|
|
if Assigned(fField) then
|
|
Result:= fField.AsBoolean
|
|
else
|
|
Result:= inherited GetAsBoolean;
|
|
end;
|
|
|
|
function TDACustomField.GetAsCurrency: currency;
|
|
begin
|
|
if Assigned(fField) then
|
|
Result:= fField.AsCurrency
|
|
else
|
|
Result:= inherited GetAsCurrency;
|
|
end;
|
|
|
|
function TDACustomField.GetAsDateTime: TDateTime;
|
|
begin
|
|
if Assigned(fField) then
|
|
Result:= fField.AsDateTime
|
|
else
|
|
Result:= inherited GetAsDateTime;
|
|
end;
|
|
|
|
function TDACustomField.GetAsFloat: double;
|
|
begin
|
|
if Assigned(fField) then
|
|
Result:= fField.AsFloat
|
|
else
|
|
Result:= inherited GetAsFloat;
|
|
end;
|
|
|
|
function TDACustomField.GetAsInteger: integer;
|
|
begin
|
|
if Assigned(fField) then
|
|
Result:= fField.AsInteger
|
|
else
|
|
Result:= inherited GetAsInteger;
|
|
end;
|
|
|
|
function TDACustomField.GetAsLargeInt: int64;
|
|
begin
|
|
if Assigned(fField) and (fField.DataType = ftLargeInt) then
|
|
Result:= TLargeintField(fField).AsLargeint
|
|
else
|
|
result:= inherited GetAsLargeInt;
|
|
end;
|
|
|
|
function TDACustomField.GetAsString: string;
|
|
begin
|
|
if Assigned(fField) then
|
|
Result:= fField.AsString
|
|
else
|
|
Result:= inherited GetAsString;
|
|
end;
|
|
|
|
function TDACustomField.GetAsVariant: variant;
|
|
begin
|
|
if Assigned(fField) then
|
|
Result:= fField.AsVariant
|
|
else
|
|
Result:= inherited GetAsVariant;
|
|
end;
|
|
|
|
function TDACustomField.GetAsWideString: Widestring;
|
|
begin
|
|
if Assigned(fField) and (fField.DataType = ftWideString) then begin
|
|
if GetIsNull then
|
|
Result:=''
|
|
else
|
|
{$IFNDEF FPC}
|
|
Result := TWideStringField(fField).Value;
|
|
{$ELSE}
|
|
REsult:= inherited GetAsWideString;
|
|
{$ENDIF}
|
|
end
|
|
{$IFDEF DELPHI10UP}
|
|
else if Assigned(fField) and (fField.DataType = ftWideMemo) then
|
|
Result := TWideMemoField(fField).Value
|
|
{$ENDIF}
|
|
else
|
|
Result := inherited GetAsWideString;
|
|
end;
|
|
|
|
function TDACustomField.GetIsNull: boolean;
|
|
begin
|
|
if Assigned(fField) then
|
|
Result:= fField.IsNull
|
|
else
|
|
Result:= inherited GetIsNull;
|
|
end;
|
|
|
|
procedure TDACustomField.SetAsBoolean(const aValue: boolean);
|
|
begin
|
|
if Assigned(fField) then
|
|
fField.AsBoolean := aValue
|
|
else
|
|
inherited SetAsBoolean(aValue);
|
|
end;
|
|
|
|
procedure TDACustomField.SetAsCurrency(const aValue: currency);
|
|
begin
|
|
if Assigned(fField) then
|
|
fField.AsCurrency := aValue
|
|
else
|
|
inherited SetAsCurrency(aValue);
|
|
end;
|
|
|
|
procedure TDACustomField.SetAsDateTime(const aValue: TDateTime);
|
|
begin
|
|
if Assigned(fField) then
|
|
fField.AsDateTime := aValue
|
|
else
|
|
inherited SetAsDateTime(aValue);
|
|
end;
|
|
|
|
procedure TDACustomField.SetAsFloat(const aValue: double);
|
|
begin
|
|
if Assigned(fField) then
|
|
fField.AsFloat := aValue
|
|
else
|
|
inherited SetAsFloat(aValue);
|
|
end;
|
|
|
|
procedure TDACustomField.SetAsInteger(const aValue: integer);
|
|
begin
|
|
if Assigned(fField) then
|
|
fField.AsInteger := aValue
|
|
else
|
|
inherited SetAsInteger(aValue);
|
|
end;
|
|
|
|
procedure TDACustomField.SetAsLargeInt(const aValue: Int64);
|
|
begin
|
|
if Assigned(fField) and (fField.DataType = ftLargeInt) then
|
|
TLargeintField(fField).AsLargeInt := aValue
|
|
else
|
|
inherited SetAsLargeInt(aValue);
|
|
end;
|
|
|
|
procedure TDACustomField.SetAsString(const aValue: string);
|
|
begin
|
|
if Assigned(fField) then
|
|
fField.AsString := aValue
|
|
else
|
|
inherited SetAsString(aValue);
|
|
end;
|
|
|
|
procedure TDACustomField.SetAsVariant(const aValue: variant);
|
|
begin
|
|
if Assigned(fField) then
|
|
fField.AsVariant := aValue
|
|
else
|
|
inherited SetAsVariant(aValue);
|
|
end;
|
|
|
|
procedure TDACustomField.SetAsWideString(const aValue: Widestring);
|
|
begin
|
|
{$IFNDEF FPC}
|
|
if (fField<>nil) and (fField.DataType = ftWideString) then TWideStringField(fField).Value := aValue else
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI10UP}
|
|
if (fField<>nil) and (fField.DataType = ftWideMemo) then TWideMemoField(fField).Value := aValue else
|
|
{$ENDIF}
|
|
inherited SetAsWideString(aValue);
|
|
end;
|
|
|
|
function TDACustomField.GetAsByte: Byte;
|
|
begin
|
|
Result := GetAsSmallInt;
|
|
end;
|
|
|
|
function TDACustomField.GetAsCardinal: Cardinal;
|
|
begin
|
|
Result := GetAsInteger;
|
|
end;
|
|
|
|
function TDACustomField.GetAsDecimal: TBcd;
|
|
begin
|
|
{$IFNDEF FPC}
|
|
if Assigned(fField) and (fField.DataType = ftFmtBcd) then
|
|
result := TFMTBCDField(fField).AsBCD
|
|
else
|
|
{$ENDIF}
|
|
result := inherited GetAsDecimal;
|
|
end;
|
|
|
|
function TDACustomField.GetAsGuid: TGUID;
|
|
begin
|
|
{$IFNDEF FPC}
|
|
if Assigned(fField) and (fField.DataType = ftGuid) then
|
|
result := TGuidField(fField).AsGuid
|
|
else
|
|
{$ENDIF}
|
|
result := inherited GetAsGuid;
|
|
end;
|
|
|
|
function TDACustomField.GetAsLargeUInt: Int64;
|
|
begin
|
|
result := GetAsLargeInt;
|
|
end;
|
|
|
|
function TDACustomField.GetAsShortInt: ShortInt;
|
|
begin
|
|
Result := GetAsSmallInt;
|
|
end;
|
|
|
|
function TDACustomField.GetAsSingle: Single;
|
|
begin
|
|
if Assigned(fField) then
|
|
result := fField.AsFloat
|
|
else
|
|
Result := inherited GetAsSingle;
|
|
end;
|
|
|
|
function TDACustomField.GetAsSmallInt: SmallInt;
|
|
begin
|
|
if Assigned(fField) and (fField.DataType = ftSmallint) then
|
|
result := TSmallintField(fField).Value
|
|
else
|
|
result := inherited GetAsSmallInt;
|
|
end;
|
|
|
|
function TDACustomField.GetAsWord: Word;
|
|
begin
|
|
if Assigned(fField) and (fField.DataType = ftWord) then
|
|
result := TWordField(fField).AsInteger
|
|
else
|
|
result := inherited GetAsWord;
|
|
end;
|
|
|
|
function TDACustomField.GetAsXml: IXMLNode;
|
|
var
|
|
s: string;
|
|
lDoc: IXMLDocument;
|
|
begin
|
|
s := GetAsWideString;
|
|
if s = '' then result := nil else begin
|
|
lDoc := NewROXmlDocument;
|
|
lDoc.New;
|
|
lDoc.XML := s;
|
|
Result := lDoc.DocumentNode;
|
|
end;
|
|
end;
|
|
|
|
procedure TDACustomField.SetAsByte(const Value: Byte);
|
|
begin
|
|
SetAsSmallInt(Value);
|
|
end;
|
|
|
|
procedure TDACustomField.SetAsCardinal(const Value: Cardinal);
|
|
begin
|
|
SetAsInteger(Value);
|
|
end;
|
|
|
|
procedure TDACustomField.SetAsDecimal(const Value: TBcd);
|
|
begin
|
|
{$IFNDEF FPC}
|
|
if (fField<>nil) and (fField.DataType = ftFMTBcd) then
|
|
TFMTBCDField(fField).Value := Value
|
|
else
|
|
{$ENDIF}
|
|
inherited SetAsDecimal(Value);
|
|
end;
|
|
|
|
procedure TDACustomField.SetAsGuid(const Value: TGUID);
|
|
begin
|
|
{$IFNDEF FPC}
|
|
if (fField<>nil) and (fField.DataType = ftGuid) then
|
|
TGuidField(fField).AsGuid := Value
|
|
else
|
|
{$ENDIF}
|
|
inherited SetAsGuid(Value);
|
|
end;
|
|
|
|
procedure TDACustomField.SetAsLargeUInt(const Value: Int64);
|
|
begin
|
|
SetAsLargeInt(Value);
|
|
end;
|
|
|
|
procedure TDACustomField.SetAsShortInt(const Value: ShortInt);
|
|
begin
|
|
SetAsSmallInt(Value);
|
|
end;
|
|
|
|
procedure TDACustomField.SetAsSingle(const Value: Single);
|
|
begin
|
|
if Assigned(fField) then
|
|
SetAsFloat(Value)
|
|
else
|
|
inherited SetAsSingle(Value);
|
|
end;
|
|
|
|
procedure TDACustomField.SetAsSmallInt(const Value: SmallInt);
|
|
begin
|
|
if Assigned(fField) and (fField.DataType = ftSmallint) then
|
|
TSmallintField(fField).Value := Value
|
|
else
|
|
inherited SetAsSmallInt(Value);
|
|
end;
|
|
|
|
procedure TDACustomField.SetAsWord(const Value: Word);
|
|
begin
|
|
if Assigned(fField) and (fField.DataType = ftWord) then
|
|
TWordField(fField).AsInteger := Value
|
|
else
|
|
inherited SetAsWord(Value);
|
|
end;
|
|
|
|
procedure TDACustomField.SetAsXml(const Value: IXMLNode);
|
|
begin
|
|
if (Value = nil) then
|
|
AsVariant := Null
|
|
else begin
|
|
SetAsWideString(Value.Xml);
|
|
end;
|
|
end;
|
|
|
|
procedure TDACustomField.SetDecimalPrecision(const Value: Integer);
|
|
begin
|
|
inherited;
|
|
if Assigned(fField) then begin
|
|
{$IFNDEF FPC}
|
|
if fField is TFMTBCDField then TFMTBCDField(fField).Precision:=Value
|
|
else if fField is TBCDField then TBCDField(fField).Precision:=Value;
|
|
{$ENDIF FPC}
|
|
end;
|
|
end;
|
|
|
|
function TDACustomField.GetDecimalPrecision: Integer;
|
|
begin
|
|
Result:=inherited GetDecimalPrecision;
|
|
if Assigned(fField) then begin
|
|
{$IFNDEF FPC}
|
|
if fField is TFMTBCDField then Result := TFMTBCDField(fField).Precision
|
|
else if fField is TBCDField then Result := TBCDField(fField).Precision;
|
|
{$ENDIF FPC}
|
|
end;
|
|
end;
|
|
|
|
function TDACustomField.GetDecimalScale: Integer;
|
|
begin
|
|
Result:=inherited GetDecimalScale;
|
|
if Assigned(fField) then begin
|
|
{$IFNDEF FPC}
|
|
if fField is TFMTBCDField then Result := TFMTBCDField(fField).Size
|
|
else if fField is TBCDField then Result := TBCDField(fField).Size;
|
|
{$ENDIF FPC}
|
|
end;
|
|
end;
|
|
|
|
procedure TDACustomField.SetDecimalScale(const Value: Integer);
|
|
begin
|
|
inherited;
|
|
if Assigned(fField) then begin
|
|
{$IFNDEF FPC}
|
|
if fField is TFMTBCDField then TFMTBCDField(fField).Size:=Value
|
|
else if fField is TBCDField then TBCDField(fField).Size:=Value;
|
|
{$ENDIF FPC}
|
|
end;
|
|
end;
|
|
|
|
{ TDACustomFieldCollection }
|
|
|
|
constructor TDACustomFieldCollection.Create(aOwner: TPersistent; aFieldClass: TDAFieldClass);
|
|
begin
|
|
inherited Create(aOwner, aFieldClass);
|
|
end;
|
|
|
|
function TDACustomFieldCollection.Add: TDAField;
|
|
begin
|
|
result := TDAField(inherited Add);
|
|
end;
|
|
|
|
function TDACustomFieldCollection.Add(const aName: string; aType: TDADataType; aSize: integer): TDACustomField;
|
|
begin
|
|
result := Add;
|
|
result.Name := aName;
|
|
result.DataType := aType;
|
|
result.Size := aSize;
|
|
end;
|
|
|
|
procedure TDACustomFieldCollection.Bind(aDataset: TDataset);
|
|
var
|
|
i: integer;
|
|
lDAField: TDACustomField;
|
|
lField: TField;
|
|
begin
|
|
Check(aDataset = nil, err_InvalidDataset);
|
|
try
|
|
for i := 0 to (Count - 1) do begin
|
|
lDAField := Fields[i];
|
|
lField := aDataset.FindField(lDAField.SQLOrigin);
|
|
if (not Assigned(lField)) and (not lDAField.Calculated) and not (lDAField.ServerCalculated) and not (lDAField.Lookup) then
|
|
RaiseError(err_CannotFindField, [lDAField.SQLOrigin])
|
|
else
|
|
lDAField.Bind(lField);
|
|
end;
|
|
except
|
|
Unbind;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
procedure TDACustomFieldCollection.Assign(Source: TPersistent);
|
|
begin
|
|
if (Source is TDACustomFieldCollection) then begin
|
|
AssignFieldCollection(TDACustomFieldCollection(Source));
|
|
end
|
|
else
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDACustomFieldCollection.AssignFieldCollection(Source: TDACustomFieldCollection);
|
|
var
|
|
i: integer;
|
|
src: TDACustomFieldCollection;
|
|
fld: TDAField;
|
|
begin
|
|
src := TDACustomFieldCollection(Source);
|
|
|
|
Clear;
|
|
|
|
if not Assigned(Source) then Exit;
|
|
|
|
for i := 0 to (src.Count - 1) do begin
|
|
fld := Add;
|
|
fld.AssignField(src[i]);
|
|
end;
|
|
end;
|
|
|
|
function TDACustomFieldCollection.FieldByName(const aName: string): TDACustomField;
|
|
begin
|
|
result := TDACustomField(inherited ItemByName(aName))
|
|
end;
|
|
|
|
function TDACustomFieldCollection.FindField(const aName: string): TDACustomField;
|
|
begin
|
|
result := TDACustomField(inherited FindItem(aName))
|
|
end;
|
|
|
|
function TDACustomFieldCollection.GetFields(Index: integer): TDACustomField;
|
|
begin
|
|
result := TDACustomField(inherited Items[Index])
|
|
end;
|
|
|
|
procedure TDACustomFieldCollection.SetFields(Index: integer; const Value: TDACustomField);
|
|
begin
|
|
Fields[Index].Assign(Value);
|
|
end;
|
|
|
|
procedure TDACustomFieldCollection.Unbind;
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 0 to (Count - 1) do
|
|
Fields[i].Unbind;
|
|
end;
|
|
|
|
{ TDAFieldCollection }
|
|
|
|
constructor TDAFieldCollection.Create(aOwner: TPersistent);
|
|
begin
|
|
inherited Create(aOwner, TDAField);
|
|
end;
|
|
|
|
function TDAFieldCollection.FieldByName(const aName: string): TDAField;
|
|
begin
|
|
result := TDAField(inherited ItemByName(aName))
|
|
end;
|
|
|
|
function TDAFieldCollection.FindField(const aName: string): TDAField;
|
|
begin
|
|
result := TDAField(inherited FindItem(aName))
|
|
end;
|
|
|
|
function TDAFieldCollection.GetFields(Index: integer): TDAField;
|
|
begin
|
|
result := TDAField(inherited Items[Index])
|
|
end;
|
|
|
|
procedure TDAFieldCollection.SetFields(Index: integer; const Value: TDAField);
|
|
begin
|
|
Fields[Index].Assign(Value);
|
|
end;
|
|
|
|
{ TDAParam }
|
|
|
|
function TDAParam.GetParamType: TDAParamType;
|
|
begin
|
|
result := fParamType;
|
|
end;
|
|
|
|
procedure TDAParam.LoadFromFile(const aFileName: string);
|
|
begin
|
|
LoadFromStream(NewROStream(TFileStream.Create(aFileName, fmOpenRead), TRUE));
|
|
end;
|
|
|
|
procedure TDAParam.SaveToFile(const aFileName: string);
|
|
begin
|
|
SaveToStream(NewROStream(TFileStream.Create(aFileName, fmCreate), TRUE));
|
|
end;
|
|
|
|
procedure TDAParam.LoadFromStream(const aStream: IROStream);
|
|
begin
|
|
Value := VariantBinaryFromRawBinary(aStream.Stream);
|
|
end;
|
|
|
|
procedure TDAParam.SaveToStream(const aStream: IROStream);
|
|
begin
|
|
VariantBinaryToRawBinary(Value, aStream.Stream);
|
|
end;
|
|
|
|
procedure TDAParam.SetParamType(Value: TDAParamType);
|
|
begin
|
|
fParamType := Value;
|
|
end;
|
|
|
|
procedure TDAParam.AssignField(Source: TDABaseField);
|
|
begin
|
|
inherited;
|
|
if Source is TDAParam then
|
|
ParamType := TDAParam(Source).ParamType;
|
|
end;
|
|
|
|
{ TDAParamCollection }
|
|
|
|
function TDAParamCollection.Add: TDAParam;
|
|
begin
|
|
result := TDAParam(inherited Add)
|
|
end;
|
|
|
|
constructor TDAParamCollection.Create(aOwner: TPersistent);
|
|
begin
|
|
inherited Create(aOwner, TDAParam);
|
|
end;
|
|
|
|
function TDAParamCollection.FindParam(
|
|
const aParamName: string): TDAParam;
|
|
begin
|
|
result := TDAParam(inherited FindItem(aParamName));
|
|
end;
|
|
|
|
function TDAParamCollection.GetParams(Index: integer): TDAParam;
|
|
begin
|
|
result := TDAParam(inherited Items[Index])
|
|
end;
|
|
|
|
function TDAParamCollection.ParamByName(const aName: string): TDAParam;
|
|
begin
|
|
result := TDAParam(inherited ItembyName(aName))
|
|
end;
|
|
|
|
procedure TDAParamCollection.ReadValues(InputParams: TParams);
|
|
var
|
|
i: integer;
|
|
par: TDAParam;
|
|
begin
|
|
for i := 0 to (Count - 1) do begin
|
|
par := Params[i];
|
|
par.Value := InputParams.ParamByName(par.Name).Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAParamCollection.SetParams(Index: integer; const Value: TDAParam);
|
|
begin
|
|
Params[Index].Assign(Value);
|
|
end;
|
|
|
|
procedure TDAParamCollection.WriteValues(OutputParams: TParams);
|
|
var
|
|
i: integer;
|
|
par: TDAParam;
|
|
outpar: TParam;
|
|
begin
|
|
for i := 0 to (Count - 1) do begin
|
|
par := Params[i];
|
|
outpar := OutputParams.ParamByName(par.Name);
|
|
if par.DataType = datBlob then begin
|
|
outpar.DataType := ftBlob;
|
|
outpar.Value := VariantBinaryToString(par.Value);
|
|
{ ToDo: make sure this is valid for ALL Data Drivers, only tested with IBX so far. mh. }
|
|
end
|
|
else begin
|
|
outpar.Value := par.Value;
|
|
end;
|
|
//outpar.Size := par.Size; // Seems to fix an ADO problem with size of parameters with SDAC
|
|
end;
|
|
end;
|
|
|
|
procedure TDAParamCollection.Assign(Source: TPersistent);
|
|
begin
|
|
if (Source is TDAParamCollection) then begin
|
|
AssignParamCollection(TDAParamCollection(Source))
|
|
end
|
|
else
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDAParamCollection.AssignParamCollection(Source: TDAParamCollection);
|
|
var
|
|
i: integer;
|
|
begin
|
|
Clear;
|
|
for i := 0 to (Source.Count - 1) do
|
|
Add.AssignField(Source[i]);
|
|
end;
|
|
|
|
function TDAParamCollection.GetHasInputParams: boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
result := false;
|
|
for i := 0 to Count-1 do begin
|
|
if Params[i].ParamType in [daptUnknown, daptInput, daptInputOutput] then begin
|
|
result := true;
|
|
exit;
|
|
end;
|
|
end; { for }
|
|
end;
|
|
|
|
{ TDASQLCommand }
|
|
|
|
procedure TDASQLCommand.Assign(aSource: TPersistent);
|
|
var
|
|
lSource: TDASQLCommand;
|
|
begin
|
|
if (aSource is TDASQLCommand) then begin
|
|
lSource := TDASQLCommand(aSource);
|
|
fName := lSource.fName;
|
|
fDescription := lSource.fDescription;
|
|
fStatements.Assign(lSource.fStatements);
|
|
fParams.Assign(lSource.fParams);
|
|
fCustomAttributes.Assign(lSource.CustomAttributes);
|
|
end
|
|
else begin
|
|
inherited;
|
|
end;
|
|
end;
|
|
|
|
constructor TDASQLCommand.Create(Collection: TCollection);
|
|
begin
|
|
inherited;
|
|
fIsPublic := true;
|
|
fStatements := TDAStatementCollection.Create(nil, Self);
|
|
fParams := TDAParamCollection.Create(nil);
|
|
fCustomAttributes := TStringList.Create;
|
|
end;
|
|
|
|
destructor TDASQLCommand.Destroy;
|
|
begin
|
|
fCustomAttributes.Free;
|
|
fStatements.Free;
|
|
fParams.Free;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
function TDASQLCommand.GetDisplayName: string;
|
|
begin
|
|
result := Name;
|
|
end;
|
|
|
|
function TDASQLCommand.GetParams: TDAParamCollection;
|
|
begin
|
|
result := fParams;
|
|
end;
|
|
|
|
function TDASQLCommand.GetSQLCommandCollection: TDASQLCommandCollection;
|
|
begin
|
|
result := TDASQLCommandCollection(Collection);
|
|
end;
|
|
|
|
function TDASQLCommand.ParamByName(const aName: string): TDAParam;
|
|
begin
|
|
result := fParams.ParamByName(aName)
|
|
end;
|
|
|
|
procedure TDASQLCommand.SetCustomAttributes(const Value: TStrings);
|
|
begin
|
|
fCustomAttributes.Assign(Value);
|
|
end;
|
|
|
|
procedure TDASQLCommand.SetDisplayName(const Value: string);
|
|
begin
|
|
inherited;
|
|
SetName(Value);
|
|
end;
|
|
|
|
procedure TDASQLCommand.SetName(const Value: string);
|
|
var
|
|
lOldName: string;
|
|
begin
|
|
lOldName := fName;
|
|
fName := Value;
|
|
if lOldName <> '' then
|
|
(Collection as TSearcheableCollection).TriggerOnItemRenamed(lOldName, fName);
|
|
end;
|
|
|
|
procedure TDASQLCommand.SetParams(const Value: TDAParamCollection);
|
|
begin
|
|
fParams.Assign(Value);
|
|
end;
|
|
|
|
procedure TDASQLCommand.SetStatements(const Value: TDAStatementCollection);
|
|
begin
|
|
fStatements.Assign(Value);
|
|
end;
|
|
|
|
function TDASQLCommand.GetStatements(): TDAStatementCollection;
|
|
begin
|
|
result := fStatements;
|
|
end;
|
|
|
|
|
|
{ TDADataset }
|
|
|
|
procedure TDADataset.Assign(aSource: TPersistent);
|
|
var
|
|
lSource: TDADataset;
|
|
begin
|
|
if (aSource is TDADataset) then begin
|
|
inherited; { Need to work the TDASQLCommand, too}
|
|
lSource := TDADataset(aSource);
|
|
fFields.Assign(lSource.Fields);
|
|
end
|
|
else begin
|
|
inherited;
|
|
end;
|
|
end;
|
|
|
|
constructor TDADataset.Create(Collection: TCollection);
|
|
begin
|
|
inherited;
|
|
fFields := TDAFieldCollection.Create(self);
|
|
fBusinessRulesServer := TDABusinessRuleScript.Create();
|
|
fBusinessRulesClient := TDAClientBusinessRuleScript.Create();
|
|
end;
|
|
|
|
destructor TDADataset.Destroy;
|
|
begin
|
|
FreeAndNil(fFields);
|
|
FreeAndNil(fBusinessRulesServer);
|
|
FreeAndNil(fBusinessRulesClient);
|
|
inherited;
|
|
end;
|
|
|
|
function TDADataset.FieldByName(const aName: string): TDAField;
|
|
begin
|
|
result := Fields.FieldByName(aName)
|
|
end;
|
|
|
|
function TDADataset.FindField(const aName: string): TDAField;
|
|
begin
|
|
result := Fields.FindField(aName)
|
|
end;
|
|
|
|
procedure TDADataset.SetBusinessRulesClient(const Value: TDAClientBusinessRuleScript);
|
|
begin
|
|
fBusinessRulesClient.Assign(Value);
|
|
end;
|
|
|
|
procedure TDADataset.SetBusinessRulesServer(const Value: TDABusinessRuleScript);
|
|
begin
|
|
fBusinessRulesServer.Assign(Value);
|
|
end;
|
|
|
|
procedure TDADataset.SetFields(const Value: TDAFieldCollection);
|
|
begin
|
|
fFields.Assign(Value);
|
|
end;
|
|
|
|
{ TDASQLCommandCollection }
|
|
|
|
function TDASQLCommandCollection.Add: TDASQLCommand;
|
|
begin
|
|
result := TDASQLCommand(inherited Add)
|
|
end;
|
|
|
|
constructor TDASQLCommandCollection.Create(aOwner: TComponent);
|
|
begin
|
|
inherited Create(aOwner, GetItemClass);
|
|
end;
|
|
|
|
function TDASQLCommandCollection.GetItemClass: TDASQLCommandClass;
|
|
begin
|
|
result := TDASQLCommand;
|
|
end;
|
|
|
|
function TDASQLCommandCollection.GetSQLCommands(
|
|
Index: integer): TDASQLCommand;
|
|
begin
|
|
result := TDASQLCommand(inherited Items[Index]);
|
|
end;
|
|
|
|
procedure TDASQLCommandCollection.SetSQLCommands(Index: integer;
|
|
const Value: TDASQLCommand);
|
|
begin
|
|
SQLCommands[Index].Assign(Value);
|
|
end;
|
|
|
|
function TDASQLCommandCollection.SQLCommandByName(
|
|
const aName: string): TDASQLCommand;
|
|
begin
|
|
result := TDASQLCommand(inherited ItemByName(aName));
|
|
end;
|
|
|
|
{ TDADatasetCollection }
|
|
|
|
function TDADatasetCollection.Add: TDADataset;
|
|
begin
|
|
result := TDADataset(inherited Add);
|
|
end;
|
|
|
|
function TDADatasetCollection.DatasetByName(const aName: string): TDADataset;
|
|
begin
|
|
result := TDADataset(inherited ItemByName(aName));
|
|
end;
|
|
|
|
function TDADatasetCollection.FindDatasetByName(const aName: string): TDADataset;
|
|
begin
|
|
result := TDADataset(inherited FindItem(aName));
|
|
end;
|
|
|
|
function TDADatasetCollection.GetDatasets(Index: integer): TDADataset;
|
|
begin
|
|
result := TDADataset(inherited Items[Index]);
|
|
end;
|
|
|
|
function TDADatasetCollection.GetItemClass: TDASQLCommandClass;
|
|
begin
|
|
result := TDADataset;
|
|
end;
|
|
|
|
procedure TDADatasetCollection.SetDatasets(Index: integer;
|
|
const Value: TDADataset);
|
|
begin
|
|
Datasets[Index].Assign(Value);
|
|
end;
|
|
|
|
{ TDAConnectionCollection }
|
|
|
|
function TDAConnectionCollection.Add: TDAConnection;
|
|
begin
|
|
result := TDAConnection(inherited Add);
|
|
end;
|
|
|
|
procedure TDAConnectionCollection.ClearDefaults(iExceptFor: TDAConnection);
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 0 to Count - 1 do begin
|
|
if (Connections[i] <> iExceptFor) then Connections[i].Default := false;
|
|
end;
|
|
end;
|
|
|
|
function TDAConnectionCollection.ConnectionByName(
|
|
const aName: string): TDAConnection;
|
|
begin
|
|
result := TDAConnection(inherited ItemByName(aName));
|
|
end;
|
|
|
|
constructor TDAConnectionCollection.Create(aOwner: TPersistent);
|
|
begin
|
|
inherited Create(aOwner, TDAConnection);
|
|
end;
|
|
|
|
function TDAConnectionCollection.FindConnection(const aName,
|
|
aType: string): TDAConnection;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if aName <> '' then begin
|
|
for i := 0 to Count -1 do begin
|
|
if GetConnections(i).Name = aName then begin
|
|
Result := GetConnections(i);
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if aType <> '' then begin
|
|
for i := 0 to Count -1 do begin
|
|
if GetConnections(i).ConnectionType = aType then begin
|
|
Result := GetConnections(i);
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
result := nil;
|
|
end;
|
|
|
|
function TDAConnectionCollection.GetConnections(
|
|
Index: integer): TDAConnection;
|
|
begin
|
|
result := TDAConnection(inherited Items[Index]);
|
|
end;
|
|
|
|
function TDAConnectionCollection.GetDefaultConnection: TDAConnection;
|
|
begin
|
|
result := inherited GetDefaultItem as TDAConnection;
|
|
end;
|
|
|
|
function TDAConnectionCollection.ItemName: string;
|
|
begin
|
|
result := 'connection';
|
|
end;
|
|
|
|
procedure TDAConnectionCollection.SetConnections(Index: integer;
|
|
const Value: TDAConnection);
|
|
begin
|
|
Connections[Index].Assign(Value);
|
|
end;
|
|
|
|
{ TDAConnection }
|
|
|
|
procedure TDAConnection.Assign(aSource: TPersistent);
|
|
var
|
|
lSource: TDAConnection;
|
|
begin
|
|
if (aSource is TDAConnection) then begin
|
|
lSource := TDAConnection(aSource);
|
|
fDescription := lSource.fDescription;
|
|
ConnectionString := lSource.ConnectionString;
|
|
ConnectionType := lSource.ConnectionType;
|
|
fName := '_____' + lSource.fName;
|
|
fDefault := false;
|
|
end
|
|
else begin
|
|
inherited;
|
|
end;
|
|
end;
|
|
|
|
function TDAConnection.GetConnectionString: string;
|
|
begin
|
|
result := fConnectionString;
|
|
end;
|
|
|
|
function TDAConnection.GetDisplayName: string;
|
|
begin
|
|
if (Trim(Name) = '') then
|
|
result := '<Noname>'
|
|
else
|
|
result := Name;
|
|
|
|
//if Default then result := result+' - [Default]';
|
|
end;
|
|
|
|
procedure TDAConnection.SetConnectionString(const aValue: string);
|
|
begin
|
|
if fConnectionString <> aValue then
|
|
fConnectionString := aValue;
|
|
end;
|
|
|
|
procedure TDAConnection.SetDefault(const Value: boolean);
|
|
begin
|
|
if (fDefault <> Value) then begin
|
|
fDefault := Value;
|
|
if Default then begin
|
|
(Collection as TDAConnectionCollection).ClearDefaults(self);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAConnection.SetDisplayName(const Value: string);
|
|
begin
|
|
inherited;
|
|
SetName(Value);
|
|
end;
|
|
|
|
procedure TDAConnection.SetName(const Value: string);
|
|
var
|
|
lOldName: string;
|
|
begin
|
|
if (Value <> fName) then begin
|
|
lOldName := fName;
|
|
fName := Value;
|
|
if lOldName <> '' then
|
|
(Collection as TDAConnectionCollection).TriggerOnItemRenamed(lOldName, fName);
|
|
end;
|
|
end;
|
|
|
|
{ TDAStatement }
|
|
|
|
procedure TDAStatement.Assign(aSource: TPersistent);
|
|
var
|
|
lSource: TDAStatement;
|
|
begin
|
|
if (aSource is TDAStatement) then begin
|
|
lSource := TDAStatement(aSource);
|
|
fSQL := lSource.fSQL;
|
|
fStatementType := lSource.fStatementType;
|
|
fConnection := lSource.fConnection;
|
|
fColumnMappings.Assign(lSource.fColumnMappings);
|
|
fTargetTable := lSource.fTargetTable;
|
|
end
|
|
else begin
|
|
inherited;
|
|
end;
|
|
end;
|
|
|
|
constructor TDAStatement.Create(Collection: TCollection);
|
|
begin
|
|
inherited;
|
|
fColumnMappings := TDAColumnMappingCollection.Create(Self);
|
|
end;
|
|
|
|
destructor TDAStatement.Destroy;
|
|
begin
|
|
fColumnMappings.Free;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
function TDAStatement.GetNeedsParams: boolean;
|
|
var
|
|
lParams: TParams;
|
|
lSQL: string;
|
|
begin
|
|
lParams := TParams.Create;
|
|
try
|
|
{ Bug in ParseSQL modified passed in string; use UniqueString to prevent
|
|
corrupting the original! }
|
|
lSQL := SQL;
|
|
UniqueString(lSQL);
|
|
lParams.ParseSQL(lSQL, TRUE);
|
|
result := (lParams.Count > 0);
|
|
finally
|
|
lParams.Free;
|
|
end;
|
|
end;
|
|
|
|
function TDAStatement.GetStatementCollection: TDAStatementCollection;
|
|
begin
|
|
result := TDAStatementCollection(Collection);
|
|
end;
|
|
|
|
procedure TDAStatement.SetColumnMappings(
|
|
const Value: TDAColumnMappingCollection);
|
|
begin
|
|
fColumnMappings.Assign(Value);
|
|
end;
|
|
|
|
procedure TDAStatement.SetSQL(const Value: string);
|
|
begin
|
|
fSQL := Value;
|
|
end;
|
|
|
|
function TDAStatement.StoreSQL: Boolean;
|
|
begin
|
|
Result := fStatementType <> stAutoSQL;
|
|
end;
|
|
|
|
{ TDAColumnMappingCollection }
|
|
|
|
function TDAColumnMappingCollection.Add: TDAColumnMapping;
|
|
begin
|
|
result := TDAColumnMapping(inherited Add);
|
|
end;
|
|
|
|
procedure TDAColumnMappingCollection.AssignColumnMapping(aSource: TPersistent);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Clear;
|
|
for i := 0 to TDAColumnMappingCollection(aSource).Count -1 do begin
|
|
Add.AssignFieldMapping(TDAColumnMappingCollection(aSource)[i]);
|
|
end;
|
|
end;
|
|
|
|
constructor TDAColumnMappingCollection.Create(aOwner: TPersistent);
|
|
begin
|
|
inherited Create(aOwner, TDAColumnMapping);
|
|
end;
|
|
|
|
function TDAColumnMappingCollection.FindMappingByDatasetField(
|
|
const aDatasetField: string): TDAColumnMapping;
|
|
var
|
|
i: integer;
|
|
begin
|
|
result := nil;
|
|
|
|
for i := 0 to (Count - 1) do
|
|
if SameText(ColumnMappings[i].DatasetField, aDatasetField) then begin
|
|
result := ColumnMappings[i];
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
function TDAColumnMappingCollection.GetColumnMappings(
|
|
Index: integer): TDAColumnMapping;
|
|
begin
|
|
result := TDAColumnMapping(inherited Items[Index])
|
|
end;
|
|
|
|
function TDAColumnMappingCollection.GetItemName(
|
|
anItem: TCollectionItem): string;
|
|
begin
|
|
result := TDAColumnMapping(anItem).DatasetField;
|
|
end;
|
|
|
|
function TDAColumnMappingCollection.MappingByDatasetField(
|
|
const aDatasetField: string): TDAColumnMapping;
|
|
begin
|
|
result := TDAColumnMapping(inherited ItemByName(aDatasetField))
|
|
end;
|
|
|
|
function TDAColumnMappingCollection.MappingByTableField(
|
|
const aTableField: string): TDAColumnMapping;
|
|
var
|
|
i: integer;
|
|
begin
|
|
result := nil;
|
|
|
|
for i := 0 to (Count - 1) do
|
|
if SameText(ColumnMappings[i].TableField, aTableField) then begin
|
|
result := ColumnMappings[i];
|
|
Exit;
|
|
end;
|
|
|
|
RaiseError('Cannot find mapping for table field %s', [aTableField]);
|
|
end;
|
|
|
|
procedure TDAColumnMappingCollection.SetColumnMappings(Index: integer;
|
|
const Value: TDAColumnMapping);
|
|
begin
|
|
TDAColumnMapping(inherited Items[Index]).AssignTo(Value);
|
|
end;
|
|
|
|
function TDAColumnMappingCollection.SetItemName(anItem: TCollectionItem;
|
|
const aName: string): string;
|
|
begin
|
|
TDAColumnMapping(anItem).DatasetField := aName;
|
|
end;
|
|
|
|
{ TDAWhere }
|
|
|
|
function TDAWhere.GetProperName(aField: TDACustomField) : string;
|
|
begin
|
|
if fClientFields
|
|
then result := ClientFieldPrefix+aField.Name
|
|
else result := aField.TableField
|
|
end;
|
|
|
|
function TDAWhere.AddCondition(const FieldName: string;
|
|
Condition: TDASQLCondition; const Value: Variant; SkipIfEmptyValue: boolean = TRUE): boolean;
|
|
var
|
|
isstr, isnull, isfloat, isCurr: boolean;
|
|
fld: TDACustomField;
|
|
fieldnametouse : string;
|
|
str: string;
|
|
oldDecimalSeparator: Char;
|
|
begin
|
|
result := FALSE;
|
|
|
|
fld := fFields.FindField(FieldName);
|
|
|
|
isnull := VarIsNull(Value) or (VarIsType(Value, [varString, varOleStr]) and (Value = ''))
|
|
or (VarIsType(Value, [varDate]) and (Value = 0));
|
|
if isnull and SkipIfEmptyValue then Exit;
|
|
if fLastWasCondition then
|
|
begin
|
|
case fDefaultOperator of
|
|
doAnd: AddOperator(opAND);
|
|
doOr: AddOperator(opOR);
|
|
end;
|
|
end;
|
|
fLastWasCondition := True;
|
|
|
|
if fld <> nil then
|
|
fieldnametouse := GetProperName(fld) // Changed by AleF: WHERE clauses cannot work with field aliases like "FieldA as XYZ"
|
|
else
|
|
fieldnametouse := FieldName;
|
|
|
|
fClause := fClause + '(' + fieldnametouse + ' ' + StrSQLCondition[Condition] + ' ';
|
|
|
|
isstr := (fld <> nil) and (fld.DataType in [datWideString, datWideMemo, datString, datDateTime, datMemo]);
|
|
isfloat := (fld <> nil) and (fld.DataType in [datFloat, datSingleFloat]);
|
|
isCurr :=(fld <> nil) and (fld.DataType in [datCurrency]);
|
|
|
|
case Condition of
|
|
cIsNull, cIsNotNull:begin
|
|
fClause := TrimRight(fClause) + ')';
|
|
end;
|
|
else begin
|
|
if isstr then begin
|
|
str:=VarToStr(Value);
|
|
if Condition = cIn then
|
|
fClause := fClause + '(' + str + '))'
|
|
else
|
|
fClause := fClause + '''' + str + ''')'
|
|
end
|
|
else begin
|
|
if isfloat or isCurr then begin
|
|
oldDecimalSeparator := DecimalSeparator;
|
|
DecimalSeparator := '.';
|
|
try
|
|
if isfloat then str:= FloatToStr(Value)
|
|
else str:=CurrToStrF(Value,ffGeneral,4);
|
|
finally
|
|
DecimalSeparator := oldDecimalSeparator;
|
|
end;
|
|
end
|
|
else
|
|
str:=VarToStr(Value);
|
|
if Condition = cIn then
|
|
fClause := fClause + '(' + str + '))'
|
|
else
|
|
fClause := fClause + str + ')';
|
|
end;
|
|
end;
|
|
end;
|
|
result := TRUE;
|
|
Changed := True;
|
|
|
|
if Assigned(OnChange) then OnChange(Self);
|
|
end;
|
|
|
|
procedure TDAWhere.AddValueGroup(const FieldName: string;
|
|
const Values: array of Variant);
|
|
var
|
|
fld: TDAField;
|
|
isstr: boolean;
|
|
cnt, i: integer;
|
|
fieldnametouse : string;
|
|
begin
|
|
fld := fFields.FieldByName(FieldName);
|
|
|
|
if fLastWasCondition then
|
|
begin
|
|
case fDefaultOperator of
|
|
doAnd: AddOperator(opAND);
|
|
doOr: AddOperator(opOR);
|
|
end;
|
|
end;
|
|
fLastWasCondition := True;
|
|
|
|
fieldnametouse := GetProperName(fld); // Changed by AleF: WHERE clauses cannot work with field aliases like "FieldA as XYZ"
|
|
|
|
if (Length(Values) > 0) then begin
|
|
isstr := (fld.DataType in [datWideString, datWideMemo, datString, datDateTime, datMemo]);
|
|
|
|
fClause := fClause + '(' + fieldnametouse + ' ' + StrSQLCondition[cIn] + ' (';
|
|
|
|
cnt := High(Values);
|
|
for i := 0 to cnt do begin
|
|
if isstr then
|
|
fClause := fClause + '''' + VarToStr(Values[i]) + ''''
|
|
else
|
|
fClause := fClause + VarToStr(Values[i]) + '';
|
|
|
|
if (i < cnt) then fClause := fClause + ', ';
|
|
end;
|
|
fClause := fClause + '))';
|
|
end;
|
|
Changed := True;
|
|
if Assigned(OnChange) then OnChange(Self);
|
|
end;
|
|
|
|
constructor TDAWhere.Create(const aFields: TDAFieldCollection; aClientFields : boolean);
|
|
begin
|
|
inherited Create;
|
|
fDefaultOperator := doAnd;
|
|
fFields := aFields;
|
|
fClientFields := aClientFields;
|
|
end;
|
|
|
|
{$WARN SYMBOL_DEPRECATED OFF} // Delphi warns you about implementing a method that's deprecated in the interface.
|
|
|
|
procedure TDAWhere.OpenBraket;
|
|
begin
|
|
OpenBracket();
|
|
end;
|
|
|
|
procedure TDAWhere.CloseBraket;
|
|
begin
|
|
CloseBracket();
|
|
end;
|
|
|
|
{$WARN SYMBOL_DEPRECATED ON}
|
|
|
|
procedure TDAWhere.OpenBracket;
|
|
begin
|
|
fClause := fClause + '(';
|
|
Changed := True;
|
|
if Assigned(OnChange) then OnChange(Self);
|
|
end;
|
|
|
|
procedure TDAWhere.CloseBracket;
|
|
begin
|
|
fClause := fClause + ')';
|
|
Changed := True;
|
|
if Assigned(OnChange) then OnChange(Self);
|
|
end;
|
|
|
|
procedure TDAWhere.AddOperator(aOperator: TDASQLOperator);
|
|
begin
|
|
fClause := fClause + ' ' + StrSQLOperator[aOperator] + ' ';
|
|
Changed := True;
|
|
fLastWasCondition := False;
|
|
if Assigned(OnChange) then OnChange(Self);
|
|
end;
|
|
|
|
procedure TDAWhere.Clear;
|
|
begin
|
|
fClause := '';
|
|
fLastWasCondition := false;
|
|
Changed := True;
|
|
if Assigned(OnChange) then OnChange(Self);
|
|
end;
|
|
|
|
procedure TDAWhere.AddText(const someText: string; MapClientFields : boolean = TRUE);
|
|
var s : string;
|
|
i : integer;
|
|
begin
|
|
s := someText;
|
|
|
|
if MapClientFields then begin
|
|
for i := 0 to (Fields.Count-1) do
|
|
s := StringReplace(s, ClientFieldPrefix+Fields[i].Name, Fields[i].TableField, [rfReplaceAll, rfIgnoreCase]);
|
|
end;
|
|
|
|
fClause := fClause + s;
|
|
|
|
Changed := True;
|
|
if Assigned(OnChange) then OnChange(Self);
|
|
end;
|
|
|
|
procedure TDAWhere.AddSpaces(Count: integer = 1);
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 1 to Count do
|
|
fClause := fClause + ' ';
|
|
|
|
Changed := True;
|
|
if Assigned(OnChange) then OnChange(Self);
|
|
end;
|
|
|
|
function TDAWhere.GetEmpty: boolean;
|
|
begin
|
|
result := Trim(fClause)=''
|
|
end;
|
|
|
|
function TDAWhere.GetNotEmpty: boolean;
|
|
begin
|
|
result := not Empty
|
|
end;
|
|
|
|
function TDAWhere.AddConditions(const FieldNames: array of string;
|
|
const Conditions: array of TDASQLCondition;
|
|
const Values: array of Variant;
|
|
const Operator: TDASQLOperator): integer;
|
|
var i : integer;
|
|
isnull : boolean;
|
|
oldclause : string;
|
|
oldonchange : TNotifyEvent;
|
|
begin
|
|
result := 0;
|
|
oldclause := fClause;
|
|
oldonchange := OnChange;
|
|
OnChange := NIL;
|
|
try
|
|
for i := 0 to Length(FieldNames)-1 do begin
|
|
isnull := VarIsNull(Values[i]) or (VarIsType(Values[i], [varString, varOleStr]) and (Values[i] = ''));
|
|
if isnull then Continue;
|
|
|
|
if NotEmpty then AddOperator(Operator);
|
|
AddCondition(FieldNames[i], Conditions[i], Values[i], TRUE);
|
|
Inc(result);
|
|
end;
|
|
finally
|
|
// This is to avoid OnChange fireing for each condition in the loop above
|
|
OnChange := oldonchange;
|
|
Changed := True;
|
|
if Assigned(OnChange) then OnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
function TDAWhere.AddCondition(const FieldName: string;
|
|
Condition: TDASQLCondition): boolean;
|
|
begin
|
|
Result:=AddCondition(FieldName,Condition,0);
|
|
end;
|
|
|
|
{ TDAColumnMapping }
|
|
|
|
procedure TDAColumnMapping.Assign(aSource: TPersistent);
|
|
var
|
|
lSource: TDAColumnMapping;
|
|
begin
|
|
if (aSource is TDAColumnMapping) then begin
|
|
lSource := TDAColumnMapping(aSource);
|
|
fDatasetField := lSource.fDatasetField;
|
|
fTableField := lSource.fTableField;
|
|
end
|
|
else begin
|
|
inherited;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAColumnMapping.AssignFieldMapping(aSource: TPersistent);
|
|
var
|
|
lSource: TDAColumnMapping;
|
|
begin
|
|
lSource := TDAColumnMapping(aSource);
|
|
fDatasetField := lSource.fDatasetField;
|
|
fTableField := lSource.fTableField;
|
|
fSQLOrigin := lSource.fSQLOrigin;
|
|
end;
|
|
|
|
function TDAColumnMapping.GetSQLOrigin: string;
|
|
begin
|
|
if (fSQLOrigin='')
|
|
then result := TableField
|
|
else result := fSQLOrigin
|
|
end;
|
|
|
|
procedure TDAColumnMapping.SetDatasetField(const Value: string);
|
|
begin
|
|
fDatasetField := Trim(Value);
|
|
end;
|
|
|
|
procedure TDAColumnMapping.SetSQLOrigin(const Value: string);
|
|
begin
|
|
fSQLOrigin:= Trim(Value)
|
|
end;
|
|
|
|
procedure TDAColumnMapping.SetTableField(const Value: string);
|
|
begin
|
|
fTableField := Trim(Value);
|
|
end;
|
|
|
|
function TDAColumnMapping.StoreSQLOrigin: Boolean;
|
|
begin
|
|
result := (fSQLOrigin <> fTableField) and (Trim(fSQLOrigin)<>'')
|
|
end;
|
|
|
|
{ TDAClientBusinessRuleScript }
|
|
|
|
constructor TDAClientBusinessRuleScript.Create;
|
|
begin
|
|
inherited;
|
|
fRunOnClientAndServer := true;
|
|
fCompileOnServer := true;
|
|
end;
|
|
|
|
{ TDADriverForeignKey }
|
|
|
|
function TDADriverForeignKey.GetValue(const Index: Integer): string;
|
|
begin
|
|
result := fValues[Index];
|
|
end;
|
|
|
|
procedure TDADriverForeignKey.SetValue(const Index: Integer; const Value: string);
|
|
begin
|
|
fValues[Index] := Value;
|
|
end;
|
|
|
|
{ TDADriverForeignKeyCollection }
|
|
|
|
constructor TDADriverForeignKeyCollection.Create(aOwner: TPersistent);
|
|
begin
|
|
inherited Create(aOwner, TDADriverForeignKey);
|
|
end;
|
|
|
|
function TDADriverForeignKeyCollection.Add: TDADriverForeignKey;
|
|
begin
|
|
result := TDADriverForeignKey(inherited Add());
|
|
end;
|
|
|
|
function TDADriverForeignKeyCollection.GetForeignKeys(Index: integer): TDADriverForeignKey;
|
|
begin
|
|
result := TDADriverForeignKey(inherited Items[Index]);
|
|
end;
|
|
|
|
procedure TDADriverForeignKeyCollection.SetForeignKeys(Index: integer; const Value: TDADriverForeignKey);
|
|
begin
|
|
inherited Items[Index].Assign(Value);
|
|
end;
|
|
|
|
{ TDAUpdateRuleCollection }
|
|
|
|
function TDAUpdateRuleCollection.Add: TDAUpdateRule;
|
|
begin
|
|
result := inherited Add() as TDAUpdateRule;
|
|
end;
|
|
|
|
constructor TDAUpdateRuleCollection.Create(aOwner : TComponent);
|
|
begin
|
|
inherited Create(aOwner, TDAUpdateRule);
|
|
end;
|
|
|
|
function TDAUpdateRuleCollection.GetUpdateRules(
|
|
Index: integer): TDAUpdateRule;
|
|
begin
|
|
result := TDAUpdateRule(inherited Items[Index]);
|
|
end;
|
|
|
|
function TDAUpdateRuleCollection.UpdateRuleByName(
|
|
const aName: string): TDAUpdateRule;
|
|
begin
|
|
result := ItemByName(aName) as TDAUpdateRule
|
|
end;
|
|
|
|
{ TDAUpdateRule }
|
|
|
|
procedure TDAUpdateRule.Assign(aSource: TPersistent);
|
|
var
|
|
lSource: TDAUpdateRule;
|
|
begin
|
|
lSource := aSource as TDAUpdateRule;
|
|
fDatasetName := lSource.fDatasetName;
|
|
fName := lSource.fName;
|
|
fDoUpdate := lSource.fDoUpdate;
|
|
fDoInsert := lSource.fDoInsert;
|
|
fDoDelete := lSource.fDoDelete;
|
|
fFailureBehavior := lSource.fFailureBehavior;
|
|
end;
|
|
|
|
constructor TDAUpdateRule.Create(aCollection: TCollection);
|
|
begin
|
|
inherited;
|
|
|
|
fDoUpdate := true;
|
|
fDoInsert := true;
|
|
fDoDelete := true;
|
|
fFailureBehavior := fbRaiseException;
|
|
end;
|
|
|
|
function TDAUpdateRule.GetChangeTypes: TDAChangeTypes;
|
|
begin
|
|
result := [];
|
|
if DoUpdate then Include(result,ctUpdate);
|
|
if DoInsert then Include(result,ctInsert);
|
|
if DoDelete then Include(result,ctDelete);
|
|
end;
|
|
|
|
function TDAUpdateRule.GetDisplayName: string;
|
|
begin
|
|
result := Name;
|
|
if (result='') then result := '<Unknown>';
|
|
end;
|
|
|
|
{ TDADatasetRelationshipCollection }
|
|
|
|
function TDADatasetRelationshipCollection.Add: TDADatasetRelationship;
|
|
begin
|
|
result := inherited Add() as TDADatasetRelationship;
|
|
end;
|
|
|
|
constructor TDADatasetRelationshipCollection.Create(aOwner: TComponent);
|
|
begin
|
|
inherited Create(aOwner, TDADatasetRelationship);
|
|
end;
|
|
|
|
procedure TDADatasetRelationshipCollection.GetDetails(const aMasterDatasetName: string; aList: TDADatasetRelationshipList);
|
|
var i : integer;
|
|
begin
|
|
aList.Clear;
|
|
for i := 0 to (Count-1) do begin
|
|
if SameText(aMasterDatasetName, RelationShips[i].MasterDatasetName) then begin
|
|
aList.Add(RelationShips[i]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TDADatasetRelationshipCollection.GetRelationShips(
|
|
Index: integer): TDADatasetRelationship;
|
|
begin
|
|
result := TDADatasetRelationship(inherited Items[Index]);
|
|
end;
|
|
|
|
function TDADatasetRelationshipCollection.RelationShipByName(
|
|
const aName: string): TDADatasetRelationship;
|
|
begin
|
|
result := ItemByName(aName) as TDADatasetRelationship;
|
|
end;
|
|
|
|
{ TDADatasetRelationship }
|
|
|
|
procedure TDADatasetRelationship.Assign(Source: TPersistent);
|
|
var src : TDADatasetRelationship;
|
|
begin
|
|
if (Source is TDADatasetRelationship) then begin
|
|
src := TDADatasetRelationship(Source);
|
|
|
|
Name := src.Name;
|
|
MasterDatasetName := src.MasterDatasetName;
|
|
MasterFields := src.MasterFields;
|
|
DetailDatasetName := src.DetailDatasetName;
|
|
DetailFields := src.DetailFields;
|
|
end
|
|
else inherited;
|
|
end;
|
|
|
|
function TDADatasetRelationship.GetDisplayName: string;
|
|
begin
|
|
result := Format('%s: %s (%s) --> %s (%s)', [fName, fDetailDatasetName, fDetailFields, fMasterDatasetName, fMasterFields]);
|
|
end;
|
|
|
|
{ TDADatasetRelationshipList }
|
|
|
|
function TDADatasetRelationshipList.Add(
|
|
aRelationship: TDADatasetRelationship): integer;
|
|
begin
|
|
result := inherited Add(aRelationship)
|
|
end;
|
|
|
|
function TDADatasetRelationshipList.GetItems(
|
|
Index: integer): TDADatasetRelationship;
|
|
begin
|
|
result := TDADatasetRelationship(inherited Items[Index]);
|
|
end;
|
|
|
|
{ TDALoginInfoAware }
|
|
|
|
function TDALoginInfoAware._AddRef: Integer;
|
|
begin
|
|
result := -1;
|
|
end;
|
|
|
|
function TDALoginInfoAware._Release: Integer;
|
|
begin
|
|
result := -1;
|
|
end;
|
|
|
|
function TDALoginInfoAware.GetLoginInfo: TDALoginInfo;
|
|
begin
|
|
result := fLoginInfo
|
|
end;
|
|
|
|
procedure TDALoginInfoAware.SetLoginInfo(aValue: TDALoginInfo);
|
|
begin
|
|
fLoginInfo := aValue;
|
|
end;
|
|
|
|
{ TDAJoinDataTableCollection }
|
|
|
|
constructor TDAJoinDataTableCollection.Create(aOwner : TComponent);
|
|
begin
|
|
inherited Create(aOwner, TDAJoinDataTable);
|
|
end;
|
|
|
|
function TDAJoinDataTableCollection.GetJoinDataTables(Index: integer): TDAJoinDataTable;
|
|
begin
|
|
result := TDAJoinDataTable(inherited Items[Index]);
|
|
end;
|
|
|
|
procedure TDAJoinDataTableCollection.SetJoinDataTables(Index: integer; const Value: TDAJoinDataTable);
|
|
begin
|
|
JoinTables[Index].Assign(Value);
|
|
end;
|
|
|
|
{
|
|
function TDAJoinedTableCollection.GetItemClass: TDASQLCommandClass;
|
|
begin
|
|
result := TDAJoinedTable;
|
|
end;
|
|
}
|
|
|
|
function TDAJoinDataTableCollection.Add: TDAJoinDataTable;
|
|
begin
|
|
result := TDAJoinDataTable(inherited Add);
|
|
end;
|
|
|
|
function TDAJoinDataTableCollection.JoinTableByName(const aName: string): TDAJoinDataTable;
|
|
begin
|
|
result := TDAJoinDataTable(inherited ItemByName(aName));
|
|
end;
|
|
|
|
function TDAJoinDataTableCollection.FindJoinTableByName(const aName: string): TDAJoinDataTable;
|
|
begin
|
|
result := TDAJoinDataTable(inherited FindItem(aName));
|
|
end;
|
|
|
|
{ TDAJoinSourceTableCollection }
|
|
|
|
function TDAJoinSourceTableCollection.GetJoinSourceTables(Index: integer): TDAJoinSourceTable;
|
|
begin
|
|
result := TDAJoinSourceTable(inherited Items[Index])
|
|
end;
|
|
|
|
procedure TDAJoinSourceTableCollection.SetJoinSourceTables(Index: integer; const Value: TDAJoinSourceTable);
|
|
begin
|
|
TDAJoinSourceTable(inherited Items[Index]).AssignTo(Value);
|
|
end;
|
|
|
|
constructor TDAJoinSourceTableCollection.Create(aOwner: TPersistent);
|
|
begin
|
|
inherited Create(aOwner, TDAJoinSourceTable);
|
|
end;
|
|
|
|
function TDAJoinSourceTableCollection.Add: TDAJoinSourceTable;
|
|
begin
|
|
result := TDAJoinSourceTable(inherited Add);
|
|
end;
|
|
|
|
function TDAJoinSourceTableCollection.JoinSourceTableByName(const aName: string): TDAJoinSourceTable;
|
|
begin
|
|
result := TDAJoinSourceTable(inherited ItemByName(aName));
|
|
end;
|
|
{
|
|
function TDAJoinedTableItemCollection.GetItemClass: TDAJoinedTableItem;
|
|
begin
|
|
result := TDAJoinedTableItem;
|
|
end;
|
|
}
|
|
|
|
{ TDAJoinDataTable }
|
|
constructor TDAJoinDataTable.Create(Collection: TCollection);
|
|
begin
|
|
inherited;
|
|
fJoinSourceTables := TDAJoinSourceTableCollection.Create(self);
|
|
end;
|
|
|
|
destructor TDAJoinDataTable.Destroy;
|
|
begin
|
|
FreeAndNil(fJoinSourceTables);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDAJoinDataTable.Assign(aSource: TPersistent);
|
|
var
|
|
lSource: TDAJoinDataTable;
|
|
begin
|
|
if (aSource is TDAJoinDataTable) then begin
|
|
inherited; { Need to work the TDASQLCommand, too}
|
|
lSource := TDAJoinDataTable(aSource);
|
|
fJoinSourceTables.Assign(lSource.fJoinSourceTables);
|
|
fMasterTable:= lSource.fMasterTable;
|
|
end
|
|
else begin
|
|
inherited;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAJoinDataTable.SetJoinSourceTables(const Value: TDAJoinSourceTableCollection);
|
|
begin
|
|
fJoinSourceTables.Assign(Value);
|
|
end;
|
|
|
|
function TDAJoinDataTable.GetParams: TDAParamCollection;
|
|
begin
|
|
result := nil;
|
|
end;
|
|
|
|
procedure TDAJoinDataTable.SetParams(const Value: TDAParamCollection);
|
|
begin
|
|
// Do Nothing
|
|
end;
|
|
|
|
function TDAJoinDataTable.GetStatements(): TDAStatementCollection;
|
|
begin
|
|
result := nil;
|
|
end;
|
|
|
|
procedure TDAJoinDataTable.SetStatements(const Value: TDAStatementCollection);
|
|
begin
|
|
// Do Nothing
|
|
end;
|
|
|
|
function TDAJoinDataTable.GetSQLCommandCollection: TDASQLCommandCollection;
|
|
begin
|
|
result := nil;
|
|
end;
|
|
|
|
|
|
{ TDAJoinSourceTable }
|
|
constructor TDAJoinSourceTable.Create(Collection: TCollection);
|
|
begin
|
|
inherited;
|
|
fJoinConditions := TDAJoinConditionCollection.Create(Self);
|
|
end;
|
|
|
|
function TDAJoinSourceTable.GetDisplayName: string;
|
|
begin
|
|
if (Trim(Name) = '') then
|
|
result := '<Noname>'
|
|
else
|
|
result := Name;
|
|
end;
|
|
|
|
procedure TDAJoinSourceTable.SetName(const Value: string);
|
|
var
|
|
lOldName: string;
|
|
begin
|
|
lOldName := fName;
|
|
fName := Value;
|
|
if lOldName <> '' then
|
|
(Collection as TSearcheableCollection).TriggerOnItemRenamed(lOldName, fName);
|
|
end;
|
|
|
|
procedure TDAJoinSourceTable.Assign(aSource: TPersistent);
|
|
var
|
|
lSource: TDAJoinSourceTable;
|
|
begin
|
|
if (aSource is TDAJoinSourceTable) then begin
|
|
lSource := TDAJoinSourceTable(aSource);
|
|
fName:= lSource.fName;
|
|
fJoinType:= lSource.fJoinType;
|
|
fJoinConditions.Assign(lSource.fJoinConditions);
|
|
end
|
|
else begin
|
|
inherited;
|
|
end;
|
|
end;
|
|
|
|
{ TDAJoinConditionCollection }
|
|
constructor TDAJoinConditionCollection.Create(aOwner: TPersistent);
|
|
begin
|
|
inherited Create(aOwner, TDAJoinCondition);
|
|
end;
|
|
|
|
function TDAJoinConditionCollection.Add: TDAJoinCondition;
|
|
begin
|
|
result := TDAJoinCondition(inherited Add);
|
|
end;
|
|
|
|
constructor TDADatasetRelationship.Create(Collection: TCollection);
|
|
begin
|
|
inherited Create(Collection);
|
|
fRelationshipType := rtForeignKey;
|
|
end;
|
|
|
|
{ TDATableFieldCollectionItem }
|
|
|
|
procedure TDATableFieldCollectionItem.Assign(Source: TPersistent);
|
|
begin
|
|
inherited;
|
|
if Source is TDATableFieldCollectionItem then begin
|
|
self.FFieldName := TDATableFieldCollectionItem(Source).FieldName;
|
|
self.FTableName := TDATableFieldCollectionItem(Source).TableName;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TDAQueryBuilder }
|
|
|
|
procedure TDAQueryBuilder.AddCrossJoin(ATable: string);
|
|
begin
|
|
with FMainTable.JoinSourceTables.Add do begin
|
|
JoinType := jtCross;
|
|
Name := ATable;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAQueryBuilder.AddGroupBy(ATable, AField: string);
|
|
begin
|
|
with TDAGroupByItem(FGroupByCollection.Add) do begin
|
|
TableName := aTable;
|
|
FieldName := AField;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAQueryBuilder.AddJoin(AJoinTable, AJoinFieldName,
|
|
AJoinToTableName, AJoinToFieldName: string; AJoinType: TDAJoinType);
|
|
begin
|
|
with FMainTable.JoinSourceTables.Add do begin
|
|
JoinType := AJoinType;
|
|
Name := AJoinTable;
|
|
with JoinConditions.Add do begin
|
|
FromTableName := AJoinTable;
|
|
FromFieldName := AJoinFieldName;
|
|
ToTableName := AJoinToTableName;
|
|
ToFieldName := AJoinToFieldName;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAQueryBuilder.AddJoin(AJoinTable: string;
|
|
AJoinFieldNames: array of string; AJoinToTableName: string;
|
|
AJoinToFieldNames: array of string; AJoinType: TDAJoinType);
|
|
var
|
|
i: integer;
|
|
begin
|
|
if High(AJoinToFieldNames) <> High(AJoinFieldNames) then raise Exception.Create('Can''t create join: AJoinFieldNames and AJoinToFieldNames should contain equal members count');
|
|
with FMainTable.JoinSourceTables.Add do begin
|
|
JoinType := AJoinType;
|
|
Name := AJoinTable;
|
|
For i:=0 to High(AJoinToFieldNames) do
|
|
with JoinConditions.Add do begin
|
|
FromTableName := AJoinTable;
|
|
FromFieldName := AJoinFieldNames[i];
|
|
ToTableName := AJoinToTableName;
|
|
ToFieldName := AJoinToFieldNames[i];
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAQueryBuilder.AddOrderBy(ATable, AField: string);
|
|
begin
|
|
with TDAOrderByItem(FOrderByCollection.Add) do begin
|
|
TableName := aTable;
|
|
FieldName := AField;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAQueryBuilder.AddSelect(ATable, AField: string);
|
|
begin
|
|
with TDASelectItem(FSelectCollection.Add) do begin
|
|
TableName := aTable;
|
|
FieldName := AField;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAQueryBuilder.Assign(Source: TPersistent);
|
|
begin
|
|
inherited;
|
|
if Source is TDAQueryBuilder then begin
|
|
FMainTable.Assign(TDAQueryBuilder(Source).MainTable);
|
|
FSelectCollection.Assign(TDAQueryBuilder(Source).Select);
|
|
FGroupByCollection.Assign(TDAQueryBuilder(Source).GroupBy);
|
|
FOrderByCollection.Assign(TDAQueryBuilder(Source).OrderBy);
|
|
FOptions:=TDAQueryBuilder(Source).FOptions;
|
|
FConnection:=TDAQueryBuilder(Source).Connection;
|
|
if (TDAQueryBuilder(Source).FWhere <> nil) or (FWhere <> nil) then
|
|
Where.Xml:=TDAQueryBuilder(Source).Where.Xml;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAQueryBuilder.Clear;
|
|
begin
|
|
FMainTable.MasterTable := '';
|
|
FMainTable.JoinSourceTables.Clear;
|
|
FSelectCollection.Clear;
|
|
if FWhere <> nil then FWhere.Clear;
|
|
FGroupByCollection.Clear;
|
|
FOrderByCollection.Clear;
|
|
end;
|
|
|
|
constructor TDAQueryBuilder.Create;
|
|
begin
|
|
inherited Create;
|
|
FSelectCollection := TDASelectCollection.Create(TDASelectItem);
|
|
FMainTable := TDAJoinDataTable.Create(nil);
|
|
FGroupByCollection := TDAGroupByCollection.Create(TDAGroupByItem);
|
|
FOrderByCollection := TDAOrderByCollection.Create(TDAOrderByItem);
|
|
FColumnMapping := TDAColumnMappingCollection.Create(Self);
|
|
FWhere := nil;
|
|
FOptions := [];
|
|
Clear;
|
|
end;
|
|
|
|
function TDAQueryBuilder.CreateGroupByClause: string;
|
|
var
|
|
i: integer;
|
|
begin
|
|
Result := '';
|
|
for i := 0 to GroupBy.Count - 1 do begin
|
|
if i <> 0 then Result := Result + ', ';
|
|
with TDAGroupByItem(GroupBy.Items[i]) do
|
|
Result := Result + GenerateFieldName(TableName, FieldName);
|
|
end;
|
|
end;
|
|
|
|
function TDAQueryBuilder.CreateOrderByClause: string;
|
|
var
|
|
i: integer;
|
|
begin
|
|
Result := '';
|
|
for i := 0 to OrderBy.Count - 1 do begin
|
|
if i <> 0 then Result := Result + ', ';
|
|
with TDAOrderByItem(OrderBy.Items[i]) do
|
|
Result := Result + GenerateFieldName(TableName, FieldName);
|
|
end;
|
|
end;
|
|
|
|
function TDAQueryBuilder.CreateSelectClause: string;
|
|
var
|
|
i,j: integer;
|
|
lflds: TDAFieldCollection;
|
|
lquotedtablename: string;
|
|
begin
|
|
Result := '';
|
|
if Select.Count = 0 then begin
|
|
if not (qboGenerateSimpleSelect in FOptions) and Assigned(FConnection) then begin
|
|
FConnection.GetTableFields(MainTable.MasterTable, lflds);
|
|
if Assigned(lflds) then try
|
|
if MainTable.JoinSourceTables.Count =0 then
|
|
lquotedtablename := ''
|
|
else
|
|
lquotedtablename:=QuoteIdentifierIfNeeded(MainTable.MasterTable)+'.';
|
|
For i:= 0 to lflds.Count -1 do
|
|
Result := Result + lquotedtablename+QuoteFieldNameIfNeeded(MainTable.MasterTable, lflds.Fields[i].Name)+', '
|
|
finally
|
|
lFlds.Free;
|
|
end;
|
|
For j:= 0 to MainTable.JoinSourceTables.Count - 1 do
|
|
with TDAJoinSourceTable(MainTable.JoinSourceTables.Items[j]) do begin
|
|
lquotedtablename:=QuoteIdentifierIfNeeded(Name)+'.';
|
|
FConnection.GetTableFields(name, lflds);
|
|
if Assigned(lflds) then try
|
|
For i:= 0 to lflds.Count -1 do
|
|
Result := Result + lquotedtablename+QuoteFieldNameIfNeeded(Name, lflds.Fields[i].Name)+', '
|
|
finally
|
|
lFlds.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
end else begin
|
|
for i := 0 to Select.Count - 1 do begin
|
|
with TDASelectItem(Select.Items[i]) do
|
|
Result := Result + GenerateFieldName(TableName, FieldName)+', ';
|
|
end;
|
|
end;
|
|
if Length(Result) > 2 then SetLength(Result, Length(Result)-2);
|
|
if Result = '' then Result:='*';
|
|
end;
|
|
|
|
function TDAQueryBuilder.CreateWhereClause: string;
|
|
begin
|
|
if FWhere = nil then
|
|
Result := ''
|
|
else
|
|
Result := FWhere.CreateWhereClause;
|
|
end;
|
|
|
|
destructor TDAQueryBuilder.Destroy;
|
|
begin
|
|
FColumnMapping.Free;
|
|
FWhere.Free;
|
|
FOrderByCollection.Free;
|
|
FGroupByCollection.Free;
|
|
FSelectCollection.Free;
|
|
FMainTable.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TDAQueryBuilder.GenerateFieldName(aTablename,
|
|
aFieldName: string; aProcessMapping: Boolean): string;
|
|
begin
|
|
if aProcessMapping then aFieldName:= GetMappingTableField(aFieldName);
|
|
if aTableName <> '' then
|
|
Result := QuoteIdentifierIfNeeded(aTableName) + '.' + QuoteFieldNameIfNeeded(aTableName, aFieldName)
|
|
else
|
|
Result := QuoteFieldNameIfNeeded(aTableName, aFieldName);
|
|
end;
|
|
|
|
function TDAQueryBuilder.GenerateSelectSQL: string;
|
|
const
|
|
c_Indent = ' ';
|
|
c_Lenght = 47;
|
|
|
|
function CompactString(AStr: String): string;
|
|
var
|
|
p,p1: Pchar;
|
|
s: string;
|
|
begin
|
|
Result:='';
|
|
p:=Pchar(AStr);
|
|
repeat
|
|
p1:=p;
|
|
repeat
|
|
p1:=StrPos(p1, ',');
|
|
if p1 <> nil then inc(p1);
|
|
until (p1 = nil) or (p1-p > c_lenght);
|
|
if p1 = nil then begin
|
|
s:=p;
|
|
end else begin
|
|
inc(p1);
|
|
SetString(s,p, p1-p);
|
|
end;
|
|
p:=p1;
|
|
Result:=Result+sLineBreak +c_Indent+ s;
|
|
until p = nil;
|
|
end;
|
|
|
|
var
|
|
lSelect, lTable, lWhere, lGroupBy, lOrderBy: string;
|
|
begin
|
|
Validate;
|
|
lSelect := CompactString(CreateSelectClause);
|
|
lTable := CreateTableClause;
|
|
lWhere := CreateWhereClause;
|
|
lGroupBy := CreateGroupByClause;
|
|
lOrderBy := CreateOrderByClause;
|
|
Result :=
|
|
'SELECT' + lSelect + sLinebreak +
|
|
'FROM' + sLineBreak + c_Indent + lTable;
|
|
if (qboGenerateDynamicWhereStatement in Options) and (lWhere = '') then lWhere := '{WHERE}';
|
|
if lWhere <> '' then Result := Result + sLineBreak + 'WHERE' + sLineBreak + c_Indent + lWhere;
|
|
if lGroupBy <> '' then Result := Result + sLineBreak + 'GROUP BY' + sLineBreak + c_Indent + lGroupBy;
|
|
if lOrderBy <> '' then Result := Result + sLineBreak + 'ORDER BY' + sLineBreak + c_Indent + lOrderBy;
|
|
end;
|
|
|
|
function TDAQueryBuilder.GetMappingTableField(
|
|
const aDataSetField: string): string;
|
|
var
|
|
lColumnMapping: TDAColumnMapping;
|
|
begin
|
|
lColumnMapping := FColumnMapping.FindMappingByDatasetField(aDataSetField);
|
|
if Assigned(lColumnMapping) then
|
|
Result := lColumnMapping.TableField
|
|
else
|
|
Result := aDataSetField;
|
|
end;
|
|
|
|
function TDAQueryBuilder.GetWhereBuilder: TDASQLWhereBuilder;
|
|
begin
|
|
if FWhere = nil then FWhere := CreateWhereBuilder;
|
|
Result:= FWhere;
|
|
end;
|
|
|
|
function TDAQueryBuilder.IdentifierNeedsQuoting(
|
|
const iIdentifier: string): boolean;
|
|
var
|
|
i: integer;
|
|
begin
|
|
if Assigned(Connection) then
|
|
Result := Connection.IdentifierNeedsQuoting(iIdentifier)
|
|
else begin
|
|
Result := False;
|
|
for i := 1 to Length(iIdentifier) do begin
|
|
Result := not (iIdentifier[i] in ['a'..'z', 'A'..'Z', '0'..'9', '_', '.']);
|
|
if Result then Break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TDAQueryBuilder.QuoteFieldNameIfNeeded(const aTableName,
|
|
aFieldName: string): string;
|
|
begin
|
|
if Assigned(Connection) then
|
|
Result := Connection.QuoteFieldNameIfNeeded(aTableName, aFieldName)
|
|
else
|
|
Result := {aTableName + '.' +} QuoteIdentifierIfNeeded(aFieldName);
|
|
end;
|
|
|
|
function TDAQueryBuilder.QuoteIdentifier(
|
|
const iIdentifier: string): string;
|
|
begin
|
|
if Assigned(Connection) then
|
|
Result := Connection.QuoteIdentifier(iIdentifier)
|
|
else
|
|
Result := '''' + iIdentifier + '''';
|
|
end;
|
|
|
|
function TDAQueryBuilder.QuoteIdentifierIfNeeded(
|
|
const iIdentifier: string): string;
|
|
begin
|
|
if Assigned(Connection) then
|
|
Result := Connection.QuoteIdentifierIfNeeded(iIdentifier)
|
|
else if IdentifierNeedsQuoting(iIdentifier) then
|
|
Result := QuoteIdentifier(iIdentifier)
|
|
else
|
|
Result := iIdentifier;
|
|
end;
|
|
|
|
procedure TDAQueryBuilder.SetColumnMapping(
|
|
const Value: TDAColumnMappingCollection);
|
|
begin
|
|
FColumnMapping.AssignColumnMapping(Value);
|
|
end;
|
|
|
|
procedure TDAQueryBuilder.Validate;
|
|
begin
|
|
if FMainTable.MasterTable = '' then raise Exception.Create('Please specify MainTable.MasterTable');
|
|
end;
|
|
|
|
{ TDAWhereBuilder }
|
|
|
|
const
|
|
c_DAWhereBuilderLocalName = 'query';
|
|
c_DAWhereBuilderNamespaceURI = 'http://www.remobjects.com/schemas/dataabstract/queries/5.0';
|
|
c_DAWhereBuilderwhere = 'where';
|
|
procedure TDAWhereBuilder.Clear;
|
|
begin
|
|
FreeAndNil(FExpression);
|
|
FColumnMapping.Clear;
|
|
fParams.Clear;
|
|
end;
|
|
|
|
constructor TDAWhereBuilder.Create;
|
|
begin
|
|
inherited Create;
|
|
FColumnMapping := TDAColumnMappingCollection.Create(nil);
|
|
fParams := TDAParamCollection.Create(nil);
|
|
end;
|
|
|
|
destructor TDAWhereBuilder.Destroy;
|
|
begin
|
|
Clear;
|
|
fParams.Free;
|
|
FColumnMapping.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TDAWhereBuilder.ExpressionToXmlNode(
|
|
const aExpression: TDAWhereExpression): IXMLNode;
|
|
var
|
|
doc: IXMLDocument;
|
|
el: IXMLNode;
|
|
begin
|
|
doc := NewROXmlDocument;
|
|
doc.New(c_DAWhereBuilderLocalName);
|
|
el := doc.DocumentNode;
|
|
el.AddAttribute('xmlns', c_DAWhereBuilderNamespaceURI);
|
|
el.AddAttribute('version', '5.0');
|
|
WriteToXml(el,aExpression);
|
|
result := doc.DocumentNode;
|
|
end;
|
|
|
|
function TDAWhereBuilder.getXml: WideString;
|
|
begin
|
|
Result:= ExpressionToXmlNode(fExpression).Document.XML;
|
|
end;
|
|
|
|
function TDAWhereBuilder.IsEmpty: Boolean;
|
|
begin
|
|
Result:= fExpression = nil;
|
|
end;
|
|
|
|
function TDAWhereBuilder.NewBinaryExpression(aLeft,
|
|
aRight: TDAWhereExpression; anOp: TDABinaryOperator): TDAWhereExpression;
|
|
begin
|
|
Result := TDABinaryExpression.Create(Self, aLeft, aRight, anOp);
|
|
end;
|
|
|
|
function TDAWhereBuilder.NewConstant(const aValue: Variant;
|
|
aType: TDADataType): TDAWhereExpression;
|
|
begin
|
|
Result := TDAConstantExpression.Create(Self, aValue, aType);
|
|
end;
|
|
|
|
function TDAWhereBuilder.NewField(
|
|
const aTableName,aFieldName: string): TDAWhereExpression;
|
|
begin
|
|
Result := TDAFieldExpression.Create(Self, aTableName,aFieldName);
|
|
end;
|
|
|
|
function TDAWhereBuilder.NewList(
|
|
const aValues: array of TDAWhereExpression): TDAWhereExpression;
|
|
begin
|
|
result := TDAListExpression.Create(Self, aValues);
|
|
end;
|
|
|
|
function TDAWhereBuilder.NewMacro(const aName: string;
|
|
const aValues: array of TDAWhereExpression): TDAWhereExpression;
|
|
begin
|
|
Result := TDAMacroExpression.Create(Self, aName, aValues);
|
|
end;
|
|
|
|
function TDAWhereBuilder.NewMacro(const aName: string): TDAWhereExpression;
|
|
begin
|
|
Result := TDAMacroExpression.Create(Self, aName);
|
|
end;
|
|
|
|
function TDAWhereBuilder.NewNull: TDAWhereExpression;
|
|
begin
|
|
Result := TDANullExpression.Create(Self);
|
|
end;
|
|
|
|
function TDAWhereBuilder.NewParameter(
|
|
const aParameterName: string): TDAWhereExpression;
|
|
begin
|
|
Result := TDAParameterExpression.Create(Self, aParameterName);
|
|
end;
|
|
|
|
function TDAWhereBuilder.NewUnaryExpression(
|
|
anExpression: TDAWhereExpression;
|
|
anOp: TDAUnaryOperator): TDAWhereExpression;
|
|
begin
|
|
Result := TDAUnaryExpression.Create(Self, anExpression, anOp);
|
|
end;
|
|
|
|
function TDAWhereBuilder.ReadFromXml(xr: IXmlNode): TDAWhereExpression;
|
|
begin
|
|
xr := SelectNodeLocal(xr, c_DAWhereBuilderwhere);
|
|
if (xr = nil) then raise Exception.Create('"'+c_DAWhereBuilderwhere+'" tag expected');
|
|
if xr.ChildrenCount > 0 then
|
|
Result := TDAWhereExpression.ParseExpression(self, xr.FirstChild)
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TDAWhereBuilder.SetColumnMapping(
|
|
const Value: TDAColumnMappingCollection);
|
|
begin
|
|
FColumnMapping.Assign(Value);
|
|
end;
|
|
|
|
procedure TDAWhereBuilder.SetParams(const Value: TDAParamCollection);
|
|
begin
|
|
fParams.Assign(Value);
|
|
end;
|
|
|
|
procedure TDAWhereBuilder.setXml(const aValue: WideString);
|
|
begin
|
|
Clear;
|
|
fExpression:=XMLToExpression(aValue);
|
|
end;
|
|
|
|
procedure TDAWhereBuilder.WriteToXml(sw: IXmlNode; const aExpression: TDAWhereExpression);
|
|
begin
|
|
sw := sw.Add(c_DAWhereBuilderwhere);
|
|
if aExpression <> nil then
|
|
aExpression.WriteToXml(sw);
|
|
end;
|
|
|
|
function TDAWhereBuilder.XMLToExpression(
|
|
const aXML: widestring): TDAWhereExpression;
|
|
var
|
|
doc: IXMLDocument;
|
|
el: IXMLNode;
|
|
begin
|
|
doc := NewROXmlDocument;
|
|
doc.New();
|
|
doc.XML := aXML;
|
|
el := doc.DocumentNode;
|
|
if (el.LocalName <> c_DAWhereBuilderLocalName) or (el.NamespaceURI <> c_DAWhereBuilderNamespaceURI) then raise Exception.Create('Not a DataAbstract query xml');
|
|
Result:= ReadFromXml(el);
|
|
end;
|
|
|
|
{ TDAWhereExpression }
|
|
|
|
constructor TDAWhereExpression.Create(anOwner: TDAWhereBuilder);
|
|
begin
|
|
inherited Create;
|
|
fOwner := anOwner;
|
|
end;
|
|
|
|
class function TDAWhereExpression.ParseExpression(aOwner: TDAWhereBuilder;
|
|
xr: IXmlNode): TDAWhereExpression;
|
|
begin
|
|
Result := CreateWhereExpression(aOwner, xr.LocalName);
|
|
Result.ReadFromXml(xr);
|
|
end;
|
|
|
|
{ TDAUnionDataTable }
|
|
constructor TDAUnionDataTable.Create(Collection: TCollection);
|
|
begin
|
|
inherited;
|
|
fSourceTables := TDAUnionSourceTableCollection.Create(Self);
|
|
end;
|
|
|
|
destructor TDAUnionDataTable.Destroy;
|
|
begin
|
|
FreeAndNil(fSourceTables);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDAUnionDataTable.SetSourceTables(Value: TDAUnionSourceTableCollection);
|
|
begin
|
|
fSourceTables.Assign(Value);
|
|
end;
|
|
|
|
{ TDAUnionSourceTableCollection }
|
|
function TDAUnionSourceTableCollection.Add: TDAUnionSourceTable;
|
|
begin
|
|
result := inherited Add() as TDAUnionSourceTable;
|
|
end;
|
|
|
|
constructor TDAUnionSourceTableCollection.Create(aOwner : TPersistent);
|
|
begin
|
|
inherited Create(aOwner, TDAUnionSourceTable);
|
|
end;
|
|
|
|
function TDAUnionSourceTableCollection.GetUnionSourceTables(
|
|
Index: integer): TDAUnionSourceTable;
|
|
begin
|
|
result := TDAUnionSourceTable(inherited Items[Index]);
|
|
end;
|
|
|
|
function TDAUnionSourceTableCollection.UnionSourceTableByName(
|
|
const aName: string): TDAUnionSourceTable;
|
|
begin
|
|
result := ItemByName(aName) as TDAUnionSourceTable
|
|
end;
|
|
|
|
{ TDAUnionSourceTable }
|
|
procedure TDAUnionSourceTable.Assign(Source: TPersistent);
|
|
begin
|
|
if Source is TDAUnionSourceTable then begin
|
|
Name := TDAUnionSourceTable(Source).Name;
|
|
IsReadonly := TDAUnionSourceTable(Source).IsReadOnly;
|
|
ColumnMappings.Assign(TDAUnionSourceTable(Source).ColumnMappings);
|
|
end;
|
|
end;
|
|
|
|
constructor TDAUnionSourceTable.Create(Collection: TCollection);
|
|
begin
|
|
inherited;
|
|
fColumnMappings := TDAColumnMappingCollection.Create(Self);
|
|
end;
|
|
|
|
destructor TDAUnionSourceTable.Destroy;
|
|
begin
|
|
FreeAndNil(fColumnMappings);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDAUnionSourceTable.SetColumnMappings(const Value: TDAColumnMappingCollection);
|
|
begin
|
|
fColumnMappings.Assign(Value);
|
|
end;
|
|
|
|
{ TDAUnionDataTableCollection }
|
|
constructor TDAUnionDataTableCollection.Create(aOwner : TComponent);
|
|
begin
|
|
inherited Create(aOwner, TDAUnionDataTable);
|
|
end;
|
|
|
|
function TDAUnionDataTableCollection.GetUnionDataTables(Index: integer): TDAUnionDataTable;
|
|
begin
|
|
result := TDAUnionDataTable(inherited Items[Index]);
|
|
end;
|
|
|
|
procedure TDAUnionDataTableCollection.SetUnionDataTables(Index: integer; const Value: TDAUnionDataTable);
|
|
begin
|
|
UnionDataTables[Index].Assign(Value);
|
|
end;
|
|
|
|
function TDAUnionDataTableCollection.Add: TDAUnionDataTable;
|
|
begin
|
|
result := TDAUnionDataTable(inherited Add);
|
|
end;
|
|
|
|
function TDAUnionDataTableCollection.UnionDataTableByName(const aName: string): TDAUnionDataTable;
|
|
begin
|
|
result := TDAUnionDataTable(inherited ItemByName(aName));
|
|
end;
|
|
|
|
function TDAUnionDataTableCollection.FindUnionDataTableByName(const aName: string): TDAUnionDataTable;
|
|
begin
|
|
result := TDAUnionDataTable(inherited FindItem(aName));
|
|
end;
|
|
|
|
|
|
|
|
{ TDASQLWhereBuilder }
|
|
|
|
constructor TDASQLWhereBuilder.Create(AConnection: IDAConnection);
|
|
begin
|
|
inherited Create;
|
|
FConnection:= AConnection;
|
|
end;
|
|
|
|
constructor TDASQLWhereBuilder.Create(AQueryBuilder: TDAQueryBuilder);
|
|
begin
|
|
inherited Create;
|
|
FQueryBuilder:= AQueryBuilder;
|
|
end;
|
|
|
|
function TDASQLWhereBuilder.CreateWhereClause: string;
|
|
begin
|
|
Result:= ProcessExpression(Expression);
|
|
end;
|
|
|
|
|
|
function TDASQLWhereBuilder.GenerateFieldName(aTablename,
|
|
aFieldName: string): string;
|
|
begin
|
|
aFieldName:= GetMappingTableField(aFieldName);
|
|
if FQueryBuilder <> nil then
|
|
Result := FQueryBuilder.GenerateFieldName(aTablename,aFieldName,False)
|
|
else
|
|
if FConnection <> nil then begin
|
|
if aTableName <> '' then
|
|
Result := FConnection.QuoteIdentifierIfNeeded(aTableName) + '.' + FConnection.QuoteFieldNameIfNeeded(aTableName, aFieldName)
|
|
else
|
|
Result := FConnection.QuoteFieldNameIfNeeded(aTableName, aFieldName);
|
|
end;
|
|
end;
|
|
|
|
function TDASQLWhereBuilder.GenerateParameter(
|
|
const aParameterName: string): string;
|
|
begin
|
|
Result:= ':'+aParameterName;
|
|
end;
|
|
|
|
function TDASQLWhereBuilder.GenerateParamName: String;
|
|
begin
|
|
fId := fId + 1;
|
|
result := Format('P%d', [fId]);
|
|
end;
|
|
|
|
function TDASQLWhereBuilder.GetMappingTableField(
|
|
const aDataSetField: string): string;
|
|
var
|
|
lColumnMapping: TDAColumnMapping;
|
|
begin
|
|
lColumnMapping := FColumnMapping.FindMappingByDatasetField(aDataSetField);
|
|
if Assigned(lColumnMapping) then
|
|
Result := lColumnMapping.TableField
|
|
else
|
|
Result := aDataSetField;
|
|
end;
|
|
|
|
function TDASQLWhereBuilder.ProcessConstantExpression(
|
|
AExpression: TDAWhereExpression): string;
|
|
const
|
|
const_prefix = 'DACONST_';
|
|
begin
|
|
With Params.Add do begin
|
|
ParamType := daptInput;
|
|
Value := TDAConstantExpression(AExpression).Value;
|
|
DataType := TDAConstantExpression(AExpression).aType;
|
|
Name := GenerateParamName();
|
|
Result:= GenerateParameter(Name);
|
|
end;
|
|
end;
|
|
|
|
function TDASQLWhereBuilder.ProcessExpression(
|
|
AExpression: TDAWhereExpression): string;
|
|
begin
|
|
Result := '';
|
|
if AExpression = nil then Exit;
|
|
if AExpression is TDABinaryExpression then Result := ProcessBinaryExpression(TDABinaryExpression(AExpression))
|
|
else if AExpression is TDAUnaryExpression then Result := ProcessUnaryExpression(TDAUnaryExpression(AExpression))
|
|
else if AExpression is TDAConstantExpression then Result := ProcessConstantExpression(TDAConstantExpression(AExpression))
|
|
else if AExpression is TDAListExpression then Result := ProcessListExpression(TDAListExpression(AExpression))
|
|
else if AExpression is TDAParameterExpression then Result := ProcessParameterExpression(TDAParameterExpression(AExpression))
|
|
else if AExpression is TDAFieldExpression then Result := ProcessFieldExpression(TDAFieldExpression(AExpression))
|
|
else if AExpression is TDANullExpression then Result := ProcessNullExpression(TDANullExpression(AExpression))
|
|
else if AExpression is TDAMacroExpression then Result := ProcessMacroExpression(TDAMacroExpression(AExpression))
|
|
else ;
|
|
end;
|
|
|
|
function TDASQLWhereBuilder.ProcessFieldExpression(
|
|
AExpression: TDAWhereExpression): string;
|
|
begin
|
|
with TDAFieldExpression(AExpression) do
|
|
Result:= GenerateFieldName(TableName, FieldName);
|
|
end;
|
|
|
|
function TDASQLWhereBuilder.ProcessListExpression(
|
|
AExpression: TDAWhereExpression): string;
|
|
var
|
|
i: integer;
|
|
begin
|
|
Result := '';
|
|
with TDAListExpression(AExpression) do
|
|
for i := 0 to Count - 1 do begin
|
|
if i > 0 then Result := Result + ', ';
|
|
Result := Result + ProcessExpression(Item[i]);
|
|
end;
|
|
end;
|
|
|
|
function TDASQLWhereBuilder.ProcessMacroExpression(
|
|
AExpression: TDAWhereExpression): string;
|
|
var
|
|
s1: string;
|
|
i: integer;
|
|
begin
|
|
with TDAMacroExpression(AExpression) do begin
|
|
Result := '{' + Name;
|
|
s1 := '}';
|
|
if Count > 0 then begin
|
|
Result := Result + '(';
|
|
for i := 0 to Count - 1 do begin
|
|
if i > 0 then Result := Result + ', ';
|
|
Result := Result + ProcessExpression(Item[i]);
|
|
end;
|
|
Result := Result + ')';
|
|
end;
|
|
end;
|
|
Result := Result + s1;
|
|
end;
|
|
|
|
function TDASQLWhereBuilder.ProcessParameterExpression(
|
|
AExpression: TDAWhereExpression): string;
|
|
begin
|
|
with TDAParameterExpression(AExpression) do
|
|
Result := GenerateParameter(ParameterName);
|
|
end;
|
|
|
|
{$IFDEF DataAbstract_Trial}
|
|
{$INCLUDE DataAbstract_Trial.inc}
|
|
{$ENDIF DataAbstract_Trial}
|
|
|
|
end.
|