unit uDADataTable; {----------------------------------------------------------------------------} { 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, Contnrs, SysUtils, {$IFDEF MSWINDOWS}ActiveX,{$ENDIF} uRODL, uROTypes, uROClasses, uROClientIntf, uRODynamicRequest,uDAExpressionEvaluator, uDAInterfaces, uDAClasses, uDAEngine, uDAScriptingProvider, uDADataStreamer, uDADelta, DataAbstract3_Intf, DataAbstract4_Intf,uDAWhere; const RecIDFieldName = 'RecID'; // Do not change! AllChanges = [ctInsert, ctUpdate, ctDelete]; type //ToDo: remove and replace these three with TRO(Dynamic)Request* TDARemoteRequest = TRODynamicRequest; TDARemoteRequestParam = TRORequestParam; TDARemoteRequestParams = TRORequestParamCollection; { Other types } float = double; datetime = TDateTime; TDADataTable = class; TDatasetClass = class of TDataset; TDADataTableRules = class; TDADataTableNotifyEvent = procedure(DataTable: TDADataTable) of object; TDADataTableFilterEvent = procedure(DataTable: TDADataTable; var Accept: Boolean) of object; TDADataTableErrorEvent = procedure(DataTable: TDADataTable; Error: EDatabaseError; var Action: TDataAction) of object; TDADataTableDynamicMethodEvent = procedure(DataTable: TDADataTable; const aMessage: IROMessage) of object; TDADataTableRemoteRequestEvent = procedure(DataTable: TDADataTable; Request: TDARemoteRequest) of object; TDADataTableDataChangeEvent = procedure(DataTable: TDADataTable; Field: TDAField) of object; TDADataRequestStreamEvent = procedure(DataTable: TDADataTable; Stream: TStream) of object; //TDADelta = class; TDAApplyUpdatesError = procedure(DataTable: TDADataTable; const Delta: IDADelta; var Ignore: boolean) of object; TDAAfterApplyUpdatesEvent = procedure(DataTable: TDADataTable; const Delta: IDADelta) of object; TDABeforeApplyUpdatesEvent = procedure(DataTable: TDADataTable; const Delta: IDADelta) of object; TDADetailOption = (dtCascadeOpenClose, dtCascadeApplyUpdates, dtAutoFetch, dtCascadeDelete, dtCascadeUpdate, dtDisableLogOfCascadeDeletes, dtDisableLogOfCascadeUpdates, dtIncludeInAllInOneFetch); TDADetailOptions = set of TDADetailOption; TDAMasterOption = (moCascadeOpenClose, moCascadeApplyUpdates, moCascadeDelete, moCascadeUpdate, moDisableLogOfCascadeDeletes, moDisableLogOfCascadeUpdates, moAllInOneFetch); TDAMasterOptions = set of TDAMasterOption; TDAStreamingOption = (soIgnoreStreamSchema, soDisableEventsWhileStreaming); TDAStreamingOptions = set of TDAStreamingOption; TDARemoteUpdatesOption = (ruoOnPost); TDARemoteUpdatesOptions = set of TDARemoteUpdatesOption; TDABaseRemoteDataAdapter = class(TComponent) protected function GetDataStreamer: TDADataStreamer; virtual; abstract; { backward compatibility: to provide access to these in the legacy events } function Get_GetSchemaCall: TDARemoteRequest; virtual; function Get_GetDataCall: TDARemoteRequest; virtual; function Get_UpdateDataCall: TDARemoteRequest; virtual; function Get_GetScriptsCall: TDARemoteRequest; virtual; public function ApplyUpdates(aTables: array of TDADataTable; aRefetchAll: boolean = false): boolean; virtual; abstract; procedure Fill(aTables: array of TDADataTable; aSaveCursor: boolean; aIncludeSchema: boolean); overload; virtual; abstract; procedure Fill(aTables: array of TDADataTable; aTableRequestInfoArray: array of TableRequestInfo; aSaveCursor: boolean=false;aIncludeSchema: boolean=false); overload; virtual; abstract; procedure Fill(aTables: array of TDADataTable; aWhereClauses : array of TDAWhereExpression; aSaveCursor: boolean=false; aIncludeSchema: boolean=false); overload; virtual; abstract; procedure FillSchema(aTables: array of TDADataTable; aPreserveLookupFields: boolean = false; areserveClientCalcFields : boolean = false); virtual; abstract; procedure FillScripts(aTables: array of TDADataTable); virtual; abstract; property DataStreamer: TDADataStreamer read GetDataStreamer; end; { IDADataTableDataset } IDADataTableDataset = interface ['{3BADA4F8-BA32-411C-A7CD-DEBD10A4AF06}'] function GetDataTable: TDADataTable; safecall; end; { IDARangeController } IDARangeController = interface ['{5A182854-B824-496F-80C2-6F8064003E13}'] procedure ApplyRange; safecall; procedure CancelRange; safecall; procedure SetRange(const StartValues, EndValues: array of const); safecall; procedure EditRangeEnd; safecall; procedure EditRangeStart; safecall; procedure SetRangeEnd; safecall; procedure SetRangeStart; safecall; end; { IDANativeDatasetStreaming } TDANativeDataFormat = (ndfBinary, ndfXML); IDANativeDatasetStreaming = interface ['{00B37B20-23DA-49A5-BB5D-B96E50C210F4}'] procedure NativeSaveToFile(const aFileName : string; DataFormat : TDANativeDataFormat = ndfBinary); procedure NativeLoadFromFile(const aFileName : string); procedure NativeSaveToStream(aStream : TStream; DataFormat : TDANativeDataFormat = ndfBinary); procedure NativeLoadFromStream(aStream : TStream); end; { TDADataSource } TDADataSource = class(TDABaseDataSource) private fDataTable: TDADataTable; function GetDataset: TDataset; procedure SetDataTable(const Value: TDADataTable); procedure SetDataset(const Value: TDataset); function GetOpening: boolean; function GetActive: boolean; protected procedure Notification(AComponent: TComponent; Operation: TOperation); override; property Dataset: TDataset read GetDataset write SetDataset; // hide base class property public constructor Create(aOwner: TComponent); override; destructor Destroy; override; property Opening: boolean read GetOpening; property Active: boolean read GetActive; published property DataTable: TDADataTable read fDataTable write SetDataTable; end; { TDADataTable } TDASortDirection = (sdAscending, sdDescending); TDAMasterMappingMode = (mmDataRequest, mmParams, mmWhere); TDASortDirectionArray = array of TDASortDirection; TStringArray = array of string; IDADataTableScriptingProvider = interface(IDAScriptingProvider) ['{E16B7359-C733-4F09-96A8-10527CFABB6D}'] procedure RunDataTableScript(aDataTable: TDADataTable; const aScript: string; const aMethod: string; aLanguage:TROSEScriptLanguage); end; TAutoIncArray = array of Int64; {$WARN SYMBOL_DEPRECATED OFF} TDADataTable = class(TScriptableComponent, {$IFDEF MSWINDOWS}ISupportErrorInfo,{$ENDIF} IDADataTable, IDASQLCommand, IDADataset, IDAEditableDataset, IDADeltaOwner, IDADataReader, IDADatasetEx) private fCurrRecId: integer; fMasterLink: TMasterDataLink; fDelta: IDADelta; fWhere: TDAWhere; fRecIDField: TIntegerField; fStreamedActive, fRefreshing, fOpening: boolean; fDataset: TDataset; fFields: TDAFieldCollection; fAfterEdit: TDADataTableNotifyEvent; fAfterInsert: TDADataTableNotifyEvent; fAfterDelete: TDADataTableNotifyEvent; fBeforeScroll: TDADataTableNotifyEvent; fAfterClose: TDADataTableNotifyEvent; fBeforePost: TDADataTableNotifyEvent; fAfterScroll: TDADataTableNotifyEvent; fBeforeCancel: TDADataTableNotifyEvent; fBeforeRefresh: TDADataTableNotifyEvent; fBeforeOpen: TDADataTableNotifyEvent; fAfterRefresh: TDADataTableNotifyEvent; fAfterOpen: TDADataTableNotifyEvent; fBeforeEdit: TDADataTableNotifyEvent; fBeforeClose: TDADataTableNotifyEvent; fBeforeDelete: TDADataTableNotifyEvent; fAfterPost: TDADataTableNotifyEvent; fOnCalcFields: TDADataTableNotifyEvent; fOnNewRecord: TDADataTableNotifyEvent; fAfterCancel: TDADataTableNotifyEvent; fBeforeInsert: TDADataTableNotifyEvent; fOnFilterRecord: TDADataTableFilterEvent; fOnEditError: TDADataTableErrorEvent; fOnDeleteError: TDADataTableErrorEvent; fOnPostError: TDADataTableErrorEvent; fBeforeFieldChange: TDADataTableDataChangeEvent; fAfterFieldChange: TDADataTableDataChangeEvent; fLogChanges: boolean; fRemoteFetchEnabled: boolean; fSortDirections: TDASortDirectionArray; fSortFieldNames: TStringArray; fParams: TDAParamCollection; fFetchedMasters: TStringList; fMasterParamsMappings, fMasterRequestMappings: TStringList; fDynamicWhere: TDAWhereBuilder; fDetailOptions: TDADetailOptions; fMasterOptions: TDAMasterOptions; fLogicalName: string; fClosing: boolean; fFetching: boolean; fStreaming: boolean; fOnAfterSchemaCall: TDADataTableRemoteRequestEvent; fOnAfterDataRequestCall: TDADataTableRemoteRequestEvent; fOnBeforeSchemaCall: TDADataTableRemoteRequestEvent; fOnBeforeDataRequestCall: TDADataTableRemoteRequestEvent; fOnBeforeDataUpdateCall: TDADataTableRemoteRequestEvent; fOnAfterDataUpdateCall: TDADataTableRemoteRequestEvent; //fOnApplyUpdatesError: TDAApplyUpdatesError; fOnReceiveDataStream: TDADataRequestStreamEvent; fStreamingOptions: TDAStreamingOptions; fRemoteUpdateOptions: TDARemoteUpdatesOptions; fLocalSchema: TDASchema; fLocalConnection: string; fBusinessRulesID: string; fBusinessRules: TDADataTableRules; fFieldRules: TObjectList; fAutoIncs : TAutoIncArray; fOnAfterApplyUpdates: TDADataTableNotifyEvent; fOnBeforeApplyUpdates: TDABeforeApplyUpdatesEvent; fMasterMappingMode: TDAMasterMappingMode; fMaxRecords: integer; fOnBeforeMergeDelta: TDADataTableNotifyEvent; fOnAfterMergeDelta: TDADataTableNotifyEvent; fStoreActive: boolean; fScriptCode: TStrings; fOnBeforeScriptCall: TDADataTableRemoteRequestEvent; fOnAfterScriptCall: TDADataTableRemoteRequestEvent; fOpenTick: cardinal; fAfterOpenIDataset: TDAAfterOpenDatasetEvent; fBeforeOpenIDataset: TDABeforeOpenDatasetEvent; fRemoteDataAdapter: TDABaseRemoteDataAdapter; fLocalDataStreamer: TDADataStreamer; fCustomAttributes: TStrings; fExpressionEvaluator: TDAStdExpressionEvaluator; fHasReducedDelta: Boolean; procedure SetLocalDataStreamer(const Value: TDADataStreamer); procedure SetRemoteDataAdapter(const Value: TDABaseRemoteDataAdapter); procedure SetLogChanges(const Value: boolean); function GetDataset: TDataset; safecall; function GetFields: TDAFieldCollection; safecall; procedure SetFields(const Value: TDAFieldCollection); function GetActive: boolean; safecall; procedure SetActive(Value: boolean); safecall; function GetLogChanges: boolean; procedure SetParams(const Value: TDAParamCollection); function GetEditing: boolean; function GetMasterRequestMappings: TStrings; procedure SetMasterRequestMappings(const Value: TStrings); procedure TempSetRowRecIDValue(Sender: TDataset); procedure SetLocalSchema(const Value: TDASchema); procedure LoadFromLocalSchema; procedure SetBusinessRulesID(const Value: string); function GetHasDelta: boolean; function GetHasDeltaRecursive: boolean; function GetRecNo: integer; procedure SetRecNo(const Value: integer); { published property accessors cannot be safecall, so we need wrappers: } function GetFieldsProperty: TDAFieldCollection; function GetActiveProperty: boolean; procedure SetActiveProperty(const Value: boolean); function GetParamsProperty: TDAParamCollection; function GetMasterParamsMappings: TStrings; procedure SetMasterParamsMappings(const Value: TStrings); procedure PackAllInOneFetchInfoArray(aDataTable : TDADataTable; OutArray: TDADatasetRequestInfoArray); procedure OnWhereChange(Sender: TObject); procedure SetScriptCode(const Value: TStrings); function GetDeltaInitialized: boolean; procedure SetCustomAttributes(const Value: TStrings); function Local_ApplyUpdates(RefetchAll: boolean = FALSE): boolean; procedure InternalCancelUpdateChange(Change: TDADeltaChange); procedure ExpessionEvaluatorGetValue(Sender: TDAExpressionEvaluator; const aIdentifier: string; out aValue: Variant); procedure DoCascadeRemoteAllInOneFetch(aStreamer: TDADataStreamer); protected function CreateAutoIncArray: TAutoIncArray; function GetAutoIncs: TAutoIncArray; virtual; procedure SetAutoIncs(const Value: TAutoIncArray); virtual; property AutoIncs: TAutoIncArray read GetAutoIncs write SetAutoIncs; function GetCurrRecId: integer; virtual; procedure SetCurrRecId(const Value: integer); virtual; procedure Loaded; override; // To override function GetDatasetClass: TDatasetClass; virtual; abstract; procedure CreateInternalFields(aDataset: TDataset; someFieldDefinitions: TDAFieldCollection); virtual; procedure DoRefresh(aDataset: TDataset); procedure DoSort(const FieldNames: array of string; const Directions: array of TDASortDirection); virtual; abstract; procedure SetMasterSource(const Value: TDADataSource); virtual; function GetMasterSource: TDADataSource; virtual; abstract; procedure SetDetailsFields(const Value: string); virtual; abstract; procedure SetMasterFields(const Value: string); virtual; function GetDetailFields: string; virtual; abstract; function GetMasterFields: string; virtual; abstract; function GetFilter: string; virtual; abstract; function GetFiltered: boolean; virtual; abstract; procedure SetFilter(const Value: string); virtual; abstract; procedure SetFiltered(const Value: boolean); virtual; abstract; function GetReadOnly: boolean; virtual; procedure SetReadOnly(const Value: boolean); virtual; procedure AttachEventHooks(aDataset: TDataset); virtual; procedure DetachEventHooks(aDataset: TDataset); virtual; // Internal procedure DoBeforeOpenDataset; virtual; procedure DoBeforeCloseDataset; virtual; procedure DoAfterOpenDataset; virtual; procedure DoAfterCloseDataset; virtual; procedure DoOpen(IgnoreAutoFetchSettings: Boolean = False); virtual; // Internal TDataset event handler hooks procedure InternalAfterInsert(Sender: TDataset); dynamic; procedure InternalAfterEdit(Sender: TDataset); dynamic; procedure InternalBeforePost(Sender: TDataset); dynamic; procedure InternalBeforeCancel(Sender: TDataset); dynamic; procedure InternalAfterDelete(Sender: TDataset); dynamic; procedure InternalBeforeScroll(Sender: TDataset); dynamic; procedure InternalAfterScroll(Sender: TDataset); dynamic; procedure InternalBeforeRefresh(Sender: TDataset); dynamic; procedure InternalAfterRefresh(Sender: TDataset); dynamic; procedure InternalOnCalcFields(Sender: TDataset); dynamic; procedure InternalOnNewRecord(Sender: TDataset); dynamic; procedure InternalAfterCancel(Sender: TDataset); dynamic; procedure InternalBeforeInsert(Sender: TDataset); dynamic; procedure InternalBeforeDelete(Sender: TDataset); dynamic; procedure InternalBeforeEdit(Sender: TDataset); dynamic; procedure InternalAfterPost(Sender: TDataset); dynamic; procedure InternalBeforeFieldUpdate(Sender: TDACustomField); procedure InternalAfterFieldUpdate(Sender: TDACustomField); procedure InternalOnFilterRecord(Dataset: TDataset; var Accept: Boolean); dynamic; procedure InternalOnDeleteError(DataSet: TDataSet; Error: EDatabaseError; var Action: TDataAction); dynamic; procedure InternalOnEditError(DataSet: TDataSet; Error: EDatabaseError; var Action: TDataAction); dynamic; procedure InternalOnPostError(DataSet: TDataSet; Error: EDatabaseError; var Action: TDataAction); dynamic; // IDASQLCommand function GetParams: TDAParamCollection; safecall; procedure RefreshParams; safecall; function Execute: integer; safecall; function GetText: string; safecall; procedure SetText(const Value: string); safecall; function GetName: string; safecall; // IDADeltaOwner function GetDelta: IDADelta; safecall; // IDADataReader function IDADataReader.First = DataReaderFirst; function IDADataReader.Next = DataReaderNext; function DataReaderFirst: boolean; safecall; function DataReaderNext: boolean; safecall; function GetFieldNames(Index: integer): string; safecall; function GetFieldIndexes(const aName: string): integer; safecall; function GetAsBoolean(Index: integer): boolean; overload; safecall; function GetAsCurrency(Index: integer): currency; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetAsDateTime(Index: integer): TDateTime; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetAsFloat(Index: integer): double; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetAsInteger(Index: integer): integer; overload; safecall; function GetAsString(Index: integer): string; overload; safecall; function GetAsVariant(Index: integer): variant; overload; safecall; function GetAsBoolean(const FieldName: string): boolean; overload; safecall; function GetAsCurrency(const FieldName: string): currency; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetAsDateTime(const FieldName: string): TDateTime; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetAsFloat(const FieldName: string): double; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} function GetAsInteger(const FieldName: string): integer; overload; safecall; function GetAsString(const FieldName: string): string; overload; safecall; function GetAsVariant(const FieldName: string): variant; overload; safecall; // IDADataset function GetIsEmpty: boolean; safecall; function GetRecordCount: integer; safecall; function GetFieldCount: integer; safecall; function GetBOF: boolean; safecall; function GetEOF: boolean; safecall; function GetSQL: string; safecall; procedure SetSQL(const Value: string); safecall; function SQLContainsDynamicWhere: boolean; safecall; function GetFieldValues(Index: integer): Variant; safecall; function GetNames(Index: integer): string; safecall; function GetWhere: TDAWhere; safecall; deprecated; function GetDynamicWhere: TDAWhereBuilder; safecall; procedure SetDynamicWhere(const Value: TDAWhereBuilder);safecall; function GetPrepared: boolean; safecall; procedure SetPrepared(Value: boolean); safecall; function GetState: TDataSetState; safecall; function GetLogicalName: string; safecall; procedure SetLogicalName(aName : string); safecall; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure OnMasterChange(Sender: TObject); virtual; procedure OnMasterDisable(Sender: TObject); virtual; function GetOnAfterOpen: TDAAfterOpenDatasetEvent; safecall; function GetOnBeforeOpen: TDABeforeOpenDatasetEvent; safecall; procedure SetOnAfterOpen(const Value: TDAAfterOpenDatasetEvent); safecall; procedure SetOnBeforeOpen(const Value: TDABeforeOpenDatasetEvent); 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; function GetOnOpenError: TDAOpenDatasetErrorEvent; safecall; procedure SetOnOpenError(const Value: TDAOpenDatasetErrorEvent); safecall; procedure NotifyFieldsClear; // IInterface function QueryInterface(const IID: TGUID; out Obj): HResult; override; property MasterLink: TMasterDataLink read fMasterLink; {$IFDEF MSWINDOWS} protected function InterfaceSupportsErrorInfo(const iid: TGUID): HResult; stdcall; public function SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult; override; {$ENDIF} public { for Delta } property RecIDField : TIntegerField read fRecIDField write fRecIDField; function GetRowRecIDValue: integer; procedure CallScript(const aEvent: string); procedure InitializeDataTable; procedure DoCascadeOperation(aStreamer: TDADataStreamer; aOption: TDAMasterOption); procedure WriteDeltaToStream(aStreamer: TDADataStreamer); procedure ReadDeltaFromStream(aStreamer: TDADataStreamer; aFailedDeltas:TList);overload; procedure ReadDeltaFromStream(aStreamer: TDADataStreamer); overload; public constructor Create(aOwner: TComponent); override; destructor Destroy; override; procedure EnableConstraints; virtual; safecall; abstract; procedure DisableConstraints; virtual; safecall; abstract; procedure LoadFromRemoteSource(BookmarkPosition: boolean = FALSE); virtual; procedure FetchMastersDetails(aMasterTable : TDADataTable = NIL; aRequestMappings : TStrings = NIL; IgnoreAutoFetchSettings : Boolean = False); dynamic; procedure LoadSchema(PreserveLookupFields : boolean = FALSE; PreserveClientCalcFields : boolean = FALSE); procedure LoadScript(aDatasetName : string = ''); function ApplyUpdates(RefetchAll: boolean = FALSE): boolean; dynamic; procedure CancelUpdates(IncludeDetails : boolean = TRUE); procedure CancelUpdateChange(Change: TDADeltaChange;IncludeDetails : boolean = TRUE); procedure Sort(const FieldNames: array of string; const Directions: array of TDASortDirection); procedure UnSort; procedure ClearFields; procedure ClearRows; procedure CloneSelectedRecord(Source: TDADataTable; DoPost: boolean = TRUE); overload; procedure CloneSelectedRecord(const Source: IDADataset; DoPost: boolean = TRUE); overload; procedure SaveToStream(aStream: TStream); procedure LoadFromStream(aStream: TStream); procedure SaveToFile(const aFileName: string); procedure LoadFromFile(const aFileName: string); procedure MergeDelta; virtual; // Master detail function GetDetailDataTables: TList; function GetDetailTablesforApplyUpdate(aRecursive: boolean = True): TList; procedure GetDetailTablesforAllinOneFetch(aRemote, aLocal:TList; aRecursive: boolean); function GetMasterDataTable : TDADataTable; // Methods procedure Open; safecall; procedure Close; safecall; procedure EnableControls; safecall; procedure DisableControls; safecall; procedure Next; safecall; 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 Refresh; 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; function FieldByName(const aName: string): TDAField; safecall; function FindField(const aName: string): TDAField; safecall; function ParamByName(const aName: string): TDAParam; safecall; function GetBookmark: pointer; safecall; procedure GotoBookmark(Bookmark: TBookmark); safecall; procedure FreeBookmark(Bookmark: TBookmark); safecall; procedure EnableEventHandlers; safecall; procedure DisableEventHandlers; safecall; procedure InternalSetFetching(aFetching: boolean); procedure AddRecord(const FieldNames : array of string; const FieldValues : array of Variant); safecall; function GetCurrentRecIdValue: integer; procedure SetCurrentRecIdValue(Value: integer); // Properties property CurrRecId: integer read GetCurrRecId write SetCurrRecId; property RecIDValue: integer read GetRowRecIDValue; property Delta: IDADelta read GetDelta write fDelta; property RecNo : integer read GetRecNo write SetRecNo; property BOF: boolean read GetBOF; property EOF: boolean read GetEOF; property RecordCount: integer read GetRecordCount; property FieldCount: integer read GetFieldCount; property FieldValues[Index: integer]: Variant read GetFieldValues; property Names[Index: integer]: string read GetNames; property SortFieldNames: TStringArray read fSortFieldNames; property SortDirections: TDASortDirectionArray read fSortDirections; property Opening: boolean read fOpening; property Closing: boolean read fClosing; property Editing: boolean read GetEditing; property Fetching: boolean read fFetching; property State: TDataSetState read GetState; property Dataset: TDataset read GetDataset; property IsEmpty : boolean read GetIsEmpty; property BusinessEventsObj: TDADataTableRules read fBusinessRules; property HasDelta: boolean read GetHasDelta; property HasDeltaRecursive: boolean read GetHasDeltaRecursive; property DeltaInitialized: boolean read GetDeltaInitialized; property Where : TDAWhere read GetWhere; property DynamicWhere: TDAWhereBuilder read GetDynamicWhere write SetDynamicWhere; procedure CheckProperties(ACheckRemoteFetching: Boolean=False); virtual; property HasReducedDelta: boolean read fHasReducedDelta; published property Active: boolean read GetActiveProperty write SetActiveProperty stored fStoreActive default false; property StoreActive: boolean read fStoreActive write fStoreActive default false; property RemoteUpdatesOptions: TDARemoteUpdatesOptions read fRemoteUpdateOptions write fRemoteUpdateOptions; property MaxRecords : integer read fMaxRecords write fMaxRecords default -1; property Fields: TDAFieldCollection read GetFieldsProperty write SetFields; property Params: TDAParamCollection read GetParamsProperty write SetParams; property MasterMappingMode : TDAMasterMappingMode read fMasterMappingMode write fMasterMappingMode default mmParams; property MasterParamsMappings : TStrings read GetMasterParamsMappings write SetMasterParamsMappings; property LogChanges: boolean read GetLogChanges write SetLogChanges default true; property StreamingOptions: TDAStreamingOptions read fStreamingOptions write fStreamingOptions; property RemoteFetchEnabled: boolean read fRemoteFetchEnabled write fRemoteFetchEnabled default true; property ScriptCode : TStrings read fScriptCode write SetScriptCode; property CustomAttributes : TStrings read fCustomAttributes write SetCustomAttributes; property RemoteDataAdapter: TDABaseRemoteDataAdapter read fRemoteDataAdapter write SetRemoteDataAdapter; property BeforeOpen: TDADataTableNotifyEvent read fBeforeOpen write fBeforeOpen; property AfterOpen: TDADataTableNotifyEvent read fAfterOpen write fAfterOpen; property BeforeClose: TDADataTableNotifyEvent read fBeforeClose write fBeforeClose; property AfterClose: TDADataTableNotifyEvent read fAfterClose write fAfterClose; property BeforeInsert: TDADataTableNotifyEvent read fBeforeInsert write fBeforeInsert; property AfterInsert: TDADataTableNotifyEvent read fAfterInsert write fAfterInsert; property BeforeEdit: TDADataTableNotifyEvent read fBeforeEdit write fBeforeEdit; property AfterEdit: TDADataTableNotifyEvent read fAfterEdit write fAfterEdit; property BeforePost: TDADataTableNotifyEvent read fBeforePost write fBeforePost; property AfterPost: TDADataTableNotifyEvent read fAfterPost write fAfterPost; property BeforeCancel: TDADataTableNotifyEvent read fBeforeCancel write fBeforeCancel; property AfterCancel: TDADataTableNotifyEvent read fAfterCancel write fAfterCancel; property BeforeDelete: TDADataTableNotifyEvent read fBeforeDelete write fBeforeDelete; property AfterDelete: TDADataTableNotifyEvent read fAfterDelete write fAfterDelete; property BeforeScroll: TDADataTableNotifyEvent read fBeforeScroll write fBeforeScroll; property AfterScroll: TDADataTableNotifyEvent read fAfterScroll write fAfterScroll; property BeforeRefresh: TDADataTableNotifyEvent read fBeforeRefresh write fBeforeRefresh; property AfterRefresh: TDADataTableNotifyEvent read fAfterRefresh write fAfterRefresh; property OnCalcFields: TDADataTableNotifyEvent read fOnCalcFields write fOnCalcFields; property OnNewRecord: TDADataTableNotifyEvent read fOnNewRecord write fOnNewRecord; property OnFilterRecord: TDADataTableFilterEvent read fOnFilterRecord write fOnFilterRecord; property ReadOnly : boolean read GetReadOnly write SetReadOnly default False; property OnDeleteError: TDADataTableErrorEvent read fOnDeleteError write fOnDeleteError; property OnEditError: TDADataTableErrorEvent read fOnEditError write fOnEditError; property OnPostError: TDADataTableErrorEvent read fOnPostError write fOnPostError; property LocalSchema: TDASchema read fLocalSchema write SetLocalSchema; property LocalDataStreamer: TDADataStreamer read fLocalDataStreamer write SetLocalDataStreamer; property LocalConnection: string read fLocalConnection write fLocalConnection; property MasterSource: TDADataSource read GetMasterSource write SetMasterSource; property MasterFields: string read GetMasterFields write SetMasterFields; property DetailFields: string read GetDetailFields write SetDetailsFields; property MasterRequestMappings: TStrings read GetMasterRequestMappings write SetMasterRequestMappings; property DetailOptions: TDADetailOptions read fDetailOptions write fDetailOptions; property MasterOptions: TDAMasterOptions read fMasterOptions write fMasterOptions; property Filtered: boolean read GetFiltered write SetFiltered default false; property Filter: string read GetFilter write SetFilter; property LogicalName: string read fLogicalName write fLogicalName; //property OnApplyUpdatesError: TDAApplyUpdatesError read fOnApplyUpdatesError write fOnApplyUpdatesError; property OnAfterApplyUpdates : TDADataTableNotifyEvent read fOnAfterApplyUpdates write fOnAfterApplyUpdates; property OnBeforeApplyUpdates : TDABeforeApplyUpdatesEvent read fOnBeforeApplyUpdates write fOnBeforeApplyUpdates; property OnBeforeMergeDelta : TDADataTableNotifyEvent read fOnBeforeMergeDelta write fOnBeforeMergeDelta; property OnAfterMergeDelta : TDADataTableNotifyEvent read fOnAfterMergeDelta write fOnAfterMergeDelta; property OnBeforeDataRequestCall: TDADataTableRemoteRequestEvent read fOnBeforeDataRequestCall write fOnBeforeDataRequestCall; property OnAfterDataRequestCall: TDADataTableRemoteRequestEvent read fOnAfterDataRequestCall write fOnAfterDataRequestCall; property OnBeforeDataUpdateCall: TDADataTableRemoteRequestEvent read fOnBeforeDataUpdateCall write fOnBeforeDataUpdateCall; property OnAfterDataUpdateCall: TDADataTableRemoteRequestEvent read fOnAfterDataUpdateCall write fOnAfterDataUpdateCall; property OnBeforeSchemaCall: TDADataTableRemoteRequestEvent read fOnBeforeSchemaCall write fOnBeforeSchemaCall; property OnAfterSchemaCall: TDADataTableRemoteRequestEvent read fOnAfterSchemaCall write fOnAfterSchemaCall; property OnBeforeScriptCall: TDADataTableRemoteRequestEvent read fOnBeforeScriptCall write fOnBeforeScriptCall; property OnAfterScriptCall: TDADataTableRemoteRequestEvent read fOnAfterScriptCall write fOnAfterScriptCall; property OnReceiveDataStream: TDADataRequestStreamEvent read fOnReceiveDataStream write fOnReceiveDataStream; property OnBeforeFieldChange: TDADataTableDataChangeEvent read fBeforeFieldChange write fBeforeFieldChange; property OnAfterFieldChange: TDADataTableDataChangeEvent read fAfterFieldChange write fAfterFieldChange; property BusinessRulesID: string read fBusinessRulesID write SetBusinessRulesID; end; TDADataTableClass = class of TDADataTable; {$WARN SYMBOL_DEPRECATED ON} { Exceptions } EDABizValidationException = class(EROException); { TDABusinessRules } TDABusinessRules = class(TDAEngineBaseObject) private protected function _AddRef: Integer; override; function _Release: Integer; override; public constructor Create; virtual; destructor Destroy; override; end; IDAStronglyTypedDataTable = interface ['{4D4063AA-DFD0-4B4D-8CC2-FCE3BE1D2F87}'] procedure Open; procedure Close; function GetActive: boolean; procedure SetActive(const Value: boolean); property Active: boolean read GetActive write SetActive; procedure Append; procedure Cancel; procedure Delete; procedure Edit; procedure First; procedure Insert; procedure Last; procedure Next; procedure Post; procedure Prior; function Locate(const aKeyFields: string; const aKeyValues: Variant; aOptions: TLocateOptions = []): Boolean; function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; function GetDataTable : TDADataTable; function GetState : TDatasetState; function GetIsEmpty : boolean; function GetRecNo : integer; procedure SetRecNo(Value : integer); function GetMasterOptions : TDAMasterOptions; procedure SetMasterOptions(Value : TDAMasterOptions); function GetDetailOptions : TDADetailOptions; procedure SetDetailOptions(Value : TDADetailOptions); function IsFieldNull(const FieldIndexOrName : Variant) : boolean; procedure ClearField(const FieldIndexOrName : Variant); function GetBOF: boolean; function GetEOF: boolean; function GetRecordCount: integer; property BOF: boolean read GetBOF; property EOF: boolean read GetEOF; property RecordCount: integer read GetRecordCount; property RecNo : integer read GetRecNo write SetRecNo; property MasterOptions : TDAMasterOptions read GetMasterOptions write SetMasterOptions; property DetailOptions : TDADetailOptions read GetDetailOptions write SetDetailOptions; property IsEmpty : boolean read GetIsEmpty; property State : TDatasetState read GetState; property DataTable : TDADataTable read GetDataTable; end; { TDAFieldRules } TDAFieldRules = class(TDABusinessRules) private fField : TDAField; fDataTable : TDADataTable; protected // Misc procedure Attach(aDataTable: TDADataTable); virtual; procedure Detach(aDataTable: TDADataTable); virtual; // Event handler hooks procedure OnValidate(Sender: TDACustomField); virtual; procedure OnChange(Sender: TDACustomField); virtual; property DataTable : TDADataTable read fDataTable; public constructor Create(aField : TDAField; aDataTable : TDADataTable); reintroduce; virtual; destructor Destroy; override; end; TDAFieldRulesClass = class of TDAFieldRules; { TDADataTableRules } TDADataTableRules = class(TDABusinessRules, IDAStronglyTypedDataTable, IDARangeController) private fDataTable: TDADataTable; fDetails : TStringList; function GetDetails(Index: integer): TDADataTable; function GetDetailsCount: integer; protected // Misc function GetDataTable: TDADataTable; procedure Attach(aDataTable: TDADataTable); virtual; procedure Detach(aDataTable: TDADataTable); virtual; procedure RefreshDetails; function FindDetail(const aLogicalName : string) : TDADataTable; function DetailByName(const aLogicalName : string) : TDADataTable; // Business events procedure BeforeOpen(Sender: TDADataTable); virtual; procedure AfterOpen(Sender: TDADataTable); virtual; procedure BeforeClose(Sender: TDADataTable); virtual; procedure AfterClose(Sender: TDADataTable); virtual; procedure BeforeInsert(Sender: TDADataTable); virtual; procedure AfterInsert(Sender: TDADataTable); virtual; procedure BeforeEdit(Sender: TDADataTable); virtual; procedure AfterEdit(Sender: TDADataTable); virtual; procedure BeforePost(Sender: TDADataTable); virtual; procedure AfterPost(Sender: TDADataTable); virtual; procedure BeforeCancel(Sender: TDADataTable); virtual; procedure AfterCancel(Sender: TDADataTable); virtual; procedure BeforeDelete(Sender: TDADataTable); virtual; procedure AfterDelete(Sender: TDADataTable); virtual; procedure BeforeScroll(Sender: TDADataTable); virtual; procedure AfterScroll(Sender: TDADataTable); virtual; procedure BeforeRefresh(Sender: TDADataTable); virtual; procedure AfterRefresh(Sender: TDADataTable); virtual; procedure OnCalcFields(Sender: TDADataTable); virtual; procedure OnNewRecord(Sender: TDADataTable); virtual; procedure OnDeleteError(DataTable: TDADataTable; Error: EDatabaseError; var Action: TDataAction); virtual; procedure OnEditError(DataTable: TDADataTable; Error: EDatabaseError; var Action: TDataAction); virtual; procedure OnPostError(DataTable: TDADataTable; Error: EDatabaseError; var Action: TDataAction); virtual; procedure OnFilterRecord(DataTable: TDADataTable; var Accept : boolean); virtual; procedure OnAfterSchemaCall(DataTable: TDADataTable; Request: TDARemoteRequest); virtual; procedure OnAfterDataRequestCall(DataTable: TDADataTable; Request: TDARemoteRequest); virtual; procedure OnBeforeSchemaCall(DataTable: TDADataTable; Request: TDARemoteRequest); virtual; procedure OnBeforeDataRequestCall(DataTable: TDADataTable; Request: TDARemoteRequest); virtual; procedure OnBeforeDataUpdateCall(DataTable: TDADataTable; Request: TDARemoteRequest); virtual; procedure OnAfterDataUpdateCall(DataTable: TDADataTable; Request: TDARemoteRequest); virtual; procedure OnBeforeScriptCall(DataTable: TDADataTable; Request: TDARemoteRequest); virtual; procedure OnAfterScriptCall(DataTable: TDADataTable; Request: TDARemoteRequest); virtual; procedure OnAfterApplyUpdates(DataTable: TDADataTable); virtual; procedure OnBeforeMergeDelta(DataTable: TDADataTable); virtual; procedure OnAfterMergeDelta(DataTable: TDADataTable); virtual; procedure OnReceiveDataStream(DataTable: TDADataTable; Stream: TStream); virtual; procedure OnBeforeApplyUpdates(DataTable: TDADataTable; const Delta: IDADelta); virtual; procedure Open; virtual; procedure Close; virtual; function GetActive: boolean; procedure SetActive(const Value: boolean); property Active: boolean read GetActive write SetActive; procedure Append; virtual; procedure Cancel; virtual; procedure Delete; virtual; procedure Edit; virtual; procedure First; virtual; procedure Insert; virtual; procedure Last; virtual; procedure Next; virtual; procedure Post; virtual; procedure Prior; virtual; function GetBOF: Boolean; virtual; function GetEOF: Boolean; virtual; function GetRecordCount: Integer; virtual; function Locate(const aKeyFields: String; const aKeyValues: Variant; aOptions: TLocateOptions = []): Boolean; virtual; function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; function GetMasterOptions : TDAMasterOptions; procedure SetMasterOptions(Value : TDAMasterOptions); function GetDetailOptions : TDADetailOptions; procedure SetDetailOptions(Value : TDADetailOptions); function GetRecNo : integer; procedure SetRecNo(Value : integer); function GetIsEmpty: boolean; function GetState: TDatasetState; function IsFieldNull(const FieldIndexOrName : Variant) : boolean; procedure ClearField(const FieldIndexOrName : Variant); property DataTable: TDADataTable read GetDataTable; property Details[Index : integer] : TDADataTable read GetDetails; property DetailCount : integer read GetDetailsCount; property State : TDatasetState read GetState; property IsEmpty : boolean read GetIsEmpty; { IDARangeController } procedure ApplyRange; safecall; procedure CancelRange; safecall; procedure SetRange(const StartValues, EndValues: array of const); safecall; procedure EditRangeEnd; safecall; procedure EditRangeStart; safecall; procedure SetRangeEnd; safecall; procedure SetRangeStart; safecall; public constructor Create(aDataTable: TDADataTable); reintroduce; virtual; destructor Destroy; override; end; TDADataTableRulesClass = class of TDADataTableRules; { TDADataTableList } TDADataTableList = class(TList) private function GetItems(Index: integer): TDADataTable; function GetPendingChangeCount: integer; protected public constructor Create(aOwnerComponent : TComponent); function ScanAndAdd(aOwnerComponent : TComponent) : integer; function Add(aDataTable : TDADataTable) : integer; procedure Remove(aDataTable : TDADataTable); property Items[Index : integer] : TDADataTable read GetItems; default; property PendingChangeCount : integer read GetPendingChangeCount; end; // Registration routines procedure RegisterDataTableRules(const anID: string; const aDataTableRulesClass: TDADataTableRulesClass); function FindDataTableRules(const anID: string; out aDataTableRulesClass: TDADataTableRulesClass): boolean; procedure RegisterFieldRules(const anID: string; const aFieldRulesClass: TDAFieldRulesClass); function FindFieldRules(const anID: string; out aFieldRulesClass: TDAFieldRulesClass): boolean; // Helper functions function NewDelta(aDataTable: TDADataTable): IDADelta; overload; function DatatableFromStream(aStream : TStream; aDataTableClass : TDADataTableClass; anAdapter : TDADataAdapter; const aDatasetName : string = '') : TDADataTable; implementation uses {$IFDEF DESIGNTIME} {$IFDEF MSWINDOWS} Dialogs, {$ENDIF MSWINDOWS} {$IFDEF LINUX} QDialogs, {$ENDIF LINUX} {$ENDIF DESIGNTIME} TypInfo, Variants, uROClient, uROSessions, uROXMLIntf, uDARegExpr, uDABusinessProcessor; var _bizfields, _bizdatatables: TStringList; type TDataSetHack = class(TDataSet); function NewDelta(aDataTable: TDADataTable): IDADelta; begin result := TDADelta.Create(aDataTable); end; procedure RegisterDataTableRules(const anID: string; const aDataTableRulesClass: TDADataTableRulesClass); var idx: integer; begin idx := _bizdatatables.IndexOf(anID); if (idx >= 0) then _bizdatatables.Objects[idx] := TObject(aDataTableRulesClass) else _bizdatatables.AddObject(anID, TObject(aDataTableRulesClass)); end; function FindDataTableRules(const anID: string; out aDataTableRulesClass: TDADataTableRulesClass): boolean; var idx: integer; begin result := FALSE; idx := _bizdatatables.IndexOf(anID); if (idx >= 0) then begin aDataTableRulesClass := TDADataTableRulesClass(_bizdatatables.Objects[idx]); result := TRUE; end else aDataTableRulesClass := nil; end; procedure RegisterFieldRules(const anID: string; const aFieldRulesClass: TDAFieldRulesClass); var idx: integer; begin idx := _bizfields.IndexOf(anID); if (idx >= 0) then _bizfields.Objects[idx] := TObject(aFieldRulesClass) else _bizfields.AddObject(anID, TObject(aFieldRulesClass)); end; function FindFieldRules(const anID: string; out aFieldRulesClass: TDAFieldRulesClass): boolean; var idx: integer; begin result := FALSE; idx := _bizfields.IndexOf(anID); if (idx >= 0) then begin aFieldRulesClass := TDAFieldRulesClass(_bizfields.Objects[idx]); result := TRUE; end else aFieldRulesClass := nil; end; function DatatableFromStream(aStream : TStream; aDataTableClass : TDADataTableClass; anAdapter : TDADataAdapter; const aDatasetName : string = '') : TDADataTable; begin result := aDataTableClass.Create(NIL); result.RemoteFetchEnabled := FALSE; anAdapter.ReadDataset(aStream, result, TRUE, aDatasetName); result.First; end; { TDADataTable } constructor TDADataTable.Create(aOwner: TComponent); begin inherited; fHasReducedDelta := False; fScriptCode := TStringList.Create; fCustomAttributes := TStringList.Create; fMaxRecords := -1; fMasterMappingMode := mmParams; fMasterParamsMappings := TStringList.Create; fFieldRules := TObjectList.Create; fRemoteUpdateOptions := []; fStreamingOptions := [soDisableEventsWhileStreaming]; fDetailOptions := [dtCascadeOpenClose, dtCascadeApplyUpdates, dtAutoFetch, dtCascadeDelete, dtCascadeUpdate, dtDisableLogOfCascadeDeletes, dtDisableLogOfCascadeUpdates, dtIncludeInAllInOneFetch // Done to avoid breaking existing apps ]; fMasterOptions := [moCascadeOpenClose, moCascadeApplyUpdates, moCascadeDelete, moCascadeUpdate, moDisableLogOfCascadeDeletes, moDisableLogOfCascadeUpdates]; fFetchedMasters := TStringList.Create; fFetchedMasters.Duplicates := dupError; fFetchedMasters.Sorted := TRUE; fMasterRequestMappings := TStringList.Create; fRemoteFetchEnabled := TRUE; fStreaming := False; SetLength(fSortDirections, 0); SetLength(fSortFieldNames, 0); fFields := TDAFieldCollection.Create(Self); fFields.OnFieldBeforeUpdate := InternalBeforeFieldUpdate; fFields.OnFieldAfterUpdate := InternalAfterFieldUpdate; fParams := TDAParamCollection.Create(Self); fWhere := TDAWhere.Create(fFields, TRUE); fWhere.OnChange := OnWhereChange; fDataset := GetDatasetClass.Create(Self); fDataset.Name := 'Dataset'; fMasterLink := TMasterDataLink.Create(fDataset); fMasterLink.OnMasterChange := OnMasterChange; fMasterLink.OnMasterDisable := OnMasterDisable; fExpressionEvaluator := TDAStdExpressionEvaluator.Create; fExpressionEvaluator.OnGetValue := ExpessionEvaluatorGetValue; fDynamicWhere := TDAWhereBuilder.Create; fLogChanges := TRUE; end; destructor TDADataTable.Destroy; begin fDynamicWhere.Free; fExpressionEvaluator.Free; fFields.Free; fWhere.Free; fMasterLink.Free; fMasterRequestMappings.Free; fMasterParamsMappings.Free; fFetchedMasters.Free; if (fBusinessRules <> nil) then begin fBusinessRules.Detach(Self); fBusinessRules.Free; end; fFieldRules.Free; fParams.Free; fDelta := NIL; fScriptCode.Free; fCustomAttributes.Free; inherited; end; procedure TDADataTable.OnWhereChange(Sender : TObject); //var par : TDARemoteRequestParam; begin //TODO: par := DataRequestCall.FindParam(par_UserFilter); //if (par<>NIL) then par.AsString := fWhere.Clause; end; procedure TDADataTable.AttachEventHooks(aDataset: TDataset); var i : integer; lFieldRulesClass : TDAFieldRulesClass; lFieldRules : TDAFieldRules; lField : TDAField; begin if (csDesigning in ComponentState) then Exit; aDataset.BeforeInsert := InternalBeforeInsert; aDataset.AfterInsert := InternalAfterInsert; aDataset.BeforeEdit := InternalBeforeEdit; aDataset.AfterEdit := InternalAfterEdit; aDataset.BeforePost := InternalBeforePost; aDataset.AfterPost := InternalAfterPost; aDataset.BeforeCancel := InternalBeforeCancel; aDataset.AfterCancel := InternalAfterCancel; aDataset.BeforeDelete := InternalBeforeDelete; aDataset.AfterDelete := InternalAfterDelete; aDataset.BeforeScroll := InternalBeforeScroll; aDataset.AfterScroll := InternalAfterScroll; aDataset.BeforeRefresh := InternalBeforeRefresh; aDataset.AfterRefresh := InternalAfterRefresh; aDataset.OnCalcFields := InternalOnCalcFields; aDataset.OnNewRecord := InternalOnNewRecord; aDataset.OnFilterRecord := InternalOnFilterRecord; aDataset.OnDeleteError := InternalOnDeleteError; aDataset.OnEditError := InternalOnEditError; aDataset.OnPostError := InternalOnPostError; for i := 0 to (fFields.Count-1) do begin lField := Fields[i]; if (lField.BusinessClassID='') then Continue; Check(not FindFieldRules(lField.BusinessClassID, lFieldRulesClass), 'Invalid BusinessClassID "%s"', [lField.BusinessClassID]); lFieldRules := lFieldRulesClass.Create(lField, Self); fFieldRules.Add(lFieldRules); end; fFields.FieldEventsDisabled := FALSE; end; procedure TDADataTable.DetachEventHooks(aDataset: TDataset); begin if (csDesigning in ComponentState) then Exit; aDataset.BeforeInsert := nil; aDataset.AfterInsert := nil; aDataset.BeforeEdit := nil; aDataset.AfterEdit := nil; aDataset.BeforePost := TempSetRowRecIDValue; // We still need to autoinc the RecID!!! aDataset.AfterPost := nil; aDataset.BeforeCancel := nil; aDataset.AfterCancel := nil; aDataset.BeforeDelete := nil; aDataset.AfterDelete := nil; aDataset.BeforeScroll := nil; aDataset.AfterScroll := nil; aDataset.BeforeRefresh := nil; aDataset.AfterRefresh := nil; if not Filtered then aDataset.OnCalcFields := nil; aDataset.OnNewRecord := nil; aDataset.OnFilterRecord := nil; aDataset.OnDeleteError := nil; aDataset.OnEditError := nil; aDataset.OnPostError := nil; fFields.FieldEventsDisabled := TRUE; fFieldRules.Clear; // Destroyes them end; procedure TDADataTable.InternalAfterDelete(Sender: TDataset); begin CallScript('AfterDelete'); if Assigned(AfterDelete) then AfterDelete(Self); if Assigned(fBusinessRules) then fBusinessRules.AfterDelete(Self); if (ruoOnPost in RemoteUpdatesOptions) then ApplyUpdates(); end; procedure TDADataTable.InternalAfterEdit(Sender: TDataset); begin CallScript('AfterEdit'); if Assigned(AfterEdit) then AfterEdit(Self); if Assigned(fBusinessRules) then fBusinessRules.AfterEdit(Self); end; procedure TDADataTable.InternalAfterInsert(Sender: TDataset); var i: integer; begin CallScript('AfterInsert'); if (State <> dsEdit) then begin // Somehow it's gets in dsBrowse here... // (autoinc) for i := 0 to (fFields.Count-1) do if (fFields[i].DataType=datLargeAutoInc) then begin fFields[i].AsLargeInt := AutoIncs[i]; AutoIncs[i] := AutoIncs[i]-1; end else if (fFields[i].DataType=datAutoInc) then begin fFields[i].AsInteger := AutoIncs[i]; AutoIncs[i] := AutoIncs[i]-1; end; end; if Assigned(AfterInsert) then AfterInsert(Self); if Assigned(fBusinessRules) then fBusinessRules.AfterInsert(Self); end; procedure TDADataTable.InternalAfterRefresh(Sender: TDataset); begin CallScript('AfterRefresh'); if Assigned(AfterRefresh) then AfterRefresh(Self); if Assigned(fBusinessRules) then fBusinessRules.AfterRefresh(Self); end; procedure TDADataTable.InternalAfterScroll(Sender: TDataset); begin if fStreaming and (soDisableEventsWhileStreaming in fStreamingOptions) then Exit; CallScript('AfterScroll'); if Assigned(AfterScroll) then AfterScroll(Self); if Assigned(fBusinessRules) then fBusinessRules.AfterScroll(Self); end; procedure TDADataTable.InternalBeforeCancel(Sender: TDataset); begin CallScript('BeforeCancel'); if Assigned(BeforeCancel) then BeforeCancel(Self); if Assigned(fBusinessRules) then fBusinessRules.BeforeCancel(Self); end; procedure TDADataTable.InternalBeforeRefresh(Sender: TDataset); begin CallScript('BeforeRefresh'); if Assigned(BeforeRefresh) then BeforeRefresh(Self); if Assigned(fBusinessRules) then fBusinessRules.BeforeRefresh(Self); DoRefresh(fDataset); end; procedure TDADataTable.InternalBeforeScroll(Sender: TDataset); begin if fStreaming and (soDisableEventsWhileStreaming in fStreamingOptions) then Exit; CallScript('BeforeScroll'); if Assigned(BeforeScroll) then BeforeScroll(Self); if Assigned(fBusinessRules) then fBusinessRules.BeforeScroll(Self); end; procedure TDADataTable.InternalOnCalcFields(Sender: TDataset); var i: integer; begin CallScript('OnCalcFields'); if Assigned(OnCalcFields) then OnCalcFields(Self); if Assigned(fBusinessRules) then fBusinessRules.OnCalcFields(Self); For i:= 0 to fFields.Count-1 do With fFields[i] do if Calculated and (Expression <> '') then Value:= fExpressionEvaluator.Evaluate(Expression); end; procedure TDADataTable.InternalOnDeleteError(DataSet: TDataSet; Error: EDatabaseError; var Action: TDataAction); begin if Assigned(OnDeleteError) then OnDeleteError(Self, Error, Action); if Assigned(fBusinessRules) then fBusinessRules.OnDeleteError(Self, Error, Action); end; procedure TDADataTable.InternalOnEditError(DataSet: TDataSet; Error: EDatabaseError; var Action: TDataAction); begin if Assigned(OnEditError) then OnEditError(Self, Error, Action); if Assigned(fBusinessRules) then fBusinessRules.OnEditError(Self, Error, Action); end; procedure TDADataTable.InternalOnFilterRecord(Dataset: TDataset; var Accept: Boolean); begin if Assigned(OnFilterRecord) then OnFilterRecord(Self, Accept); if Assigned(fBusinessRules) then fBusinessRules.OnFilterRecord(Self, Accept); end; procedure TDADataTable.InternalOnPostError(DataSet: TDataSet; Error: EDatabaseError; var Action: TDataAction); begin fDelta.RestoreLastChange; // ALEF: added as follow up to the Post errors (Jeff B.) if Assigned(OnPostError) then OnPostError(Self, Error, Action); if Assigned(fBusinessRules) then fBusinessRules.OnPostError(Self, Error, Action); end; procedure TDADataTable.SetLogChanges(const Value: boolean); begin fLogChanges := Value; end; function TDADataTable.GetDataset: TDataset; begin result := fDataset // inherited Dataset; end; function TDADataTable.GetFields: TDAFieldCollection; begin result := fFields; end; procedure TDADataTable.SetFields(const Value: TDAFieldCollection); begin if Active then Close; fFields.Assign(Value); end; function TDADataTable.GetActive: boolean; begin result := fDataset.Active; end; procedure TDADataTable.SetActive(Value: boolean); begin if (csLoading in ComponentState) then fStreamedActive := Value else begin if (Value <> Active) then begin if Value then Open else Close end; end; end; procedure TDADataTable.InternalOnNewRecord(Sender: TDataset); var i: integer; begin fFields.FieldEventsDisabled := TRUE; try try for i := 0 to (fFields.Count - 1) do if (fFields[i].DefaultValue <> '') then fFields[i].Value := fFields[i].DefaultValue; fFields.FieldEventsDisabled := FALSE; CallScript('OnNewRecord'); if Assigned(OnNewRecord) then OnNewRecord(Self); if Assigned(fBusinessRules) then fBusinessRules.OnNewRecord(Self); except fDelta.CancelChange; // OnNewRecord's exception put the dataset in read mode so we must cancel the change raise; end; finally fFields.FieldEventsDisabled := FALSE; // Just in case... end; end; procedure TDADataTable.DoCascadeOperation(aStreamer: TDADataStreamer; aOption: TDAMasterOption); var i: integer; details: TList; dt: TDADataTable; flag: boolean; lRemoteList,lLocalList: TList; begin if aOption = moAllInOneFetch then begin DoCascadeRemoteAllInOneFetch(aStreamer); exit; end; lRemoteList:= TList.Create; lLocalList:= TList.Create; GetDetailTablesforAllinOneFetch(lRemoteList,lLocalList, False); details := GetDetailDataTables; try for i := 0 to (details.Count - 1) do begin dt := TDADataTable(details[i]); flag := dt.LogChanges; case aOption of moCascadeDelete: begin if (dtDisableLogOfCascadeDeletes in dt.DetailOptions) then dt.LogChanges := FALSE; dt.ClearRows; end; moCascadeOpenClose: begin if (dtCascadeOpenClose in dt.DetailOptions) then begin if Opening then begin if (lLocalList.IndexOf(dt)=-1)and (lRemoteList.IndexOf(dt)=-1) then begin dt.Close; dt.DoOpen; end; end else if Closing then dt.Close; end; end; moCascadeUpdate: begin end; moAllInOneFetch: begin { if (dtIncludeInAllInOneFetch in dt.DetailOptions) then try dt.LogChanges := FALSE; if Opening and not (soIgnoreStreamSchema in fStreamingOptions) then begin aStreamer.ReadDataset(dt.LogicalName, dt, TRUE, FALSE); dt.InitializeDataTable; end; aStreamer.ReadDataset(dt.LogicalName, dt); dt.DoCascadeOperation(aStreamer, moAllInOneFetch); finally dt.LogChanges := flag; end; } end; end; dt.LogChanges := flag; end; finally details.Free; lRemoteList.Free; lLocalList.Free; end; end; procedure TDADataTable.DoCascadeRemoteAllInOneFetch(aStreamer: TDADataStreamer); var lFetchedMasters: TStringList; procedure ProcessDetailTable(aTable: TDADataTable); begin with aTable do begin fFetchedMasters.Sorted:=False; fFetchedMasters.AddStrings(lFetchedMasters); fFetchedMasters.Sorted:=True; DoCascadeRemoteAllInOneFetch(aStreamer); end; end; var lLocalList, lRemoteList: TList; ltbl: TDADataTable; i: integer; lflag: boolean; begin if moAllInOneFetch in fMasterOptions then begin lRemoteList:= TList.Create; lLocalList:= TList.Create; try GetDetailTablesforAllinOneFetch(lRemoteList,lLocalList, False); if (lRemoteList.Count > 0) or (lLocalList.Count > 0) then begin lFetchedMasters:= TStringList.Create; try First; while not EOF do begin lFetchedMasters.Add(IntToStr(GetRowRecIDValue)); Next; end; lFetchedMasters.Sort; // these tables are read in RDA for i := 0 to lRemoteList.Count - 1 do begin ProcessDetailTable(TDADataTable(lRemoteList[i])); end; // these tables we should read manually from streamer for i := 0 to lLocalList.Count - 1 do begin ltbl:= TDADataTable(lLocalList[i]); if aStreamer.FindDatasetIndex(ltbl.LogicalName) = -1 then Continue; // may be to better raise an exception! lflag := ltbl.LogChanges; try ltbl.LogChanges := False; if Opening and not (soIgnoreStreamSchema in fStreamingOptions) then begin aStreamer.ReadDataset(ltbl.LogicalName, ltbl, TRUE, FALSE); ltbl.InitializeDataTable; end; aStreamer.ReadDataset(ltbl.LogicalName, ltbl); finally ltbl.LogChanges := lflag; end; ProcessDetailTable(ltbl); end; finally lFetchedMasters.Free; end; end; finally lRemoteList.Free; lLocalList.Free; end; end; end; procedure TDADataTable.TempSetRowRecIDValue(Sender: TDataset); begin if (State <> dsEdit) then begin // Somehow it's gets in dsBrowse here... fRecIDField.AsInteger := CurrRecId; CurrRecId := CurrRecId + 1; end; end; procedure TDADataTable.CreateInternalFields(aDataset: TDataset; someFieldDefinitions: TDAFieldCollection); var i, cnt: integer; fld: TFieldDef; fldcls: TFieldClass; realfld: TField; begin // Creates the RecID field fld := aDataset.FieldDefs.AddFieldDef; fld.DataType := ftInteger; fld.Name := RecIDFieldName; // Creates the autoinc map (autoinc) AutoIncs := CreateAutoIncArray; // Adds the data fields (non calculated) to the FieldDefs for i := 0 to (Fields.Count - 1) do begin if Fields[i].Calculated or Fields[i].Lookup then Continue; // Added as fields later fld := aDataset.FieldDefs.AddFieldDef; // (autoinc) if (Fields[i].DataType=datLargeAutoInc) then fld.DataType := ftLargeint else if (Fields[i].DataType=datAutoInc) then fld.DataType := ftInteger else fld.DataType := DATypeToVCLType(Fields[i].DataType); fld.Name := Fields[i].Name; {if not (fld.DataType in [ftFloat, ftCurrency, ftBlob, ftInteger]) then fld.Size := Fields[i].Size;} if (fld.DataType = ftString) or (fld.DataType = ftWideString) then fld.Size := Fields[i].Size; if (fld.DataType = ftGuid) then fld.Size := 38; if (fld.DataType = ftFMTBcd) then begin fld.Size:=Fields[i].DecimalScale; fld.Precision:=Fields[i].DecimalPrecision; end; fld.Required := Fields[i].Required; end; // Creates the data fields for i := 0 to (aDataset.FieldDefs.Count - 1) do begin realfld := aDataset.FieldDefs[i].CreateField(aDataset); realfld.DataSet := aDataset; // NEW end; // Creates the calculated fields for i := 0 to (Fields.Count - 1) do begin if not Fields[i].Calculated then Continue; fldcls := DefaultFieldClasses[DATypeToVCLType(Fields[i].DataType)]; if fldcls = nil then fldcls := TStringField; realfld := fldcls.Create(Self); realfld.Name := aDataset.Name + Fields[i].Name; realfld.FieldName := Fields[i].Name; realfld.DataSet := aDataset; if (Fields[i].DataType = datString) or (Fields[i].DataType = datWideString) then realfld.Size := Fields[i].Size; realfld.Required := Fields[i].Required; if Fields[i].Calculated then realfld.FieldKind := fkCalculated; realfld.DataSet := aDataset; end; // Creates the lookup fields for i := 0 to (Fields.Count - 1) do begin if not Fields[i].Lookup then Continue; fldcls := DefaultFieldClasses[DATypeToVCLType(Fields[i].DataType)]; if not Assigned(fldcls) then RaiseError('No or invalid DataType specified for lookup field %s.%s',[self.Name, Fields[i].Name]); realfld := fldcls.Create(Self); realfld.Name := aDataset.Name + Fields[i].Name; realfld.FieldName := Fields[i].Name; realfld.DataSet := aDataset; // NEW // Sets lookup properties with Fields[i] do begin {$IFDEF FPC} realfld.FieldKind:=fkLookup; {$ELSE} realfld.Lookup := TRUE; {$ENDIF} if (LookupSource<>NIL) then with TDADataSource(LookupSource) do if Assigned(DataTable) then realfld.LookupDataSet := DataTable.Dataset; realfld.LookupKeyFields := LookupKeyFields; realfld.LookupCache := LookupCache; realfld.LookupResultField := LookupResultField; realfld.KeyFields := KeyFields; end; if (Fields[i].DataType = datString) or (Fields[i].DataType = datWideString) then realfld.Size := Fields[i].Size; //realfld.DataSet := aDataset; end; // Adjusts field positions (less intrusive than changing the code above) cnt := Fields.Count-1; for i := 0 to cnt do aDataSet.FieldByName(Fields[i].Name).Index := i+1; end; procedure TDADataTable.Loaded; begin inherited; if Assigned(fBusinessRules) then fBusinessRules.Attach(Self); Active := fStreamedActive; AttachEventHooks(fDataset); end; procedure TDADataTable.DoRefresh(aDataset: TDataset); begin if fRefreshing then Exit; fRefreshing := TRUE; try Close; Open; finally fRefreshing := FALSE; end; end; procedure TDADataTable.InternalBeforeInsert(Sender: TDataset); begin CallScript('BeforeInsert'); if Assigned(BeforeInsert) then BeforeInsert(Self); if Assigned(fBusinessRules) then fBusinessRules.BeforeInsert(Self); if not LogChanges or (csDesigning in ComponentState) then Exit; fDelta.StartChange(ctInsert); end; procedure TDADataTable.InternalBeforeDelete(Sender: TDataset); begin CallScript('BeforeDelete'); if Assigned(BeforeDelete) then BeforeDelete(Self); if Assigned(fBusinessRules) then fBusinessRules.BeforeDelete(Self); if not LogChanges or (csDesigning in ComponentState) then Exit; // Deletes the records from the detail tables if (moCascadeDelete in MasterOptions) then DoCascadeOperation(nil, moCascadeDelete); // Logs the delete fDelta.StartChange(ctDelete); fDelta.EndChange; end; procedure TDADataTable.InternalBeforeEdit(Sender: TDataset); begin CallScript('BeforeEdit'); if Assigned(BeforeEdit) then BeforeEdit(Self); if Assigned(fBusinessRules) then fBusinessRules.BeforeEdit(Self); if not LogChanges or (csDesigning in ComponentState) then Exit; fDelta.StartChange(ctUpdate); end; procedure TDADataTable.InternalBeforePost(Sender: TDataset); var details : TList; key : string; i : integer; begin CallScript('BeforePost'); if Assigned(BeforePost) then BeforePost(Self); if Assigned(fBusinessRules) then fBusinessRules.BeforePost(Self); for i := 0 to (fFields.Count - 1) do if (fFields[i].RegExpression <> '') and not fFields[i].IsNull then begin if not ExecRegExpr(fFields[i].RegExpression, fFields[i].AsString) then RaiseError('Invalid input value for field ' + fFields[i].Name); end; if (State <> dsEdit) then begin // Somehow it's gets in dsBrowse here... fRecIDField.AsInteger := CurrRecId; CurrRecId := CurrRecId + 1; end; // This was originally in AfterPost. Moved here because after a post filters might step in and the current // record can change resulting in half change from record X and the remaining from record Y if not LogChanges or (csDesigning in ComponentState) then Exit; fDelta.EndChange; // Adds a reference to the RecID of this record to avoid double fetching records // This is a new master record, so it means there are no details to fetch remotely if (State=dsInsert) then begin key := IntToStr(GetRowRecIDValue); details := GetDetailDataTables; try for i := 0 to (details.Count-1) do begin with TDADataTable(details[i]) do if Active and (fFetchedMasters.IndexOf(key)<0) then fFetchedMasters.Add(key); end; finally details.Free; end; end; if (ruoOnPost in RemoteUpdatesOptions) then try ApplyUpdates(); except on E: Exception do begin fDelta.RestoreLastChange; raise; end; end; end; procedure TDADataTable.InternalAfterPost(Sender: TDataset); begin CallScript('AfterPost'); if Assigned(AfterPost) then AfterPost(Self); if Assigned(fBusinessRules) then fBusinessRules.AfterPost(Self); if not LogChanges or (csDesigning in ComponentState) then Exit; end; procedure TDADataTable.InternalAfterCancel(Sender: TDataset); begin CallScript('AfterCancel'); if Assigned(AfterCancel) then AfterCancel(Self); if Assigned(fBusinessRules) then fBusinessRules.AfterCancel(Self); fDelta.CancelChange; end; function TDADataTable.GetLogChanges: boolean; begin result := fLogChanges; end; procedure TDADataTable.DisableControls; begin fDataset.DisableControls; end; procedure TDADataTable.EnableControls; begin fDataset.EnableControls; end; function TDADataTable.GetBOF: boolean; begin result := fDataset.BOF end; function TDADataTable.GetEOF: boolean; begin result := fDataset.EOF end; function TDADataTable.GetFieldCount: integer; begin result := fFields.Count end; function TDADataTable.GetFieldValues(Index: integer): Variant; begin result := Fields[Index].Value end; function TDADataTable.GetNames(Index: integer): string; begin result := Fields[Index].Name end; function TDADataTable.GetRecordCount: integer; begin result := fDataset.RecordCount; end; function TDADataTable.GetSQL: string; begin // Not implemented in DataTables result := ''; end; function TDADataTable.Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; begin if VarIsArray(KeyValues) and (VarArrayHighBound(KeyValues, 1) = 0) then result := fDataset.Locate(KeyFields, KeyValues[0], Options) else result := fDataset.Locate(KeyFields, KeyValues, Options); end; procedure TDADataTable.Next; begin fDataset.Next; end; procedure TDADataTable.SetSQL(const Value: string); begin // Not implemented in DataTables end; function TDADataTable.Execute: integer; begin // Not implemented in DataTables result := -1; end; function TDADataTable.GetParams: TDAParamCollection; begin // Not implemented in DataTables result := fParams; end; procedure TDADataTable.RefreshParams; begin // Not implemented in DataTables end; procedure TDADataTable.Append; begin fDataset.Append; end; procedure TDADataTable.Delete; begin fDataset.Delete; end; procedure TDADataTable.Cancel; begin fDataset.Cancel; end; procedure TDADataTable.Edit; begin fDataset.Edit; end; procedure TDADataTable.Insert; begin fDataset.Insert; end; procedure TDADataTable.Post; begin fDataset.Post; end; {$WARN SYMBOL_DEPRECATED OFF} function TDADataTable.GetWhere: TDAWhere; begin result := fWhere end; {$WARN SYMBOL_DEPRECATED ON} procedure TDADataTable.SetRemoteDataAdapter(const Value: TDABaseRemoteDataAdapter); begin if Value <> fRemoteDataAdapter then begin fRemoteDataAdapter := Value; if assigned(fRemoteDataAdapter) then fRemoteDataAdapter.FreeNotification(self); end; end; procedure TDADataTable.Close; begin if not Active then Exit; fClosing := TRUE; try DoBeforeCloseDataset; if Assigned(BeforeClose) then BeforeClose(Self); if Assigned(fBusinessRules) then fBusinessRules.BeforeClose(Self); if (moCascadeOpenClose in MasterOptions) then DoCascadeOperation(nil, moCascadeOpenClose); Dataset.Close; fFields.Unbind; //Dataset.Fields.Clear; fDelta := nil; fFetchedMasters.Clear; DoAfterCloseDataset; if Assigned(AfterClose) then AfterClose(Self); if Assigned(fBusinessRules) then fBusinessRules.AfterClose(Self); finally fClosing := FALSE; end; end; procedure TDADataTable.InitializeDataTable; begin fCurrRecId := 1; try fDataset.Fields.Clear; fDataset.FieldDefs.Clear; finally NotifyFieldsClear; end; try // Creates the fields for the internal dataset CreateInternalFields(fDataset, Fields); finally NotifyFieldsClear; end; fRecIDField := fDataset.FieldByName(RecIDFieldName) as TIntegerField; fRecIDField.Visible := FALSE; fFields.Bind(fDataset); // Prepares the delta fDelta := TDADelta.Create(Self); (* // Finishes to prepare the internal dataset (descendant might need additional customization and might not be open) if RemoteFetchEnabled and (RemoteDataAdapter<>nil) and (TDARemoteDataAdapter(RemoteDataAdapter).GetDataCall.Default) then LoadScript(); *) DoBeforeOpenDataset; if not Dataset.Active then Dataset.Open; DoAfterOpenDataset; end; procedure TDADataTable.LoadFromLocalSchema; var lConnection: IDAConnection; data: TStream; gofirst, oldlog: boolean; ds: IDADataset; i: integer; lDynFields: array of string; begin if (LocalSchema = nil) or (LogicalName = '') then begin InitializeDataTable; Exit; end; // Local but from schema. Client/Server mode CheckProperties; lConnection := LocalSchema.ConnectionManager.NewConnection(fLocalConnection); try SetLength(lDynFields, 0); ds := LocalSchema.NewDataset(lConnection, fLogicalName,lDynFields,fDynamicWhere.Xml); oldlog := LogChanges; fFetching := TRUE; LogChanges := FALSE; // book := nil; data := Binary.Create; Binary(data).CapacityIncrement := LocalDataStreamer.BufferSize; try for i := 0 to (ds.Params.Count - 1) do ds.Params[i].Value := ParamByName(ds.Params[i].Name).Value; LocalDataStreamer.WriteDataset(data, ds, [woRows, woSchema], -1); if Active then gofirst := FALSE else gofirst := TRUE; if Assigned(fOnReceiveDataStream) then fOnReceiveDataStream(Self, data); if Assigned(fBusinessRules) then fBusinessRules.OnReceiveDataStream(Self, data); data.Position := 0; // Reads the data LocalDataStreamer.Initialize(data, aiRead); if (LocalDataStreamer.DatasetCount = 0) then RaiseError('Stream does not contain any dataset'); if Opening then begin if not (soIgnoreStreamSchema in fStreamingOptions) then LocalDataStreamer.ReadDataset(LogicalName, Self, TRUE, FALSE); InitializeDataTable; end; LocalDataStreamer.ReadDataset(LogicalName, Self, FALSE); { if (moAllInOneFetch in MasterOptions) then begin DoCascadeOperation(LocalDataStreamer, moAllInOneFetch); end;} LocalDataStreamer.Finalize; if gofirst then First; finally fFetching := FALSE; data.Free; LogChanges := oldlog; end; finally lConnection := nil; end; end; procedure TDADataTable.DoOpen(IgnoreAutoFetchSettings: Boolean); var i : integer; begin if Active or fOpening then Exit; fOpening := TRUE; try { Checks that all the lookup datasets are open. If not, we would get the error "Missing Data Provider"} for i := 0 to (FieldCount-1) do if Fields[i].Lookup and (Fields[i].LookupSource<>NIL) then begin if (Fields[i].LookupSource is TDADataSource) then begin if Assigned(TDADataSource(Fields[i].LookupSource).DataTable) then TDADataSource(Fields[i].LookupSource).DataTable.Open; end else begin if Assigned(Fields[i].LookupSource.DataSet) then Fields[i].LookupSource.DataSet.Open; end; end; if Assigned(BeforeOpen) then BeforeOpen(Self); if Assigned(fBusinessRules) then fBusinessRules.BeforeOpen(Self); try if not fFetching then begin if fMasterLink.Active then FetchMastersDetails(nil, nil, IgnoreAutoFetchSettings) // This calls InitializeDataTable possibily applying a new schema else if RemoteFetchEnabled then LoadFromRemoteSource else LoadFromLocalSchema; end; if (moCascadeOpenClose in MasterOptions) then DoCascadeOperation(nil, moCascadeOpenClose); if Assigned(AfterOpen) then AfterOpen(Self); if Assigned(fBusinessRules) then fBusinessRules.AfterOpen(Self); except on E: Exception do begin Close; {$IFDEF DESIGNTIME} if (csDesigning in ComponentState) then begin SysUtils.Beep; MessageDlg(E.Message, mtError, [mbOK], 0); end else {$ENDIF DESIGNTIME} raise; end; end; finally fOpening := FALSE; end; end; procedure TDADataTable.Open; begin DoOpen(True); end; procedure TDADataTable.OnMasterChange(Sender: TObject); begin if (MasterSource <> nil) and (MasterSource.DataTable <> nil) then begin if MasterSource.DataTable.fFetching then exit; end; FetchMastersDetails; end; procedure TDADataTable.OnMasterDisable(Sender: TObject); begin end; procedure TDADataTable.LoadFromRemoteSource(BookmarkPosition: boolean = FALSE); begin CheckProperties(True); if Assigned(fOnBeforeDataRequestCall) then fOnBeforeDataRequestCall(Self, RemoteDataAdapter.Get_GetDataCall); if Assigned(fBusinessRules) then fBusinessRules.OnBeforeDataRequestCall(Self, RemoteDataAdapter.Get_GetDataCall); RemoteDataAdapter.Fill([self], BookmarkPosition, FieldCount = 0); if Assigned(fOnAfterDataRequestCall) then fOnAfterDataRequestCall(Self, RemoteDataAdapter.Get_GetDataCall); if Assigned(fBusinessRules) then fBusinessRules.OnAfterDataRequestCall(Self, RemoteDataAdapter.Get_GetDataCall); end; function TDADataTable.ApplyUpdates(RefetchAll: boolean = FALSE): boolean; var details: TList; i: integer; dt: TDADataTable; begin details:= GetDetailTablesforApplyUpdate; try // check RDA CheckProperties; for i := 0 to details.Count-1 do begin dt:= TDADataTable(details[i]); {if dt.RemoteFetchEnabled then } dt.CheckProperties; end; //fOnBeforeApplyUpdates if Assigned(fOnBeforeApplyUpdates) then fOnBeforeApplyUpdates(Self, fDelta); for i := 0 to details.Count-1 do begin dt:= TDADataTable(details[i]); if Assigned(dt.fOnBeforeApplyUpdates) then dt.fOnBeforeApplyUpdates(dt, fDelta); end; //fBusinessRules.OnBeforeApplyUpdates if Assigned(fBusinessRules) then fBusinessRules.OnBeforeApplyUpdates(Self, fDelta); for i := 0 to details.Count-1 do begin dt:= TDADataTable(details[i]); if Assigned(dt.fBusinessRules) then dt.fBusinessRules.OnBeforeApplyUpdates(dt, fDelta); end; if RemoteFetchEnabled then begin //fOnBeforeDataUpdateCall if Assigned(fOnBeforeDataUpdateCall) then fOnBeforeDataUpdateCall(Self, RemoteDataAdapter.Get_UpdateDataCall); for i := 0 to details.Count-1 do begin dt:= TDADataTable(details[i]); if Assigned(dt.fOnBeforeDataUpdateCall) then dt.fOnBeforeDataUpdateCall(dt, dt.RemoteDataAdapter.Get_UpdateDataCall); end; //fBusinessRules.OnBeforeDataUpdateCall if Assigned(fBusinessRules) then fBusinessRules.OnBeforeDataUpdateCall(Self, RemoteDataAdapter.Get_UpdateDataCall); for i := 0 to details.Count-1 do begin dt:= TDADataTable(details[i]); if Assigned(dt.fBusinessRules) then dt.fBusinessRules.OnBeforeDataUpdateCall(dt, dt.RemoteDataAdapter.Get_UpdateDataCall); end; result := RemoteDataAdapter.ApplyUpdates([self], RefetchAll); //fOnAfterDataUpdateCall if Assigned(fOnAfterDataUpdateCall) then fOnAfterDataUpdateCall(Self, RemoteDataAdapter.Get_UpdateDataCall); for i := 0 to details.Count-1 do begin dt:= TDADataTable(details[i]); if Assigned(dt.fOnAfterDataUpdateCall) then dt.fOnAfterDataUpdateCall(dt, dt.RemoteDataAdapter.Get_UpdateDataCall); end; //fBusinessRules.OnAfterDataUpdateCall if Assigned(fBusinessRules) then fBusinessRules.OnAfterDataUpdateCall(Self, RemoteDataAdapter.Get_UpdateDataCall); for i := 0 to details.Count-1 do begin dt:= TDADataTable(details[i]); if Assigned(dt.fBusinessRules) then dt.fBusinessRules.OnAfterDataUpdateCall(dt, dt.RemoteDataAdapter.Get_UpdateDataCall); end; end else begin result := Local_ApplyUpdates(RefetchAll); end; //fOnAfterApplyUpdates if Assigned(fOnAfterApplyUpdates) then fOnAfterApplyUpdates(Self); for i := 0 to details.Count-1 do begin dt:= TDADataTable(details[i]); if Assigned(dt.fOnAfterApplyUpdates) then dt.fOnAfterApplyUpdates(dt); end; //fBusinessRules.OnAfterApplyUpdates if Assigned(fBusinessRules) then fBusinessRules.OnAfterApplyUpdates(Self); for i := 0 to details.Count-1 do begin dt:= TDADataTable(details[i]); if Assigned(dt.fBusinessRules) then dt.fBusinessRules.OnAfterApplyUpdates(dt); end; finally details.Free; end; end; procedure TDADataTable.LoadSchema(PreserveLookupFields : boolean = FALSE; PreserveClientCalcFields : boolean = FALSE); begin CheckProperties(True); if Assigned(fOnBeforeSchemaCall) then fOnBeforeSchemaCall(Self, RemoteDataAdapter.Get_GetSchemaCall); if Assigned(fBusinessRules) then fBusinessRules.OnBeforeSchemaCall(self, RemoteDataAdapter.Get_GetSchemaCall); RemoteDataAdapter.FillSchema([self], PreserveLookupFields, PreserveClientCalcFields); if Assigned(fOnAfterSchemaCall) then fOnAfterSchemaCall(Self, RemoteDataAdapter.Get_GetSchemaCall); if Assigned(fBusinessRules) then fBusinessRules.OnAfterSchemaCall(self, RemoteDataAdapter.Get_GetSchemaCall); end; procedure TDADataTable.LoadScript(aDatasetName : string = ''); begin CheckProperties(True); if Assigned(fOnBeforeScriptCall) then fOnBeforeScriptCall(Self, RemoteDataAdapter.Get_GetScriptsCall); if Assigned(fBusinessRules) then fBusinessRules.OnBeforeScriptCall(Self, RemoteDataAdapter.Get_GetScriptsCall); RemoteDataAdapter.FillScripts([self]); if Assigned(fOnAfterScriptCall) then fOnAfterScriptCall(Self, RemoteDataAdapter.Get_GetScriptsCall); if Assigned(fBusinessRules) then fBusinessRules.OnAfterScriptCall(Self, RemoteDataAdapter.Get_GetScriptsCall); end; procedure TDADataTable.FetchMastersDetails(aMasterTable : TDADataTable = NIL; aRequestMappings : TStrings = NIL; IgnoreAutoFetchSettings: Boolean = False); procedure CombineDynamicWhere(aWhereExpression:TDAWhereExpression); begin if fMasterMappingMode = mmWhere then begin if fDynamicWhere.Expression = nil then fDynamicWhere.Expression:= aWhereExpression else fDynamicWhere.Expression:= fDynamicWhere.NewBinaryExpression(fDynamicWhere.Expression,aWhereExpression,dboAnd); end; end; procedure RevertDynamicWhere(aWhereExpression:TDAWhereExpression); var fUserWhereExpression: TDAWhereExpression; begin if fMasterMappingMode = mmWhere then begin fUserWhereExpression:= nil; if fDynamicWhere.Expression <> aWhereExpression then begin fUserWhereExpression:= TDABinaryExpression(fDynamicWhere.Expression).Left; TDABinaryExpression(fDynamicWhere.Expression).Left:=nil; end; fDynamicWhere.Clear; fDynamicWhere.Expression:= fUserWhereExpression; end; end; function GenerateWhereStatement: TDAWhereExpression; var lFieldName: string; pos1, pos2: integer; lfld1: TDAField; lfld2: TDAField; lExpression: TDAWhereExpression; begin //fDynamicWhere.Clear; Pos1 := 1; pos2 := 1; Result:=nil; while True do begin if (Pos1 > Length(DetailFields)) and (Pos2 > Length(MasterFields)) then Break; if ((Pos1 > Length(DetailFields)) and (Pos2 <= Length(MasterFields))) or ((Pos1 <= Length(DetailFields)) and (Pos2 > Length(MasterFields))) then RaiseError('DetailFields should have same number of items as MasterFields'); {$WARN SYMBOL_DEPRECATED OFF} lFieldName:= ExtractFieldName(DetailFields, Pos1); {$WARN SYMBOL_DEPRECATED ON} lfld1 := FindField(lFieldName); if lfld1 = nil then RaiseError('Invalid field name %s in DetailFields', [lFieldName]); {$WARN SYMBOL_DEPRECATED OFF} lFieldName:= ExtractFieldName(MasterFields, Pos2); {$WARN SYMBOL_DEPRECATED ON} lfld2 := MasterSource.DataTable.Fields.FindField(lFieldName); if lfld2 = nil then RaiseError('Invalid field name %s in MasterFields', [lFieldName]); lExpression := fDynamicWhere.NewBinaryExpression( fDynamicWhere.NewField('',lfld1.Name), fDynamicWhere.NewConstant(lfld2.Value,lfld2.DataType), dboEqual); if Result <> nil then Result:=fDynamicWhere.NewBinaryExpression(Result,lExpression,dboAnd) else Result:= lExpression; end; end; var master: TDataset; par: TDARemoteRequestParam; fld: TDAField; key: string; i: integer; dofetch: boolean; mappings : TStrings; detailparam : TDAParam; lmmWhereExpression: TDAWhereExpression; begin if RemoteFetchEnabled then CheckProperties else if not(Assigned(LocalSchema) and Assigned(LocalDataStreamer)) then begin if fOpening then InitializeDataTable; Exit; end; // // // TODO: this doesnt properly use the new RDA's DMB yet. we need to discuss/rethink how to handle that! // // mappings := NIL; dofetch := (((dtAutoFetch in DetailOptions) or IgnoreAutoFetchSettings) {and RemoteFetchEnabled}) or (aMasterTable<>NIL); if (aRequestMappings<>NIL) then mappings := aRequestMappings else begin case fMasterMappingMode of mmDataRequest : mappings := MasterRequestMappings; mmParams : mappings := MasterParamsMappings; end; end; if (aMasterTable<>NIL) then master := aMasterTable.Dataset else master := fMasterLink.DataSet; if master = nil then exit; if (master.RecordCount = 0) then begin if not Active then InitializeDataTable; // Master opened with 0 records and detail wasn't open yet Exit; end else if (MasterSource = nil) then Exit; if (master.State=dsBrowse) and not MasterSource.DataTable.Delta.IsNewRecord then begin if dofetch then begin // Determines if the details for this master have been fetched key := IntToStr(MasterSource.DataTable.GetRowRecIDValue); if (fFetchedMasters.IndexOf(key) >= 0) then Exit; if (fMasterMappingMode = mmWhere) or ((mappings<>NIL) and (mappings.Count > 0)) then begin lmmWhereExpression:=nil; if RemoteFetchEnabled then begin // remotemode // If not, then assigns the param values from the current master record, // invokes the remote call and loads the data case MasterMappingMode of mmWhere: begin lmmWhereExpression:=GenerateWhereStatement; end; mmDataRequest : begin for i := 0 to (mappings.Count - 1) do begin par := nil; if RemoteDataAdapter.Get_GetDataCall <> nil then par := RemoteDataAdapter.Get_GetDataCall.Params.ParamByName(Trim(mappings.Names[i])); if (par=NIL) then RaiseError('Invalid parameter name %s in master mappings', [Trim(mappings.Names[i])]); fld := MasterSource.DataTable.Fields.FindField(Trim(mappings.Values[mappings.Names[i]])); if (fld=NIL) then RaiseError('Invalid field name %s in master mappings', [Trim(mappings.Values[mappings.Names[i]])]); if (par <> nil) and (fld <> nil) and not VarIsNull(fld.Value) then par.AsVariant := fld.Value end; end; mmParams : begin // Fills it in for i := 0 to (mappings.Count - 1) do begin detailparam := Params.ParamByName(Trim(mappings.Names[i])); if (detailparam=NIL) then RaiseError('Invalid parameter name %s in param mappings', [Trim(mappings.Names[i])]); fld := MasterSource.DataTable.Fields.FindField(Trim(mappings.Values[mappings.Names[i]])); if (fld=NIL) then RaiseError('Invalid field name %s in param mappings', [Trim(mappings.Values[mappings.Names[i]])]); if (detailparam <> nil) and (fld <> nil) and not VarIsNull(fld.Value) then detailparam.Value := fld.Value end; end; end; CombineDynamicWhere(lmmWhereExpression); try LoadFromRemoteSource; finally RevertDynamicWhere(lmmWhereExpression); end; try fFetchedMasters.Add(key); except raise Exception.CreateFmt('Master record %s has been fetched twice', [key]); end; end { RemoteFetchEnabled }else begin // localmode // If not, then assigns the param values from the current master record, // invokes the remote call and loads the data case MasterMappingMode of mmWhere: begin lmmWhereExpression := GenerateWhereStatement; end; mmParams: begin // Fills it in for i := 0 to (mappings.Count - 1) do begin detailparam := Params.ParamByName(Trim(mappings.Names[i])); if (detailparam=NIL) then RaiseError('Invalid parameter name %s in param mappings', [Trim(mappings.Names[i])]); fld := MasterSource.DataTable.Fields.FindField(Trim(mappings.Values[mappings.Names[i]])); if (fld=NIL) then RaiseError('Invalid field name %s in param mappings', [Trim(mappings.Values[mappings.Names[i]])]); if (detailparam <> nil) and (fld <> nil) and not VarIsNull(fld.Value) then detailparam.Value := fld.Value end; end; mmDataRequest: raise Exception.Create('mmDataRequest mode only supported in RemoteFetchEnabled mode'); end; CombineDynamicWhere(lmmWhereExpression); try LoadFromLocalSchema; finally RevertDynamicWhere(lmmWhereExpression); end; try fFetchedMasters.Add(key); except raise Exception.CreateFmt('Master record %s has been fetched twice', [key]); end; end; end else begin { ALEF: I removed the code below because it was never meant to be here to begin with. Very error prone. Who added this??? // Automatics for i := 0 to (DataRequestCall.Params.Count - 1) do begin par := DataRequestCall.Params[i]; fld := MasterSource.DataTable.Fields.FindField(par.Name); if (par <> nil) and (fld <> nil) and not VarIsNull(fld.Value) then par.Value := fld.Value; end;} RaiseError('There are no mappings defined. Cannot fetch records for detail table '+Name); end; end; {dofetch} end; end; procedure TDADataTable.WriteDeltaToStream(aStreamer: TDADataStreamer); var i: integer; details: TList; lHasReducedDelta: Boolean; oldMode: boolean; begin // And the details' updates (if specified) details := GetDetailTablesforApplyUpdate(False); try lHasReducedDelta:= fHasReducedDelta; if not aStreamer.SendReducedDelta then begin if not lHasReducedDelta then for i := 0 to (details.Count - 1) do begin lHasReducedDelta:= TDADataTable(details[i]).fHasReducedDelta; if lHasReducedDelta then Break; end; end; oldMode:=aStreamer.SendReducedDelta; if lHasReducedDelta then aStreamer.SendReducedDelta:=True; try // Writes its own updates if self.HasDelta then aStreamer.WriteDelta(Self); for i := 0 to (details.Count - 1) do TDADataTable(details[i]).WriteDeltaToStream(aStreamer); finally aStreamer.SendReducedDelta := oldMode; end; finally details.Free; end; end; procedure TDADataTable.ReadDeltaFromStream(aStreamer: TDADataStreamer;aFailedDeltas:TList); var i: integer; details: TList; begin // Reads its own updates if aStreamer.FindDeltaIndex(Self.LogicalName) <> -1 then begin Delta.Clear; aStreamer.ReadDelta(Self); if Delta.Count>0 then fHasReducedDelta := aStreamer.HasReducedDelta; For i := 0 to Delta.Count-1 do if Delta.Changes[i].Status = csFailed then aFailedDeltas.Add(Delta.Changes[i]); end; // And the details' updates (if specified) details := GetDetailTablesforApplyUpdate(False); try for i := 0 to (details.Count - 1) do TDADataTable(details[i]).ReadDeltaFromStream(aStreamer, aFailedDeltas); finally details.Free; end; end; procedure TDADataTable.ReadDeltaFromStream(aStreamer: TDADataStreamer); var List: TList; begin List:= TList.Create; try ReadDeltaFromStream(aStreamer,List); finally List.Free; end; end; procedure TDADataTable.MergeDelta; var i, k, x: integer; details: TList; dt: TDADataTable; // ok : boolean; // failed, pending, resolved : integer; oldval, newval, val : Variant; fld : TDAField; pkfields : string; oldopt : TDARemoteUpdatesOptions; oldlog : boolean; keyvals : array of variant; oldmastersource : TDADataSource; lhasDelta: Boolean; pk_array: array of boolean; lReadOnly: boolean; begin details:=GetDetailTablesforApplyUpdate(False); try //fOnBeforeMergeDelta if Assigned(fOnBeforeMergeDelta) then fOnBeforeMergeDelta(Self); for i := 0 to details.Count-1 do begin dt:= TDADataTable(details[i]); if Assigned(dt.fOnBeforeMergeDelta) then dt.fOnBeforeMergeDelta(dt); end; //fBusinessRules.OnBeforeMergeDelta if Assigned(fBusinessRules) then fBusinessRules.OnBeforeMergeDelta(Self); for i := 0 to details.Count-1 do begin dt:= TDADataTable(details[i]); if Assigned(dt.fBusinessRules) then dt.fBusinessRules.OnBeforeMergeDelta(dt); end; oldopt := RemoteUpdatesOptions; oldlog := LogChanges; oldmastersource := MasterSource; lhasDelta := Delta.Count > 0; if lhasDelta then begin RemoteUpdatesOptions := RemoteUpdatesOptions-[ruoOnPost]; LogChanges := FALSE; // Disables the M/D relationship so that Locates can work in all cases (master or detail tables, regardless // of their positioning) MasterSource := NIL; end; try pkfields := ''; for i := 0 to (Delta.KeyFieldCount-1) do pkfields := pkfields+Delta.KeyFieldNames[i]+';'; pkfields := Copy(pkfields, 1, Length(pkfields)-1); SetLength(keyvals, Delta.KeyFieldCount); // Merges the updates if (Delta.Count>0) then begin SetLength(pk_array, Delta.LoggedFieldCount); for i := 0 to Delta.LoggedFieldCount - 1 do pk_array[i]:=False; for i := 0 to Delta.KeyFieldCount - 1 do begin x := Delta.IndexOfLoggedField(Delta.KeyFieldNames[i]); if x <> -1 then pk_array[x]:=True; end; for i := (Delta.Count-1) downto 0 do begin if (Delta[i].Status<>csResolved) then Continue; if (Delta[i].ChangeType<>ctDelete) then begin if (Self.State in [dsEdit, dsInsert]) and (ruoOnPost in oldopt) then begin // Merge the details for x := 0 to (details.Count - 1) do TDADataTable(details[x]).MergeDelta; for x := 0 to (Delta.LoggedFieldCount-1) do begin fld := FieldByName(Delta.LoggedFieldNames[x]); newval := Delta[i].NewValueByName[fld.Name]; oldval := Delta[i].OldValueByName[fld.Name]; if fHasReducedDelta then begin if not pk_array[x] and ROVariantsEqual(oldVal,newVal) then continue; end; if fld.ServerAutoRefresh or (not VarIsArray(newVal) and not ROVariantsEqual(newval,oldval)) then begin VariantToFieldValue(Delta[i].NewValueByName[fld.Name], fld); end; end; end else begin for k := 0 to (Delta.KeyFieldCount-1) do begin val := Delta[i].OldValueByName[Delta.KeyFieldNames[k]]; keyvals[k] := val; end; // Locates the original record First; if not Locate(pkfields, keyvals, []) then Continue; // Merge the details for x := 0 to (details.Count - 1) do TDADataTable(details[x]).MergeDelta; // Merges its own updates Edit; for x := 0 to (Delta.LoggedFieldCount-1) do begin fld := FieldByName(Delta.LoggedFieldNames[x]); newval := Delta[i].NewValueByName[fld.Name]; oldval := Delta[i].OldValueByName[fld.Name]; if fHasReducedDelta then begin if not pk_array[x] and ROVariantsEqual(oldVal,newVal) then continue; end; if fld.ServerAutoRefresh or (not VarIsArray(newVal) and (newval<>oldval)) then begin lReadOnly := fld.ServerAutoRefresh and fld.ReadOnly; if lReadOnly then fld.ReadOnly:=False; VariantToFieldValue(Delta[i].NewValueByName[fld.Name], fld); if lReadOnly then fld.ReadOnly:=True; end; end; Post; end; end; // Removes this merged change Delta.Delete(i); end; end // If there are no updates for this master, the children still need to be processed else begin // Merge the details for x := 0 to (details.Count - 1) do TDADataTable(details[x]).MergeDelta; end; finally if lhasDelta then begin RemoteUpdatesOptions := oldopt; LogChanges := oldlog; // Restores the M/D relationship MasterSource := oldmastersource; end; //fOnAfterMergeDelta if Assigned(fOnAfterMergeDelta) then fOnAfterMergeDelta(Self); for i := 0 to details.Count-1 do begin dt:= TDADataTable(details[i]); if Assigned(dt.fOnAfterMergeDelta) then dt.fOnAfterMergeDelta(dt); end; //fBusinessRules.OnAfterMergeDelta if Assigned(fBusinessRules) then fBusinessRules.OnAfterMergeDelta(Self); for i := 0 to details.Count-1 do begin dt:= TDADataTable(details[i]); if Assigned(dt.fBusinessRules) then dt.fBusinessRules.OnAfterMergeDelta(dt); end; end; finally details.Free; if Delta.Count = 0 then fHasReducedDelta:=False; end; end; procedure TDADataTable.PackAllInOneFetchInfoArray(aDataTable : TDADataTable; OutArray: TDADatasetRequestInfoArray); var outinfo : TDADatasetRequestInfo; details : TList; dt : TDADataTable; i : integer; begin outinfo := outarray.Add; outinfo.DatasetName := aDataTable.LogicalName; outinfo.MaxRecords := aDataTable.MaxRecords; outinfo.IncludeSchema := TRUE; outinfo.Params := NIL; details := aDataTable.GetDetailDataTables; try for i := 0 to (details.Count - 1) do begin dt := TDADataTable(details[i]); if (dtIncludeInAllInOneFetch in dt.DetailOptions) then PackAllInOneFetchInfoArray(dt, OutArray); end; finally details.Free; end; end; function TDADataTable.FieldByName(const aName: string): TDAField; begin result := fFields.FieldByName(aName) end; function TDADataTable.ParamByName(const aName: string): TDAParam; begin result := fParams.ParamByName(aName) end; procedure TDADataTable.First; begin fDataset.First end; procedure TDADataTable.Last; begin fDataset.Last end; procedure TDADataTable.Prior; begin fDataset.Prior end; procedure TDADataTable.Sort(const FieldNames: array of string; const Directions: array of TDASortDirection); var i: integer; begin DoSort(FieldNames, Directions); // Stores the new settings for convenience SetLength(fSortDirections, Length(Directions)); for i := 0 to Length(Directions) - 1 do fSortDirections[i] := Directions[i]; SetLength(fSortFieldNames, Length(FieldNames)); for i := 0 to Length(FieldNames) - 1 do fSortFieldNames[i] := FieldNames[i]; end; procedure TDADataTable.UnSort; begin Sort([], []); end; procedure TDADataTable.LoadFromStream(aStream: TStream); var //remfetch, oldlogchanges, oldcascadeopenclose: boolean; lStreamer: TDADataStreamer; i: integer; begin Check(RemoteFetchEnabled, Name+'. Cannot do this operation when RemoteFetchEnabled is set to TRUE'); if RemoteDataAdapter <> nil then lStreamer:=RemoteDataAdapter.DataStreamer else lStreamer:=LocalDataStreamer; Check(lStreamer = nil, Name+'. RemoteDataAdapter or LocalDataStreamer must be assigned.'); Close; oldlogchanges := LogChanges; // remfetch := RemoteFetchEnabled; oldcascadeopenclose := moCascadeOpenClose in fMasterOptions; // RemoteFetchEnabled := FALSE; LogChanges := FALSE; if oldcascadeopenclose then fMasterOptions := fMasterOptions - [moCascadeOpenClose]; try fStreaming := True; try lStreamer.Initialize(aStream, aiRead); if not (soIgnoreStreamSchema in fStreamingOptions) then lStreamer.ReadDataset(LogicalName, Self, TRUE) else lStreamer.ReadDataset(LogicalName, Self, FALSE); lStreamer.ReadDelta(Self); if Delta <> nil then For i:= 0 to Delta.Count-1 do if fCurrRecId <= Delta.Changes[i].RecID then fCurrRecId := Delta.Changes[i].RecID+1; finally fStreaming := False; end; finally lStreamer.Finalize; LogChanges := oldlogchanges; // RemoteFetchEnabled := remfetch; if oldcascadeopenclose then begin fMasterOptions := fMasterOptions + [moCascadeOpenClose]; fOpening := True; try DoCascadeOperation(nil, moCascadeOpenClose); finally fOpening := False; end; end; if Active then First; end; end; procedure TDADataTable.SaveToStream(aStream: TStream); var lStreamer: TDADataStreamer; OldMasterSource: TDADataSource; begin if (soDisableEventsWhileStreaming in fStreamingOptions) then DisableControls; try OldMasterSource := MasterSource; MasterSource := nil; fStreaming := True; try First; // Important! if RemoteFetchEnabled then lStreamer:= RemoteDataAdapter.DataStreamer else lStreamer:=LocalDataStreamer; if lStreamer = nil then CheckProperties; lStreamer.Initialize(aStream, aiWrite); lStreamer.WriteDataset(Self, [woRows, woSchema]); lStreamer.WriteDelta(Self); lStreamer.Finalize; finally fStreaming := False; MasterSource := OldMasterSource; end; finally if (soDisableEventsWhileStreaming in fStreamingOptions) then EnableControls; end; end; procedure TDADataTable.LoadFromFile(const aFileName: string); var fs: TFileStream; oldval : boolean; begin oldval := RemoteFetchEnabled; RemoteFetchEnabled := FALSE; try fs := TFileStream.Create(aFileName, fmOpenRead); try LoadFromStream(fs); finally fs.Free; end; finally RemoteFetchEnabled := oldval; end; end; procedure TDADataTable.SaveToFile(const aFileName: string); var fs: TFileStream; begin fs := TFileStream.Create(aFileName, fmCreate); try SaveToStream(fs); finally fs.Free; end; end; procedure TDADataTable.SetParams(const Value: TDAParamCollection); begin fParams.Assign(Value); end; procedure TDADataTable.ClearFields; var i: integer; begin for i := 0 to FieldCount - 1 do Fields[i].Value := Null; end; procedure TDADataTable.ClearRows; var CurChange: TDADeltaChange; begin while (RecordCount > 0) do begin if (not LogChanges) and Assigned(Delta) then begin CurChange := Delta.FindChange(RecIDValue); if Assigned(CurChange) then Delta.RemoveChange(CurChange); end; Delete; end; end; function TDADataTable.GetState: TDataSetState; begin result := fDataset.State end; function TDADataTable.GetEditing: boolean; begin result := State in [dsEdit, dsInsert] end; function TDADataTable.GetPrepared: boolean; begin result := FALSE end; procedure TDADataTable.SetPrepared(Value: boolean); begin end; function TDADataTable.GetText: string; begin result := '' end; procedure TDADataTable.SetText(const Value: string); begin end; procedure TDADataTable.Notification(AComponent: TComponent; Operation: TOperation); var i: Integer; begin inherited; if (Operation = opRemove) then begin if (AComponent = fLocalSchema) then fLocalSchema := nil; if (AComponent = fRemoteDataAdapter) then fRemoteDataAdapter := nil; if (AComponent = fLocalDataStreamer) then fLocalDataStreamer := nil; if AComponent is TDataSource then begin for i := 0 to Fields.Count - 1 do begin if Fields[i].LookupSource = AComponent then Fields[i].LookupSource := nil; end; end; end; end; procedure TDADataTable.SetMasterSource(const Value: TDADataSource); begin fMasterLink.DataSource := Value; end; procedure TDADataTable.SetMasterFields(const Value: string); begin fMasterLink.FieldNames := Value; end; function TDADataTable.GetMasterRequestMappings: TStrings; begin result := fMasterRequestMappings; end; procedure TDADataTable.SetMasterRequestMappings(const Value: TStrings); begin fMasterRequestMappings.Assign(Value); end; function TDADataTable.GetDetailDataTables: TList; var i: integer; ownerdt: TDADataTable; dtdataset: IDADataTableDataset; tmplist: TList; begin // This function only returns the linked datatables and removes duplicates // from the GetDetailDataSets call. I assume the duplicates are because of // the masterlink TDADatatables create. result := TList.Create; tmplist := TList.Create; try {$IFNDEF FPC} Dataset.GetDetailDataSets(tmplist); {$ENDIF} for i := 0 to (tmplist.Count - 1) do begin if not Supports(TDataset(tmplist[i]), IDADataTableDataset, dtdataset) then Continue; ownerdt := dtdataset.GetDataTable; if (result.IndexOf(ownerdt) < 0) then result.Add(ownerdt); end; finally tmplist.Free; end; end; function TDADataTable.GetDelta: IDADelta; begin if (fDelta = nil) then raise Exception.Create('Delta has not yet been initialized by the datatable'); result := fDelta; end; function TDADataTable.GetName: string; begin if (LogicalName = '') then result := Name else result := LogicalName; end; procedure TDADataTable.DoAfterCloseDataset; begin CallScript('AfterClose'); end; procedure TDADataTable.DoAfterOpenDataset; begin CallScript('AfterOpen'); if Assigned(fAfterOpenIDataset) then fAfterOpenIDataset(Self, '', ROGetTickCount-fOpenTick); end; procedure TDADataTable.DoBeforeCloseDataset; begin CallScript('BeforeClose'); end; procedure TDADataTable.CloneSelectedRecord(Source: TDADataTable; DoPost: boolean = TRUE); begin CloneSelectedRecord(Source as IDADataset, DoPost); end; procedure TDADataTable.CloneSelectedRecord(const Source: IDADataset; DoPost: boolean = TRUE); var i: integer; destfld, srcfld: TDAField; lreadonly: boolean; begin Insert; for i := 0 to (Source.FieldCount - 1) do begin srcfld := Source.Fields[i]; destfld := Fields.FindField(srcfld.Name); lreadonly := destfld.ReadOnly; destfld.ReadOnly := False; try if destfld <> nil then destfld.Value := srcfld.Value; finally destfld.ReadOnly := lreadonly; end; end; if DoPost then Post; end; procedure TDADataTable.FreeBookmark(Bookmark: TBookmark); begin Dataset.FreeBookmark(Bookmark); end; function TDADataTable.GetBookmark: pointer; begin result := Dataset.GetBookmark; end; procedure TDADataTable.GotoBookmark(Bookmark: TBookmark); begin Dataset.GotoBookmark(Bookmark); end; function TDADataTable.GetRowRecIDValue: integer; begin result := fRecIDField.AsInteger end; procedure TDADataTable.DisableEventHandlers; begin DetachEventHooks(Dataset); end; procedure TDADataTable.EnableEventHandlers; begin AttachEventHooks(Dataset); end; procedure TDADataTable.Refresh; begin fDataset.Refresh; end; procedure TDADataTable.SetLocalDataStreamer(const Value: TDADataStreamer); begin fLocalDataStreamer := Value; if (fLocalDataStreamer <> nil) then fLocalDataStreamer.FreeNotification(Self); end; procedure TDADataTable.SetLocalSchema(const Value: TDASchema); begin fLocalSchema := Value; if (fLocalSchema <> nil) then begin fLocalSchema.FreeNotification(Self); RemoteFetchEnabled := FALSE; end; end; function TDADataTable.DataReaderFirst: boolean; begin result := RecordCount > 0; if result then First; end; function TDADataTable.DataReaderNext: boolean; begin result := not EOF; if result then Next; end; function TDADataTable.GetAsBoolean(Index: integer): boolean; begin result := fFields[Index].AsBoolean; end; function TDADataTable.GetAsBoolean(const FieldName: string): boolean; begin result := FieldByName(FieldName).AsBoolean; end; function TDADataTable.GetAsCurrency(Index: integer): Currency; begin Result:= fFields[Index].AsCurrency; end; function TDADataTable.GetAsCurrency(const FieldName: string): currency; begin result := FieldByName(FieldName).AsCurrency; end; function TDADataTable.GetAsDateTime(const FieldName: string): TDateTime; begin result := FieldByName(FieldName).AsDateTime; end; function TDADataTable.GetAsDateTime(Index: integer): TDateTime; begin result := fFields[Index].AsDateTime; end; function TDADataTable.GetAsFloat(const FieldName: string): double; begin result := FieldByName(FieldName).AsFloat; end; function TDADataTable.GetAsFloat(Index: integer): double; begin result := fFields[Index].AsFloat; end; function TDADataTable.GetAsInteger(Index: integer): integer; begin result := fFields[Index].AsInteger; end; function TDADataTable.GetAsInteger(const FieldName: string): integer; begin result := FieldByName(FieldName).AsInteger; end; function TDADataTable.GetAsString(const FieldName: string): string; begin result := FieldByName(FieldName).AsString; end; function TDADataTable.GetAsString(Index: integer): string; begin result := fFields[Index].AsString; end; function TDADataTable.GetAsVariant(const FieldName: string): variant; begin result := FieldByName(FieldName).Value; end; function TDADataTable.GetAsVariant(Index: integer): variant; begin result := fFields[Index].Value end; function TDADataTable.GetFieldIndexes(const aName: string): integer; begin result := fFields.FindItem(aName).Index end; function TDADataTable.GetFieldNames(Index: integer): string; begin result := fFields[Index].Name end; procedure TDADataTable.SetBusinessRulesID(const Value: string); var bizclass: TDADataTableRulesClass; begin if (Value = fBusinessRulesID) then Exit; if Assigned(fBusinessRules) then begin fBusinessRules.Detach(Self); FreeAndNIL(fBusinessRules); end; fBusinessRulesID := Trim(Value); if (fBusinessRulesID <> '') and not (csDesigning in ComponentState) then begin Check(not FindDataTableRules(Value, bizclass), 'Invalid BusinessRulesID "%s"', [Value]); fBusinessRules := bizclass.Create(Self); fBusinessRules.Attach(Self); end; end; function TDADataTable.QueryInterface(const IID: TGUID; out Obj): HResult; begin result := inherited QueryInterface(IID, Obj); if (result <> S_OK) and Assigned(fBusinessRules) then begin // Users might introduce specific interfaces at the business rule level // This allows to type cast the data table to any additional business oriented interface // they decide to create. result := fBusinessRules.QueryInterface(IID, Obj); end; end; function TDADataTable.GetHasDelta: boolean; begin result := Assigned(fDelta) and (fDelta.Count > 0); end; function TDADataTable.GetHasDeltaRecursive: boolean; var lDetails: TList; lTable: TDADataTable; i: integer; begin result := Assigned(fDelta) and (fDelta.Count > 0); if not result then begin lDetails := nil; if (moCascadeApplyUpdates in fMasterOptions) then try lDetails := GetDetailDataTables; for i := 0 to (lDetails.Count-1) do begin lTable := TDADataTable(lDetails[i]); if lTable.HasDeltaRecursive then begin result := true; exit; end; end; finally lDetails.Free; end; end; end; function TDADataTable.GetMasterDataTable: TDADataTable; var lDatatableDataset : IDADataTableDataset; begin if Supports(fMasterLink.DataSet, IDADataTableDataset, lDatatableDataset) then result := lDatatableDataset.GetDataTable else result := NIL; end; function TDADataTable.GetRecNo: integer; begin result := fDataset.RecNo end; procedure TDADataTable.SetRecNo(const Value: integer); begin fDataset.RecNo := Value end; function TDADataTable.GetFieldsProperty: TDAFieldCollection; begin result := GetFields; end; function TDADataTable.GetActiveProperty: boolean; begin result := GetActive(); end; procedure TDADataTable.SetActiveProperty(const Value: boolean); begin SetActive(Value); end; function TDADataTable.GetParamsProperty: TDAParamCollection; begin result := GetParams(); end; {$IFNDEF LINUX} function TDADataTable.InterfaceSupportsErrorInfo(const iid: TGUID): HResult; begin if GetInterfaceEntry(iid) <> nil then Result := S_OK else Result := S_FALSE; end; function TDADataTable.SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult; begin Result := uDAEngine.DAHandleSafeCallException(self,ExceptObject, ExceptAddr); end; {$ENDIF} procedure TDADataTable.CancelUpdates(IncludeDetails: boolean); var list : TList; i, orignextinc : integer; wasfiltered, remotefetch : boolean; lOldMasterFields: string; begin if Editing then Cancel; if not LogChanges then Exit; DisableControls; wasfiltered := Filtered; Filtered := FALSE; try // Truns off the remote fetching for this datatable and its details remotefetch := RemoteFetchEnabled; RemoteFetchEnabled := FALSE; if IncludeDetails then list := GetDetailDataTables else list := TList.Create; // Disable the log of changes (we're about to make a bunch!) LogChanges := FALSE; // Saves the current recinc (we'll change this during the restore) orignextinc := CurrRecId; try lOldMasterFields := MasterFields; MasterFields := ''; try // Reverts the records to the original state for i := 0 to (Delta.Count-1) do InternalCancelUpdateChange(Delta[i]); finally MasterFields := lOldMasterFields; end; // Cancels the updates for the details for i := 0 to list.Count-1 do begin TDADataTable(list[i]).CancelUpdates(TRUE); end; // Erases the delta Delta.Clear; finally fHasReducedDelta:=False; list.Free; CurrRecId := orignextinc; LogChanges := TRUE; RemoteFetchEnabled := remotefetch; end; finally Filtered := wasfiltered; EnableControls; end; end; procedure TDADataTable.DoBeforeOpenDataset; begin CallScript('BeforeOpen'); fOpenTick := ROGetTickCount; if Assigned(fBeforeOpenIDataset) then fBeforeOpenIDataset(Self); end; function TDADataTable.Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; begin result := fDataset.Lookup(KeyFields, KeyValues, ResultFields); end; function TDADataTable.GetIsEmpty: boolean; begin result := fDataset.IsEmpty; end; function TDADataTable.GetMasterParamsMappings: TStrings; begin result := fMasterParamsMappings end; procedure TDADataTable.SetMasterParamsMappings(const Value: TStrings); begin fMasterParamsMappings.Assign(Value); end; function TDADataTable.GetLogicalName: string; begin result := fLogicalName; end; function TDADataTable.GetReadOnly: boolean; begin result := FALSE; end; procedure TDADataTable.SetReadOnly(const Value: boolean); begin // By default this property cannot be set. Raising exceptions creates problems // at design time and it's useless end; procedure TDADataTable.SetScriptCode(const Value: TStrings); begin fScriptCode.Assign(Value); end; procedure TDADataTable.CallScript(const aEvent: string); begin if Assigned(ScriptingProvider) and (ScriptCode.Count > 0) then begin (ScriptingProvider as IDADataTableScriptingProvider).RunDataTableScript(self, ScriptCode.Text, aEvent, rslPascalScript); end; end; function TDADataTable.FindField(const aName: string): TDAField; begin result := fFields.FindField(aName); end; procedure TDADataTable.AddRecord(const FieldNames: array of string; const FieldValues: array of Variant); var i : integer; begin Insert; for i := 0 to Length(FieldNames)-1 do FieldByName(FieldNames[i]).Value := FieldValues[i]; Post; end; procedure TDADataTable.SetLogicalName(aName: string); begin fLogicalName := aName; end; function TDADataTable.GetDeltaInitialized: boolean; begin result := fDelta<>NIL end; procedure TDADataTable.NotifyFieldsClear; var i, lLockCount: integer; begin // This method patches VCL issue with notification // of datasources when clearing fields and controls is disabled lLockCount := 0; while DataSet.ControlsDisabled do begin inc(lLockCount); DataSet.EnableControls; end; TDataSetHack(DataSet).DataEvent(deFieldListChange, 0); for i := 0 to lLockCount - 1 do begin DataSet.DisableControls; end; end; function TDADataTable.GetOnAfterOpen: TDAAfterOpenDatasetEvent; begin result := fAfterOpenIDataset; end; function TDADataTable.GetOnBeforeOpen: TDABeforeOpenDatasetEvent; begin result := fBeforeOpenIDataset; end; procedure TDADataTable.SetOnAfterOpen( const Value: TDAAfterOpenDatasetEvent); begin fAfterOpenIDataset := Value; end; procedure TDADataTable.SetOnBeforeOpen( const Value: TDABeforeOpenDatasetEvent); begin fBeforeOpenIDataset := Value; end; function TDADataTable.GetOnAfterExecute: TDAAfterExecuteCommandEvent; begin NotSupported(); end; function TDADataTable.GetOnBeforeExecute: TDABeforeExecuteCommandEvent; begin NotSupported(); end; procedure TDADataTable.SetOnAfterExecute( const Value: TDAAfterExecuteCommandEvent); begin NotSupported(); end; procedure TDADataTable.SetOnBeforeExecute( const Value: TDABeforeExecuteCommandEvent); begin NotSupported(); end; function TDADataTable.GetOnExecuteError: TDAExecuteCommandErrorEvent; begin NotSupported(); end; function TDADataTable.GetOnOpenError: TDAOpenDatasetErrorEvent; begin NotSupported(); end; procedure TDADataTable.SetOnExecuteError( const Value: TDAExecuteCommandErrorEvent); begin NotSupported(); end; procedure TDADataTable.SetOnOpenError( const Value: TDAOpenDatasetErrorEvent); begin NotSupported(); end; function TDADataTable.GetCurrRecId: integer; begin result := fCurrRecId; end; procedure TDADataTable.SetCurrRecId(const Value: integer); begin fCurrRecId := Value; end; function TDADataTable.GetAutoIncs: TAutoIncArray; begin result := fAutoIncs; end; procedure TDADataTable.SetAutoIncs(const Value: TAutoIncArray); begin fAutoIncs := Value; end; function TDADataTable.CreateAutoIncArray: TAutoIncArray; var i: integer; begin SetLength(result, Fields.Count); for i := 0 to Fields.Count-1 do result[i] := -1; end; function TDADataTable.GetCurrentRecIdValue: integer; begin result := fCurrRecId; end; procedure TDADataTable.SetCurrentRecIdValue(Value: integer); begin fCurrRecId := Value; end; procedure TDADataTable.InternalAfterFieldUpdate(Sender: TDACustomField); begin if assigned(fAfterFieldChange) and (Sender is TDAField) then fAfterFieldChange(self, TDAField(Sender)); end; procedure TDADataTable.InternalBeforeFieldUpdate(Sender: TDACustomField); begin if assigned(fBeforeFieldChange) and (Sender is TDAField) then fBeforeFieldChange(self, TDAField(Sender)); end; procedure TDADataTable.InternalSetFetching(aFetching: boolean); begin fFetching := aFetching; end; procedure TDADataTable.SetCustomAttributes(const Value: TStrings); begin fCustomAttributes.Assign(Value); end; function TDADataTable.Local_ApplyUpdates(RefetchAll: boolean): boolean; function UnpackDeltas(var lStruct: TDADeltaStruct): TDABusinessProcessor; var j: integer; lBizProc: TDABusinessProcessor; lDetails: TDADatasetRelationshipList; lFound: boolean; begin result := nil; lStruct := nil; // Reads the deltas. lFound := false; { Tries to locate a user-defined business processor } if LocalSchema.Owner <> nil then for j := 0 to (LocalSchema.Owner.ComponentCount - 1) do begin if (LocalSchema.Owner.Components[j] is TDABusinessProcessor) then begin lBizProc := TDABusinessProcessor(LocalSchema.Owner.Components[j]); if SameText(lBizProc.ReferencedDataset, Self.LogicalName) then begin lStruct := TDADeltaStruct.Create(Self.Delta, lBizProc); lFound := true; Break; end; end; end; { Either creates one} if not lFound then begin lBizProc := TDABusinessProcessor.Create(nil); lBizProc.ReferencedDataset := Self.LogicalName; lBizProc.Schema := LocalSchema; Result := lBizProc; lStruct := TDADeltaStruct.Create(Self.Delta, lBizProc); end; { Sets the master/detail relationships } if (LocalSchema.RelationShips.Count > 0) then begin lDetails := TDADatasetRelationshipList.Create; try LocalSchema.RelationShips.GetDetails(lStruct.BusinessProcessor.ReferencedDataset, lDetails); if (lDetails.Count <> 0) then begin { Prepares an array with the references to the detail deltas that will be used later on to adjust autoincs, etc. } for j := 0 to lDetails.Count - 1 do begin if lDetails[j].DetailDatasetName = LogicalName then begin lStruct.DetailDeltas.Add(lStruct.Delta); lStruct.RelationShips.Add(lDetails[j]); end; end; end; finally lDetails.Free; end; end; end; var FLocalConnection: IDAConnection; lProcessedDeltas: TStringList; lStruct: TDADeltaStruct; lBizProc: TDABusinessProcessor; i, j: integer; begin Result:=False; CheckProperties; FLocalConnection := LocalSchema.ConnectionManager.NewConnection(LocalConnection); if (Delta = nil) or (Delta.Count = 0) then Exit; lBizProc := UnpackDeltas(lStruct); try {if TriggerTransactionEvent(fOnUpdateDataBeginTransaction) then} FLocalConnection.BeginTransaction; try if (LocalSchema.UpdateRules.Count = 0) then begin lStruct.BusinessProcessor.ProcessDelta(FLocalConnection, lStruct.Delta, AllChanges); end else begin lProcessedDeltas := TStringList.Create; try for i := 0 to (LocalSchema.UpdateRules.Count - 1) do begin // Processes them in the order defined in the schema if LocalSchema.UpdateRules[i].DatasetName = LogicalName then begin // Adds the dataset name to the list of processed deltas. Those that don't have update rules will be processed later lProcessedDeltas.Add(LogicalName); // Processes the delta lStruct.BusinessProcessor.ProcessDelta(FLocalConnection, lStruct.Delta, LocalSchema.UpdateRules[i].ChangeTypes); if (ctInsert in LocalSchema.UpdateRules[i].ChangeTypes) then begin for j := 0 to (lStruct.DetailDeltas.Count - 1) do lStruct.BusinessProcessor.SynchronizeAutoIncs(lStruct.Delta, lStruct.DetailDeltas[j], lStruct.RelationShips[j]); end; end; end; // Processes the deltas for which update rules were not defined if lProcessedDeltas.IndexOf(LogicalName) = -1 then lStruct.BusinessProcessor.ProcessDelta(FLocalConnection, lStruct.Delta, AllChanges); finally lProcessedDeltas.Free; end; end; if FLocalConnection.InTransaction {and TriggerTransactionEvent(fOnUpdateDataCommitTransaction)} then FLocalConnection.CommitTransaction; MergeDelta; Result:=True; except on E: Exception do begin if FLocalConnection.InTransaction {and TriggerTransactionEvent(fOnUpdateDataRollBackTransaction)} then FLocalConnection.RollbackTransaction; raise; end; end; finally if lStruct <> nil then lStruct.Free; if lBizProc <> nil then lBizProc.Free; end; if RefetchAll and result then begin if Active then Close; Open; end; end; procedure TDADataTable.GetDetailTablesforAllinOneFetch(aRemote, aLocal:TList; aRecursive: boolean); var i: integer; dt: TDADataTable; dtList: TList; scc: IDASimpleClonedCursorsSupport; begin if (moAllInOneFetch in fMasterOptions) then begin dtList:=GetDetailDataTables; try for i := 0 to dtList.Count-1 do begin dt := TDADataTable(dtList[i]); if (dtIncludeInAllInOneFetch in dt.DetailOptions) then begin if (dt.QueryInterface(IDASimpleClonedCursorsSupport, scc) = S_OK) and (scc.GetSimpleCloneSource <> nil) then begin dt:= TDADatatable(scc.GetSimpleCloneSource); end; if self.RemoteFetchEnabled and dt.RemoteFetchEnabled and (dt.RemoteDataAdapter = Self.RemoteDataAdapter) then begin if aRemote.IndexOf(dt) = -1 then aRemote.Add(dt); end else begin if aLocal.IndexOf(dt) = -1 then aLocal.Add(dt); end; if aRecursive then dt.GetDetailTablesforAllinOneFetch(aRemote,aLocal, aRecursive); end; end; finally dtList.Free; end; end end; function TDADataTable.GetDetailTablesforApplyUpdate(aRecursive: boolean): TList; var i: integer; dt: TDADataTable; dtList, dtlist1: TList; scc: IDASimpleClonedCursorsSupport; begin Result:= TList.Create; if (moCascadeApplyUpdates in fMasterOptions) then begin dtList:=GetDetailDataTables; try for i := 0 to dtList.Count-1 do begin dt := TDADataTable(dtList[i]); if dt.Active and (dtCascadeApplyUpdates in dt.DetailOptions) then begin if (dt.QueryInterface(IDASimpleClonedCursorsSupport, scc) = S_OK) and (scc.GetSimpleCloneSource <> nil) then begin dt:= TDADatatable(scc.GetSimpleCloneSource); end; if Result.IndexOf(dt) = -1 then Result.Add(dt); if aRecursive then begin dtlist1:= dt.GetDetailTablesforApplyUpdate(aRecursive); try Result.Assign(dtlist1,laOr); finally dtlist1.Free; end; end; end; end; finally dtList.Free; end; end end; procedure TDADataTable.CancelUpdateChange(Change: TDADeltaChange;IncludeDetails : boolean = TRUE); var orignextinc : integer; wasfiltered, remotefetch : boolean; lOldMasterFields: string; details: TList; i,j,k: integer; detailChange: TDADeltaChange; ChangePKValueArray: array of Variant; lNeedDeleteChange: boolean; keyvalue: variant; begin if Editing then Cancel; if not LogChanges then Exit; DisableControls; wasfiltered := Filtered; Filtered := FALSE; try // Truns off the remote fetching for this datatable and its details remotefetch := RemoteFetchEnabled; RemoteFetchEnabled := FALSE; // Disable the log of changes (we're about to make a bunch!) LogChanges := FALSE; // Saves the current recinc (we'll change this during the restore) orignextinc := CurrRecId; try lOldMasterFields := MasterFields; MasterFields := ''; try // Reverts the records to the original state if IncludeDetails then begin SetLength(ChangePKValueArray,Change.Delta.KeyFieldCount); For i:=1 to Change.Delta.KeyFieldCount do begin if Change.ChangeType = ctInsert then keyvalue:=Change.NewValueByName[Change.Delta.KeyFieldNames[i-1]] else keyvalue:=Change.OldValueByName[Change.Delta.KeyFieldNames[i-1]]; ChangePKValueArray[0]:=keyvalue; end; details:=GetDetailTablesforApplyUpdate(False); try for i:=0 to details.Count-1 do begin for j:=0 to TDADataTable(details[i]).Delta.Count-1 do begin detailChange :=TDADataTable(details[i]).Delta.Changes[j]; if detailChange.Status <> csResolved then begin lNeedDeleteChange:= True; for k:=0 to Change.Delta.KeyFieldCount-1 do begin if detailChange.ChangeType = ctInsert then keyvalue:=detailChange.NewValueByName[Change.Delta.KeyFieldNames[k]] else keyvalue:=detailChange.oldValueByName[Change.Delta.KeyFieldNames[k]]; if not VarSameValue(keyValue, ChangePKValueArray[k]) then begin lNeedDeleteChange:= False; Break; end; end; if lNeedDeleteChange then TDADataTable(details[i]).CancelUpdateChange(detailChange,IncludeDetails); end; end; end; finally details.Free; end; end; InternalCancelUpdateChange(change); Delta.RemoveChange(change); finally if Delta.Count = 0 then fHasReducedDelta:=False; MasterFields := lOldMasterFields; end; finally CurrRecId := orignextinc; LogChanges := TRUE; RemoteFetchEnabled := remotefetch; end; finally Filtered := wasfiltered; EnableControls; end; end; procedure TDADataTable.InternalCancelUpdateChange(Change: TDADeltaChange); var i, x : integer; fldname : string; fldvalue : Variant; details: TList; RecID:string; begin case Change.ChangeType of ctDelete : begin CurrRecId := change.RecID; // We want the same autoinc regenerated RecID:=IntToStr(Change.RecID); Insert; for x := 0 to (Delta.LoggedFieldCount-1) do begin fldname := Delta.LoggedFieldNames[x]; fldvalue := change.OldValues[x]; VariantToFieldValue(fldValue, FieldByName(fldname)); end; Post; details := GetDetailDataTables; try for x := 0 to (details.Count-1) do begin i:=TDADataTable(details[x]).fFetchedMasters.IndexOf(RecID); if i<>-1 then TDADataTable(details[x]).fFetchedMasters.Delete(i); end; finally details.Free; end; end; else begin if not Locate(RecIDFieldName, change.RecID, []) then RaiseError('Couldn''t find record #'+FormatRecIDString(change.RecID)); if (change.ChangeType=ctInsert) then Delete else begin Edit; for x := 0 to (Delta.LoggedFieldCount-1) do begin fldname := Delta.LoggedFieldNames[x]; fldvalue := change.OldValues[x]; if fHasReducedDelta and ROVariantsEqual(fldvalue, change.NewValues[x]) then Continue; VariantToFieldValue(fldValue, FieldByName(fldname)); end; Post; end; end; end; end; procedure TDADataTable.CheckProperties(ACheckRemoteFetching: Boolean=False); begin if LogicalName = '' then raise Exception.Create(Name+'.LogicalName must be specified.'); if RemoteFetchEnabled or ACheckRemoteFetching then begin Check(RemoteDataAdapter = nil, Name+'.RemoteDataAdapter must be assigned.'); end else begin Check(LocalDataStreamer = nil , Name+'.LocalDataStreamer must be assigned.'); Check(LocalSchema = nil, Name+'.LocalSchema must be assigned.'); LocalSchema.CheckProperties; end; end; procedure TDADataTable.ExpessionEvaluatorGetValue( Sender: TDAExpressionEvaluator; const aIdentifier: string; out aValue: Variant); begin aValue := Fields.FieldByName(aIdentifier).Value; end; function TDADataTable.GetDynamicWhere: TDAWhereBuilder; begin Result := fDynamicWhere; end; procedure TDADataTable.SetDynamicWhere(const Value: TDAWhereBuilder); begin if Value <> nil then FDynamicWhere.Xml := Value.Xml else FDynamicWhere.Clear; end; function TDADataTable.SQLContainsDynamicWhere: boolean; begin Result:=False; // Not implemented in DataTables end; { TDADataSource } constructor TDADataSource.Create(aOwner: TComponent); begin inherited; end; destructor TDADataSource.Destroy; begin inherited; end; function TDADataSource.GetActive: boolean; begin result := (fDataTable <> nil) and fDataTable.Active end; function TDADataSource.GetDataset: TDataset; begin result := nil; end; function TDADataSource.GetOpening: boolean; begin result := (fDataTable <> nil) and fDataTable.Opening end; procedure TDADataSource.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if (AComponent = fDataTable) then begin fDataTable := nil; inherited Dataset := nil; end; end; procedure TDADataSource.SetDataset(const Value: TDataset); begin end; procedure TDADataSource.SetDataTable(const Value: TDADataTable); begin fDataTable := Value; if (fDataTable <> nil) then begin fDataTable.FreeNotification(Self); inherited Dataset := fDataTable.Dataset; end else inherited Dataset := nil; end; { TDABusinessRules } constructor TDABusinessRules.Create; begin inherited; end; destructor TDABusinessRules.Destroy; begin inherited; end; function TDABusinessRules._AddRef: Integer; begin result := -1; end; function TDABusinessRules._Release: Integer; begin result := -1; end; { TDADataTableRules } constructor TDADataTableRules.Create(aDataTable: TDADataTable); begin inherited Create; Check(not Assigned(aDatatable), 'DataTable cannot be NIL'); fDetails := TStringList.Create; fDetails.Sorted := TRUE; fDetails.Duplicates := dupError; fDataTable := aDataTable; end; destructor TDADataTableRules.Destroy; begin fDetails.Free; inherited; end; procedure TDADataTableRules.AfterCancel(Sender: TDADataTable); begin end; procedure TDADataTableRules.AfterClose(Sender: TDADataTable); begin end; procedure TDADataTableRules.AfterDelete(Sender: TDADataTable); begin end; procedure TDADataTableRules.AfterEdit(Sender: TDADataTable); begin end; procedure TDADataTableRules.AfterInsert(Sender: TDADataTable); begin end; procedure TDADataTableRules.AfterOpen(Sender: TDADataTable); begin end; procedure TDADataTableRules.AfterPost(Sender: TDADataTable); begin end; procedure TDADataTableRules.AfterRefresh(Sender: TDADataTable); begin end; procedure TDADataTableRules.AfterScroll(Sender: TDADataTable); begin end; procedure TDADataTableRules.BeforeCancel(Sender: TDADataTable); begin end; procedure TDADataTableRules.BeforeClose(Sender: TDADataTable); begin end; procedure TDADataTableRules.BeforeDelete(Sender: TDADataTable); begin end; procedure TDADataTableRules.BeforeEdit(Sender: TDADataTable); begin end; procedure TDADataTableRules.BeforeInsert(Sender: TDADataTable); begin end; procedure TDADataTableRules.BeforeOpen(Sender: TDADataTable); begin end; procedure TDADataTableRules.BeforePost(Sender: TDADataTable); begin end; procedure TDADataTableRules.BeforeRefresh(Sender: TDADataTable); begin end; procedure TDADataTableRules.BeforeScroll(Sender: TDADataTable); begin end; procedure TDADataTableRules.OnCalcFields(Sender: TDADataTable); begin end; procedure TDADataTableRules.OnNewRecord(Sender: TDADataTable); begin end; procedure TDADataTableRules.OnDeleteError(DataTable: TDADataTable; Error: EDatabaseError; var Action: TDataAction); begin end; procedure TDADataTableRules.OnEditError(DataTable: TDADataTable; Error: EDatabaseError; var Action: TDataAction); begin end; procedure TDADataTableRules.Attach(aDataTable: TDADataTable); begin RefreshDetails; end; procedure TDADataTableRules.Detach(aDataTable: TDADataTable); begin fDetails.Clear; end; procedure TDADataTableRules.Append; begin fDataTable.Append(); end; procedure TDADataTableRules.Cancel; begin fDataTable.Cancel(); end; procedure TDADataTableRules.Delete; begin fDataTable.Delete(); end; procedure TDADataTableRules.Edit; begin fDataTable.Edit(); end; procedure TDADataTableRules.First; begin fDataTable.First(); end; procedure TDADataTableRules.Insert; begin fDataTable.Insert(); end; procedure TDADataTableRules.Last; begin fDataTable.Last(); end; procedure TDADataTableRules.Next; begin fDataTable.Next(); end; procedure TDADataTableRules.Post; begin fDataTable.Post(); end; procedure TDADataTableRules.Prior; begin fDataTable.Prior(); end; function TDADataTableRules.GetBOF: Boolean; begin result := fDataTable.BOF; end; function TDADataTableRules.GetEOF: Boolean; begin result := fDataTable.EOF; end; function TDADataTableRules.GetRecordCount: Integer; begin result := fDataTable.RecordCount; end; function TDADataTableRules.Locate(const aKeyFields: String; const aKeyValues: Variant; aOptions: TLocateOptions = []): boolean; begin result := fDataTable.Locate(aKeyFields, aKeyValues, aOptions); end; function TDADataTableRules.GetDetails(Index: integer): TDADataTable; begin result := TDADataTable(fDetails[Index]) end; function TDADataTableRules.GetDetailsCount: integer; begin result := fDetails.Count end; function TDADataTableRules.FindDetail( const aLogicalName: string): TDADataTable; var i : integer; begin result := NIL; i := fDetails.IndexOf(aLogicalName); if (i>=0) then result := TDADataTable(fDetails.Objects[i]); end; function TDADataTableRules.DetailByName( const aLogicalName: string): TDADataTable; begin result := FindDetail(aLogicalName); if (result=NIL) then raise Exception.CreateFmt('Cannot find the detail DataTable %s ', [aLogicalName]); end; procedure TDADataTableRules.RefreshDetails; var lList : TList; i : integer; lLogicalName : string; begin lList := DataTable.GetDetailDataTables; fDetails.Clear; try for i := 0 to (lList.Count-1) do begin lLogicalName := TDADataTable(lList[i]).LogicalName; if (lLogicalName<>'') then fDetails.AddObject(lLogicalName, lList[i]); end; finally lList.Free; end; end; function TDADataTableRules.GetDetailOptions: TDADetailOptions; begin result := DataTable.DetailOptions end; function TDADataTableRules.GetMasterOptions: TDAMasterOptions; begin result := DataTable.MasterOptions end; procedure TDADataTableRules.SetDetailOptions(Value: TDADetailOptions); begin DataTable.DetailOptions := Value end; procedure TDADataTableRules.SetMasterOptions(Value: TDAMasterOptions); begin DataTable.MasterOptions := Value end; function TDADataTableRules.GetRecNo: integer; begin result := fDataTable.RecNo end; procedure TDADataTableRules.SetRecNo(Value: integer); begin fDataTable.RecNo := Value end; procedure TDADataTableRules.OnFilterRecord(DataTable: TDADataTable; var Accept: boolean); begin end; procedure TDADataTableRules.OnPostError(DataTable: TDADataTable; Error: EDatabaseError; var Action: TDataAction); begin end; function TDADataTableRules.Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; begin result := fDataTable.Lookup(KeyFields, KeyValues, ResultFields); end; function TDADataTableRules.GetIsEmpty: boolean; begin result := fDataTable.IsEmpty end; function TDADataTableRules.GetState: TDatasetState; begin result := fDataTable.State end; function TDADataTableRules.IsFieldNull( const FieldIndexOrName: Variant): boolean; var fld : TDAField; begin case VarType(FieldIndexOrName) of varString, varOleStr, varStrArg : fld := DataTable.FieldByName(VarToStr(FieldIndexOrName)); else fld := DataTable.Fields[FieldIndexOrName]; end; result := fld.IsNull; end; procedure TDADataTableRules.ClearField(const FieldIndexOrName: Variant); var fld : TDAField; begin case VarType(FieldIndexOrName) of varString, varOleStr, varStrArg : fld := DataTable.FieldByName(VarToStr(FieldIndexOrName)); else fld := DataTable.Fields[FieldIndexOrName]; end; fld.Clear; end; function TDADataTableRules.GetDataTable: TDADataTable; begin result := fDataTable; end; procedure TDADataTableRules.ApplyRange; begin (fDataTable as IDARangeController).ApplyRange end; procedure TDADataTableRules.CancelRange; begin (fDataTable as IDARangeController).CancelRange end; procedure TDADataTableRules.EditRangeEnd; begin (fDataTable as IDARangeController).EditRangeEnd end; procedure TDADataTableRules.EditRangeStart; begin (fDataTable as IDARangeController).EditRangeStart end; procedure TDADataTableRules.SetRange(const StartValues, EndValues: array of const); begin (fDataTable as IDARangeController).SetRange(StartValues, EndValues); end; procedure TDADataTableRules.SetRangeEnd; begin (fDataTable as IDARangeController).SetRangeEnd end; procedure TDADataTableRules.SetRangeStart; begin (fDataTable as IDARangeController).SetRangeStart end; procedure TDADataTableRules.Close; begin fDataTable.Close; end; procedure TDADataTableRules.Open; begin fDataTable.Open; end; function TDADataTableRules.GetActive: boolean; begin result := fDataTable.Active; end; procedure TDADataTableRules.SetActive(const Value: boolean); begin fDataTable.Active := Value; end; procedure TDADataTableRules.OnAfterApplyUpdates(DataTable: TDADataTable); begin end; procedure TDADataTableRules.OnAfterDataRequestCall(DataTable: TDADataTable; Request: TDARemoteRequest); begin end; procedure TDADataTableRules.OnAfterDataUpdateCall(DataTable: TDADataTable; Request: TDARemoteRequest); begin end; procedure TDADataTableRules.OnAfterMergeDelta(DataTable: TDADataTable); begin end; procedure TDADataTableRules.OnAfterSchemaCall(DataTable: TDADataTable; Request: TDARemoteRequest); begin end; procedure TDADataTableRules.OnAfterScriptCall(DataTable: TDADataTable; Request: TDARemoteRequest); begin end; procedure TDADataTableRules.OnBeforeApplyUpdates(DataTable: TDADataTable; const Delta: IDADelta); begin end; procedure TDADataTableRules.OnBeforeDataRequestCall( DataTable: TDADataTable; Request: TDARemoteRequest); begin end; procedure TDADataTableRules.OnBeforeDataUpdateCall(DataTable: TDADataTable; Request: TDARemoteRequest); begin end; procedure TDADataTableRules.OnBeforeMergeDelta(DataTable: TDADataTable); begin end; procedure TDADataTableRules.OnBeforeSchemaCall(DataTable: TDADataTable; Request: TDARemoteRequest); begin end; procedure TDADataTableRules.OnBeforeScriptCall(DataTable: TDADataTable; Request: TDARemoteRequest); begin end; procedure TDADataTableRules.OnReceiveDataStream(DataTable: TDADataTable; Stream: TStream); begin end; { TDAFieldRules } constructor TDAFieldRules.Create(aField : TDAField; aDataTable : TDADataTable); begin inherited Create; fDataTable := aDataTable; fField := aField; fField.OnValidate := OnValidate; fField.OnChange := OnChange; Attach(fDataTable); end; destructor TDAFieldRules.Destroy; begin Detach(fDataTable); inherited; end; procedure TDAFieldRules.Attach(aDataTable: TDADataTable); begin end; procedure TDAFieldRules.Detach(aDataTable: TDADataTable); begin end; procedure TDAFieldRules.OnChange(Sender: TDACustomField); begin end; procedure TDAFieldRules.OnValidate(Sender: TDACustomField); begin end; { TDADataTableList } constructor TDADataTableList.Create(aOwnerComponent: TComponent); begin inherited Create; ScanAndAdd(aOwnerComponent); end; function TDADataTableList.Add(aDataTable: TDADataTable): integer; begin result := inherited Add(aDataTable); end; function TDADataTableList.GetItems(Index: integer): TDADataTable; begin result := TDADataTable(inherited Items[Index]); end; procedure TDADataTableList.Remove(aDataTable: TDADataTable); begin inherited Remove(aDataTable); end; function TDADataTableList.ScanAndAdd(aOwnerComponent: TComponent): integer; var i : integer; begin result := 0; with aOwnerComponent do begin for i := 0 to (Count-1) do if (Components[i] is TDADataTable) then begin Add(TDADataTable(Components[i])); Inc(result); end; end; end; function TDADataTableList.GetPendingChangeCount: integer; var i : integer; begin result := 0; for i := 0 to (Count-1) do if Items[i].Active and Items[i].LogChanges then Inc(result, Items[i].Delta.Count); end; { TDABaseRemoteDataAdapter } function TDABaseRemoteDataAdapter.Get_GetDataCall: TDARemoteRequest; begin result := nil; end; function TDABaseRemoteDataAdapter.Get_GetSchemaCall: TDARemoteRequest; begin result := nil; end; function TDABaseRemoteDataAdapter.Get_GetScriptsCall: TDARemoteRequest; begin result := nil; end; function TDABaseRemoteDataAdapter.Get_UpdateDataCall: TDARemoteRequest; begin result := nil; end; initialization RegisterExceptionClass(EDABizValidationException); _bizfields := TStringList.Create; _bizfields.Sorted := TRUE; _bizdatatables := TStringList.Create; _bizdatatables.Sorted := TRUE; finalization UnregisterExceptionClass(EDABizValidationException); _bizdatatables.Free; _bizfields.Free; end.