unit uDARemoteDataAdapter; {----------------------------------------------------------------------------} { 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, uRODynamicRequest, uRORemoteService, uDAInterfaces, uDAClasses, uDADataStreamer, uDADataTable, uDADelta, uDARemoteDataAdapterRequests, DataAbstract4_Intf; type TDARequestEvent = procedure(Sender: TObject; Request: TRODynamicRequest) of object; TDAApplyUpdatesEvent = procedure(Sender: TObject; aTable: TDADataTable; const Delta: IDADelta) of object; TDAFailureBehavior = (fbNone, fbRaiseException, fbShowReconcile, fbBoth); TDABeforeProcessFailuresEvent = procedure(Sender: TObject; aTablesList: TList; aFailedDeltas: TList; var aFailureBehavior: TDAFailureBehavior) of object; TDAOnGenerateRecordMessage = procedure(Sender: TObject; aChange: TDADeltaChange; ADatatable: TDADataTable; var aMessage: string) of object; TDAReconcileDialogAction = (rdlgNone,rdlgSkip,rdlgCancel); TDAShowReconcileRecordInAppUIEvent = procedure(Sender: TObject; aChange: TDADeltaChange; aDatatable: TDADataTable; var aHandled: Boolean; var aAction: TDAReconcileDialogAction) of object; TDAShowReconcleDialogEvent = procedure(Sender: TObject; var AFailedDeltaList: TList; aTableList: TList; var aHandled: boolean) of object; { TDARemoteDataAdapter } TDARemoteDataAdapter = class(TDABaseRemoteDataAdapter) private fGetDataCall: TDAGetDataRequest; fGetSchemaCall: TDAGetSchemaRequest; fUpdateDataCall: TDAUpdateDataRequest; fGetScriptsCall: TDAGetScriptsRequest; fRemoteService: TRORemoteService; fDataStreamer: TDADataStreamer; fSchema: TDASchema; fCacheSchema: boolean; fBeforeGetDataCall, fAfterGetDataCall, fBeforeGetSchemaCall, fAfterGetSchemaCall, fBeforeGetScriptsCall, fAfterGetScriptsCall, fBeforeUpdateDataCall, fAfterUpdateDataCall: TDARequestEvent; fBeforeApplyUpdates, fAfterApplyUpdates: TDAApplyUpdatesEvent; fBeforeProcessFailures: TDABeforeProcessFailuresEvent; fAutoFillScripts: Boolean; FFailureBehavior: TDAFailureBehavior; FOnGenerateRecordMessage: TDAOnGenerateRecordMessage; fOnShowReconcleRecordInAppUI: TDAShowReconcileRecordinAppUIEvent; fOnShowReconcleDialog: TDAShowReconcleDialogEvent; FDynamicSelect: Boolean; procedure SetCacheSchema(const Value: boolean); function CreateTableRequestInfo(aTable: TDADataTable; aIncludeSchema: boolean; aDynamicWhereExpression: TDAWhereExpression = nil): TableRequestInfo; procedure DoGetSchemaCall; function GetSchema: TDASchema; procedure FillTableNamesParam(aTables: array of TDADataTable; aParam: TRORequestParam); procedure SetDataStreamer(const Value: TDADataStreamer); procedure SetRemoteService(const Value: TRORemoteService); procedure FillTableParams(aTables: array of TDADataTable; aParam: TRORequestParam); procedure ThrowFailures(ATableList,AFailedDeltas:TList); protected procedure Notification(AComponent: TComponent; Operation: TOperation); override; function GetDataStreamer: TDADataStreamer; override; procedure Loaded; override; { backward compatibility: to provide access to these in the legacy events in TDADataTable} function Get_GetSchemaCall: TDARemoteRequest; override; function Get_GetDataCall: TDARemoteRequest; override; function Get_UpdateDataCall: TDARemoteRequest; override; function Get_GetScriptsCall: TDARemoteRequest; override; public constructor Create(aOwner: TComponent); override; destructor Destroy; override; procedure SetupDefaultRequestV3; procedure SetupDefaultRequest; procedure CheckProperties; function ApplyUpdates(aTables: array of TDADataTable; aRefetchAll: boolean = false): boolean; override; procedure Fill(aTables: array of TDADataTable; aSaveCursor: boolean=false; aIncludeSchema: boolean=false); overload; override; procedure Fill(aTables: array of TDADataTable; aTableRequestInfoArray: array of TableRequestInfo; aSaveCursor: boolean=false; aIncludeSchema: boolean=false); overload; override; procedure Fill(aTables: array of TDADataTable; aWhereClauses : array of TDAWhereExpression; aSaveCursor: boolean=false; aIncludeSchema: boolean=false); overload; override; procedure FillSchema(aTables: array of TDADataTable; aPreserveLookupFields: boolean = false; aPreserveClientCalcFields : boolean = false); override; procedure FillScripts(aTables: array of TDADataTable); override; function ReadSchema(aForceReRead: boolean = false): TDASchema; procedure FlushSchema; property Schema: TDASchema read GetSchema; published property GetSchemaCall: TDAGetSchemaRequest read fGetSchemaCall; property GetDataCall: TDAGetDataRequest read fGetDataCall; property UpdateDataCall: TDAUpdateDataRequest read fUpdateDataCall; property GetScriptsCall: TDAGetScriptsRequest read fGetScriptsCall; property RemoteService: TRORemoteService read fRemoteService write SetRemoteService; property DataStreamer: TDADataStreamer read fDataStreamer write SetDataStreamer; property CacheSchema: boolean read fCacheSchema write SetCacheSchema default false; property AutoFillScripts: Boolean read fAutoFillScripts write fAutoFillScripts default false; property BeforeGetDataCall: TDARequestEvent read fBeforeGetDataCall write fBeforeGetDataCall; property AfterGetDataCall: TDARequestEvent read fAfterGetDataCall write fAfterGetDataCall; property BeforeGetSchemaCall: TDARequestEvent read fBeforeGetSchemaCall write fBeforeGetSchemaCall; property AfterGetSchemaCall: TDARequestEvent read fAfterGetSchemaCall write fAfterGetSchemaCall; property BeforeGetScriptsCall: TDARequestEvent read fBeforeGetScriptsCall write fBeforeGetScriptsCall; property AfterGetScriptsCall: TDARequestEvent read fAfterGetScriptsCall write fAfterGetScriptsCall; property BeforeUpdateDataCall: TDARequestEvent read fBeforeUpdateDataCall write fBeforeUpdateDataCall; property AfterUpdateDataCall: TDARequestEvent read fAfterUpdateDataCall write fAfterUpdateDataCall; property BeforeApplyUpdates: TDAApplyUpdatesEvent read fBeforeApplyUpdates write fBeforeApplyUpdates; property AfterApplyUpdates: TDAApplyUpdatesEvent read fAfterApplyUpdates write fAfterApplyUpdates; property BeforeProcessFailures: TDABeforeProcessFailuresEvent read fBeforeProcessFailures write fBeforeProcessFailures; property FailureBehavior: TDAFailureBehavior read FFailureBehavior write FFailureBehavior default fbBoth; property OnGenerateRecordMessage: TDAOnGenerateRecordMessage read FOnGenerateRecordMessage write FOnGenerateRecordMessage; property OnShowReconcleDialog:TDAShowReconcleDialogEvent read fOnShowReconcleDialog write fOnShowReconcleDialog; property OnShowReconcileRecordInAppUI: TDAShowReconcileRecordInAppUIEvent read fOnShowReconcleRecordInAppUI write fOnShowReconcleRecordInAppUI; property DynamicSelect: Boolean read FDynamicSelect write FDynamicSelect default False; end; implementation uses SysUtils, DB, TypInfo, Variants, uRODL, uROTypes, uROXMLIntf, uROClasses, uDAReconcileDialog; { TDARemoteDataAdapter } procedure TDARemoteDataAdapter.FillTableNamesParam(aTables: array of TDADataTable; aParam: TRORequestParam); var lArray: StringArray; i: integer; begin case aParam.DataType of rtString: begin // v3 style string if Length(aTables) <> 1 then raise Exception.Create('The current GetDataCall configuration does not allow fetching multiple data tables at once.'); aParam.AsString := aTables[Low(aTables)].LogicalName; end; rtUserDefined: begin // v4 style string array lArray := StringArray.Create(); lArray.Resize(Length(aTables)); for i := Low(aTables) to High(aTables) do lArray[i-Low(aTables)] := AnsiToUtf8(aTables[i].LogicalName); aParam.AsComplexType := lArray; aParam.OwnsComplexType := true; end; end; end; type TDATableOptions = record // Fill Bookmark: TBookMark; GoFirst, OldLogChanges: boolean; OldPos: cardinal; // FillSchema FieldHandlers : TStringList; end; procedure TDARemoteDataAdapter.FillTableParams( aTables: array of TDADataTable; aParam: TRORequestParam); var lArray: DataParameterArray; lParam: DataParameter; lTable: TDADataTable; j: integer; lList: TStringList; begin lArray:=nil; // prevert "W1036 Variable 'lArray' might not have been initialized" case aParam.DataType of rtString: begin // v3 style string if Length(aTables) <> 1 then raise Exception.Create('The current GetDataCall configuration does not allow fetching multiple data tables'); with aTables[Low(aTables)].Params do begin if Count<>0 then begin lList:= TStringList.Create; try for j := 0 to Count - 1 do lList.Values[Params[j].Name]:=Params[j].AsString; aParam.AsString:= lList.Text; finally lList.Free; end; end; end; end; rtUserDefined: begin if aParam.TypeName = 'DataParameterArray' then lArray := DataParameterArray.Create(); lTable := aTables[Low(aTables)]; for j := 0 to lTable.Params.Count-1 do begin lParam := lArray.Add(); lParam.Name := AnsiToUtf8(lTable.Params[j].Name); lParam.Value := lTable.Params[j].Value; end; aParam.AsComplexType := lArray; aParam.OwnsComplexType := true; end; end; end; procedure TDARemoteDataAdapter.Fill(aTables: array of TDADataTable; aTableRequestInfoArray: array of TableRequestInfo; aSaveCursor: boolean=false; aIncludeSchema: boolean=false); var lSavedOptions: array of TDATableOptions; lHasTableNamesParameter: Boolean; lParam, lResultParam: TRORequestParam; i: integer; ltablearray: array of TDADataTable; ltableList: TList; llocalList: TList; ltbl: TDADataTable; lArray: TableRequestInfoArray; begin if Length(aTables) <> Length(aTableRequestInfoArray) then raise Exception.Create('aTables and aTableRequestInfoArray should contain equal members count.'); CheckProperties; ltableList := TList.Create; llocalList := TList.Create; lArray:= TableRequestInfoArray.Create; try try for i := Low(aTables) to High(aTables) do begin ltbl:=aTables[i]; if ltbl = nil then continue; if ltableList.IndexOf(ltbl) = -1 then ltableList.Add(ltbl); ltbl.GetDetailTablesforAllinOneFetch(ltableList,llocalList,True); end; SetLength(ltablearray,ltableList.Count); for i := 0 to ltableList.Count - 1 do ltablearray[i]:=TDADataTable(ltableList[i]); for i := 0 to High(ltablearray) do lArray.Add(nil); for i := 0 to High(aTableRequestInfoArray) do lArray.Items[ltableList.IndexOf(aTables[i])]:=aTableRequestInfoArray[i]; for i := 0 to lArray.Count-1 do if lArray.Items[i] = nil then lArray.Items[i]:= CreateTableRequestInfo(ltablearray[i],aIncludeSchema); finally ltableList.Free; llocalList.Free; end; SetLength(lSavedOptions, length(ltablearray)); try for i := 0 to High(ltablearray) do begin ltbl:= ltablearray[i]; lSavedOptions[i].OldLogChanges := ltbl.LogChanges; ltbl.LogChanges := false; ltbl.InternalSetFetching(true); if ltbl.Active then begin lSavedOptions[i].GoFirst := false; if aSaveCursor then lSavedOptions[i].Bookmark := ltbl.GetBookMark; end else begin lSavedOptions[i].GoFirst := true; end; end; try lParam := GetDataCall.Params.FindParam(GetDataCall.OutgoingTableNamesParameter); lHasTableNamesParameter := assigned(lParam); if lHasTableNamesParameter then FillTableNamesParam(ltablearray, lParam) else if Length(ltablearray) <> 1 then raise Exception.Create('The current GetDataCall configuration does not allow fetching multiple data tables'); if Length(GetDataCall.OutgoingTableRequestInfosParameter) > 0 then begin lParam := GetDataCall.Params.FindParam(GetDataCall.OutgoingTableRequestInfosParameter); if Assigned(lParam) then begin if (lParam.DataType = rtUserDefined) and (lParam.TypeName = 'TableRequestInfoArray') then begin lParam.AsComplexType := lArray; end; end; end; if (GetDataCall.OutgoingParamsParameter <> '') then begin // v3 style call lParam := GetDataCall.Params.FindParam(GetDataCall.OutgoingParamsParameter); if Assigned(lParam) then FillTableParams(ltablearray, lParam); end; if (GetDataCall.OutgoingMaxRecordsParameter <> '') then begin // v3 style call if Length(ltablearray) <> 1 then for i := 0 to High(ltablearray) do if ltablearray[i].MaxRecords <> -1 then raise Exception.Create('The current GetDataCall configuration does not allow fetching multiple data tables with a limited record count.'); lParam := GetDataCall.Params.FindParam(GetDataCall.OutgoingMaxRecordsParameter); if Assigned(lParam) and (Length(ltablearray) > 0) then lParam.AsInteger := ltablearray[0].MaxRecords; end; if (GetDataCall.OutgoingIncludeSchemaParameter <> '') then begin // v3 style call lParam := GetDataCall.Params.FindParam(GetDataCall.OutgoingIncludeSchemaParameter); if Assigned(lParam) then lParam.AsBoolean := aIncludeSchema; end; if Assigned(fBeforeGetDataCall) then fBeforeGetDataCall(Self, GetDataCall); GetDataCall.Execute(); lResultParam := GetDataCall.Params.FindParam(GetDataCall.IncomingDataParameter); if Assigned(fAfterGetDataCall) then fAfterGetDataCall(Self, GetDataCall); if not assigned(lResultParam) or (lResultParam.DataType <> rtBinary) then raise Exception.Create('Result parameter of GetDataCall is not properly defined.'); if not assigned(lResultParam.AsBinary) then raise Exception.Create('The server returned a nil buffer.'); {todo?: oldpos := lResultParam.AsBinary.Position; if Assigned(fOnAfterDataRequestCall) then fOnAfterDataRequestCall(Self, DataRequestCall); if Assigned(fOnReceiveDataStream) then fOnReceiveDataStream(Self, data); lResultParam.AsBinary.Position := oldpos;} // Reads the data DataStreamer.Initialize(lResultParam.AsBinary, aiRead); try // part 1 - reading schema for i := Low(ltablearray) to High(ltablearray) do begin //if aTables[i].Opening then begin ltbl:= ltablearray[i]; if lArray[i].IncludeSchema and not (soIgnoreStreamSchema in ltbl.StreamingOptions) then begin if not lHasTableNamesParameter and (DataStreamer.DatasetCount = 1) then DataStreamer.ReadDataset(DataStreamer.DatasetNames[0], ltbl, true, false) else DataStreamer.ReadDataset(ltbl.LogicalName, ltbl, true, false); end; if not ltbl.Active then ltbl.InitializeDataTable; //end; end; // part 2 - reading data for i := Low(ltablearray) to High(ltablearray) do begin ltbl:= ltablearray[i]; if not lHasTableNamesParameter and (DataStreamer.DatasetCount = 1) then DataStreamer.ReadDataset(DataStreamer.DatasetNames[0], ltbl, false, true) else DataStreamer.ReadDataset(ltbl.LogicalName, ltbl, false, true); if (moAllInOneFetch in ltbl.MasterOptions) then begin ltbl.DoCascadeOperation(DataStreamer, moAllInOneFetch); end; end; finally DataStreamer.Finalize; end; finally lParam := GetDataCall.Params.FindParam(GetDataCall.OutgoingTableRequestInfosParameter); if Assigned(lParam) then lParam.ClearValue; lParam := GetDataCall.Params.FindParam(GetDataCall.OutgoingParamsParameter); if Assigned(lParam) then lParam.ClearValue; lParam := GetDataCall.Params.FindParam(GetDataCall.IncomingDataParameter); if Assigned(lParam) then lParam.ClearValue; for i := 0 to High(ltablearray) do begin ltbl:= ltablearray[i]; if ltbl.Active then begin if lSavedOptions[i].GoFirst then begin ltbl.First; end else begin if aSaveCursor then begin ltbl.GotoBookmark(lSavedOptions[i].Bookmark); ltbl.FreeBookmark(lSavedOptions[i].Bookmark); end; end; end; ltbl.LogChanges := lSavedOptions[i].OldLogChanges; ltbl.InternalSetFetching(false); end; end; if fAutoFillScripts then FillScripts(ltablearray); finally SetLength(lSavedOptions,0); SetLength(ltablearray,0); end; finally lArray.Free; end; end; procedure TDARemoteDataAdapter.DoGetSchemaCall; begin //ToDo: handle aFilter parameter? if Assigned(fBeforeGetSchemaCall) then fBeforeGetSchemaCall(Self, GetSchemaCall); GetSchemaCall.Execute(); if Assigned(fAfterGetSchemaCall) then fAfterGetSchemaCall(Self, GetSchemaCall); end; procedure TDARemoteDataAdapter.Fill(aTables: array of TDADataTable; aSaveCursor: boolean=false; aIncludeSchema: boolean=false); var lTableRequestInfoArray: array of TableRequestInfo; i: integer; begin SetLength(lTableRequestInfoArray, Length(aTables)); for i := 0 to High(aTables) do lTableRequestInfoArray[i]:= CreateTableRequestInfo(aTables[i],aIncludeSchema); Fill(aTables, lTableRequestInfoArray, aSaveCursor, aIncludeSchema); end; procedure TDARemoteDataAdapter.Fill(aTables: array of TDADataTable; aWhereClauses: array of TDAWhereExpression; aSaveCursor, aIncludeSchema: boolean); var lTableRequestInfoArray: array of TableRequestInfo; i: integer; begin if Length(aTables) <> Length(aWhereClauses) then raise Exception.Create('aTables and aWhereClauses should contain equal members count.'); SetLength(lTableRequestInfoArray, Length(aTables)); for i := 0 to High(aTables) do lTableRequestInfoArray[i]:= CreateTableRequestInfo(aTables[i],aIncludeSchema,aWhereClauses[i]); Fill(aTables, lTableRequestInfoArray, aSaveCursor,aIncludeSchema); end; procedure TDARemoteDataAdapter.FillSchema(aTables: array of TDADataTable; aPreserveLookupFields, aPreserveClientCalcFields: boolean); type THandlerArray = array[0..1] of TMethod; PHandlerArray = ^THandlerArray; const HandlersToSave : array[0..1] of string = ('OnChange', 'OnValidate'); var lSavedOptions: array of TDATableOptions; i, j, k, lIndex: integer; lHandlers : PHandlerArray; lResultParam: TRORequestParam; lSchema: TDASchema; lDataTableSchema: TDADataset; lookupfields : TDAFieldCollection; clientcalcfields : TDAFieldCollection; lField: TDAField; begin CheckProperties; SetLength(lSavedOptions, Length(aTables)); for i := Low(aTables) to High(aTables) do if aTables[i].Active then aTables[i].Close(); lookupfields := nil; clientcalcfields := nil; for i := Low(aTables) to High(aTables) do aTables[i].Fields.FieldEventsDisabled := true; try for i := Low(aTables) to High(aTables) do begin lSavedOptions[i-Low(aTables)].FieldHandlers := TStringList.Create; { Saves the current event handler pointers } for j := 0 to aTables[i].Fields.Count-1 do begin New(lHandlers); for k := Low(HandlersToSave) to High(HandlersToSave) do lHandlers[k] := GetMethodProp(aTables[i].Fields[j], HandlersToSave[k]); lSavedOptions[i-Low(aTables)].FieldHandlers.AddObject(aTables[i].Fields[j].Name, TObject(lHandlers)); end; { Save lookup and calced fields} if aPreserveLookupFields then begin lookupfields := TDAFieldCollection.Create(nil); lookupfields.Assign(aTables[i].Fields); for j := (lookupfields.Count-1) downto 0 do if not (lookupfields[j] as TDACustomField).Lookup then lookupfields.Delete(j); end; if aPreserveClientCalcFields then begin clientcalcfields := TDAFieldCollection.Create(nil); clientcalcfields.Assign(aTables[i].Fields); for j :=(clientcalcfields.Count-1) downto 0 do if not (clientcalcfields[j] as TDACustomField).Calculated then clientcalcfields.Delete(j); end; aTables[i].Fields.Clear; end; try lResultParam := GetSchemaCall.Params.FindParam(GetSchemaCall.IncomingSchemaParameter); if not assigned(lResultParam) then raise Exception.Create('Result parameter of GetSchemaCall is not defined.'); case lResultParam.DataType of rtBinary:begin DoGetSchemaCall(); if not assigned(lResultParam.AsBinary) or (lResultParam.AsBinary.Size = 0 ) then raise Exception.Create('Server returned an empty buffer for schema.'); DataStreamer.Initialize(lResultParam.AsBinary, aiRead); try if (DataStreamer.DatasetCount = 0) then raise Exception.Create('Stream does not contain any dataset'); for i := Low(aTables) to High(aTables) do DataStreamer.ReadDataset(aTables[i].LogicalName, aTables[i], true, false); finally DataStreamer.Finalize; end; end; rtString:begin DoGetSchemaCall(); lSchema := TDASchema.Create(nil); try lSchema.LoadFromXml(Utf8ToAnsi(lResultParam.AsString)); for i := Low(aTables) to High(aTables) do begin lDataTableSchema := lSchema.Datasets.FindDatasetByName(aTables[i].LogicalName); if not assigned(lDataTableSchema) then lDataTableSchema := lSchema.UnionDataTables.FindUnionDataTableByName(aTables[i].LogicalName); if not assigned(lDataTableSchema) then lDataTableSchema := lSchema.JoinDataTables.FindJoinTableByName(aTables[i].LogicalName); if not assigned(lDataTableSchema) then raise Exception.CreateFmt('Data table "%s" was not found in schema.',[aTables[i].LogicalName]); aTables[i].Fields.AssignFieldCollection(lDataTableSchema.Fields); // ToDo: the code below is shared with TableWizard. Refactor. if lDataTableSchema is TDAUnionDataTable then begin if not Assigned(aTables[i].Fields.FindField(def_SourceTableFieldName) as TDAField) then begin lField := aTables[i].Fields.Add(); lField.Name := def_SourceTableFieldName; lField.DataType := datInteger; lField.InPrimaryKey := True; lField.ServerAutoRefresh := True; end; end; aTables[i].Params.AssignParamCollection(lDataTableSchema.Params); aTables[i].CustomAttributes.Assign(lDataTableSchema.CustomAttributes); end; finally FreeAndNil(lSchema); end; end; else raise Exception.Create('Result parameter of GetSchemaCall is not properly defined as String or Binary.'); end; finally { Save lookup and calced fields} if aPreserveLookupFields then for i := Low(aTables) to High(aTables) do for j := 0 to (lookupfields.Count-1) do aTables[i].Fields.Add.Assign(lookupfields[j]); if aPreserveClientCalcFields then for i := Low(aTables) to High(aTables) do for j := 0 to (clientcalcfields.Count-1) do if not Assigned(aTables[i].Fields.FindField(clientcalcfields[j].Name)) then aTables[i].Fields.Add.Assign(clientcalcfields[j]); { restores the old event handler pointers } for i := Low(aTables) to High(aTables) do begin for j := 0 to aTables[i].Fields.Count-1 do begin lIndex := lSavedOptions[i-Low(aTables)].FieldHandlers.IndexOf(aTables[i].Fields[j].Name); if lIndex >= 0 then begin lHandlers := PHandlerArray(lSavedOptions[i-Low(aTables)].FieldHandlers.Objects[lIndex]); for k := Low(HandlersToSave) to High(HandlersToSave) do SetMethodProp(aTables[i].Fields[j], HandlersToSave[k], lHandlers[k]); Dispose(lHandlers); end; end; lSavedOptions[i-Low(aTables)].FieldHandlers.Free(); end; end; finally lResultParam := GetSchemaCall.Params.FindParam(GetSchemaCall.IncomingSchemaParameter); if Assigned(lResultParam) then lResultParam.ClearValue; clientcalcfields.Free; lookupfields.Free; for i := Low(aTables) to High(aTables) do aTables[i].Fields.FieldEventsDisabled := false; end; end; procedure TDARemoteDataAdapter.FillScripts(aTables: array of TDADataTable); var lXml: IXMLDocument; lScriptNode: IXMLNode; lParam: TDARemoteRequestParam; lResultParam: TRORequestParam; i: integer; begin CheckProperties; if GetScriptsCall.MethodName = '' then raise Exception.Create('GetScriptsCall.MethodName must be configured to retrieve scripts.'); try lParam := GetScriptsCall.Params.FindParam(GetScriptsCall.OutgoingTableNamesParameter); if assigned(lParam) then FillTableNamesParam(aTables, lParam); GetScriptsCall.Execute(); lResultParam := GetScriptsCall.Params.FindParam(GetScriptsCall.IncomingScriptParameter); if not assigned(lResultParam) or (lResultParam.DataType <> rtString) then raise Exception.Create('Result parameter of GetScriptsCall is not properly defined.'); if Assigned(fBeforeGetScriptsCall) then fBeforeGetScriptsCall(Self, GetScriptsCall); GetScriptsCall.Execute(); if Assigned(fAfterGetScriptsCall) then fAfterGetScriptsCall(Self, GetScriptsCall); lXml := NewROXmlDocument; lXml.New; lXml.XML := UTF8Decode(lResultParam.AsString); for i := Low(aTables) to High(aTables) do begin lScriptNode := lXml.DocumentNode.GetNodeByName(aTables[i].Logicalname); if assigned(lScriptNode) then aTables[i].ScriptCode.Text := Utf8Decode(VarToStr(lScriptNode.Value)) else aTables[i].ScriptCode.Text := ''; end; finally lParam := GetScriptsCall.Params.FindParam(GetScriptsCall.OutgoingTableNamesParameter); if assigned(lParam) then lParam.ClearValue; lParam := GetScriptsCall.Params.FindParam(GetScriptsCall.IncomingScriptParameter); if assigned(lParam) then lParam.ClearValue; end; end; function TDARemoteDataAdapter.GetDataStreamer: TDADataStreamer; begin result := fDataStreamer; end; {$IFDEF FPC} procedure List_Union(List1,List2: TList); var i: integer; begin if List1 = List2 then Exit; for i := 0 to List2.Count-1 do if List1.IndexOf(List2[i])=-1 then List1.Add(List2[i]); end; {$ENDIF} function TDARemoteDataAdapter.ApplyUpdates(aTables: array of TDADataTable; aRefetchAll: boolean): boolean; var i,j: integer; lHasData: Boolean; lParam, lResultparam: TRORequestParam; details: TList; dt: TDADataTable; lFailedDeltas: TList; lTablesList: TList; begin CheckProperties; result := false; try { Fill Input Parameters } lParam := UpdateDataCall.Params.FindParam(UpdateDataCall.OutgoingDeltaParameter); if not assigned(lParam) or (lParam.DataType <> rtBinary) then raise Exception.Create('OutgoingDeltaParameter parameter of UpdateDataCall is not properly defined.'); lParam.ClearValue(); DataStreamer.Initialize(lParam.AsBinary, aiWrite); try lHasData := false; for i := Low(aTables) to High(aTables) do begin if aTables[i].Active and aTables[i].DeltaInitialized then begin lHasData := true; //fBeforeApplyUpdates if Assigned(fBeforeApplyUpdates) then fBeforeApplyUpdates(Self, aTables[i], aTables[i].Delta); details:= aTables[i].GetDetailTablesforApplyUpdate; try for j := 0 to details.Count-1 do begin dt:= TDADataTable(details[j]); if Assigned(dt.RemoteDataAdapter) and Assigned(TDARemoteDataAdapter(dt.RemoteDataAdapter).fBeforeApplyUpdates) then TDARemoteDataAdapter(dt.RemoteDataAdapter).fBeforeApplyUpdates(dt.RemoteDataAdapter, dt, dt.Delta); end; finally details.free; end; aTables[i].WriteDeltaToStream(DataStreamer); end; end; finally DataStreamer.Finalize; end; { Make call } if lHasData then begin if Assigned(fBeforeUpdateDataCall) then fBeforeUpdateDataCall(Self, UpdateDataCall); UpdateDataCall.Execute(); if Assigned(fAfterUpdateDataCall) then fAfterUpdateDataCall(Self, UpdateDataCall); { Get Output Parameters } if UpdateDataCall.IncomingDeltaParameter <> '' then begin // If the result parameter isn't set, we shouldn't check for a result. lResultParam := UpdateDataCall.Params.FindParam(UpdateDataCall.IncomingDeltaParameter); if not assigned(lResultParam) or (lResultParam.DataType <> rtBinary) then raise Exception.Create('IncomingDeltaParameter parameter of UpdateDataCall is not properly defined.'); // Reads the incoming delta, including the details if assigned(lResultParam.AsBinary) and (lResultParam.AsBinary.Size > 0) then begin DataStreamer.Initialize(lResultParam.AsBinary, aiReadFromBeginning); lFailedDeltas := TList.Create; try try for i := Low(aTables) to High(aTables) do begin if aTables[i].Active and aTables[i].DeltaInitialized then aTables[i].ReadDeltaFromStream(DataStreamer, lFailedDeltas); end; finally DataStreamer.Finalize; end; for i := Low(aTables) to High(aTables) do aTables[i].MergeDelta; lTablesList:= TList.Create; try for i := Low(aTables) to High(aTables) do begin lTablesList.Add(aTables[i]); details:= aTables[i].GetDetailTablesforApplyUpdate; try {$IFDEF FPC} List_Union(lTablesList,Details) {$ELSE} lTablesList.Assign(Details, laOr); {$ENDIF} finally details.Free; end; end; ThrowFailures(lTablesList,lFailedDeltas); finally lTablesList.Free; end; //fAfterApplyUpdates for i := Low(aTables) to High(aTables) do begin if Assigned(fAfterApplyUpdates) then fAfterApplyUpdates(Self, aTables[i], nil); details:= aTables[i].GetDetailTablesforApplyUpdate; try for j := 0 to details.Count-1 do begin dt:= TDADataTable(details[j]); if Assigned(dt.RemoteDataAdapter) and Assigned(TDARemoteDataAdapter(dt.RemoteDataAdapter).fAfterApplyUpdates) then TDARemoteDataAdapter(dt.RemoteDataAdapter).fAfterApplyUpdates(dt.RemoteDataAdapter, dt, nil); end; finally details.free; end; end; finally lFailedDeltas.Free; end; end; end else begin for i := Low(aTables) to High(aTables) do aTables[i].MergeDelta; end; end; result := true; finally lResultParam := UpdateDataCall.Params.FindParam(UpdateDataCall.IncomingDeltaParameter); if assigned(lResultParam) then lResultParam.ClearValue; lParam := UpdateDataCall.Params.FindParam(UpdateDataCall.OutgoingDeltaParameter); if assigned(lParam) then lParam.ClearValue; end; if aRefetchAll and result then begin for i := Low(aTables) to High(aTables) do if aTables[i].Active then aTables[i].Close(); for i := Low(aTables) to High(aTables) do aTables[i].Open(); end; end; constructor TDARemoteDataAdapter.Create(aOwner: TComponent); begin inherited; fGetSchemaCall := TDAGetSchemaRequest.Create(self); fGetDataCall := TDAGetDataRequest.Create(self); fUpdateDataCall := TDAUpdateDataRequest.Create(self); fGetScriptsCall := TDAGetScriptsRequest.Create(self); fGetSchemaCall.Name := 'GetSchemaCall'; fGetDataCall.Name := 'GetDataCall'; fUpdateDataCall.Name := 'UpdateDataCall'; fGetScriptsCall.Name := 'GetScriptsCall'; FFailureBehavior := fbBoth; FDynamicSelect := False; SetupDefaultRequest; end; function TDARemoteDataAdapter.CreateTableRequestInfo(aTable: TDADataTable; aIncludeSchema: boolean; aDynamicWhereExpression: TDAWhereExpression = nil): TableRequestInfo; var lParam: DataParameter; j: integer; lExpression: TDAWhereExpression; begin if aDynamicWhereExpression <> nil then lExpression := aDynamicWhereExpression else lExpression := aTable.DynamicWhere.Expression; if FDynamicSelect or (lExpression <> nil) then begin Result := TableRequestInfoV5.Create(); if FDynamicSelect then begin TableRequestInfoV5(Result).DynamicSelectFieldNames := StringArray.Create; For j:=0 to aTable.FieldCount-1 do if not aTable.Fields[j].Lookup then TableRequestInfoV5(Result).DynamicSelectFieldNames.Add(AnsiToUtf8(aTable.Fields[j].Name)); end; if lExpression <> nil then TableRequestInfoV5(Result).WhereClause:=aTable.DynamicWhere.ExpressionToXmlNode(lExpression); end else Result := TableRequestInfo.Create(); Result.MaxRecords := aTable.MaxRecords; Result.IncludeSchema := aIncludeSchema and not (soIgnoreStreamSchema in aTable.StreamingOptions); Result.UserFilter := AnsiToUtf8(aTable.Where.Clause); for j := 0 to aTable.Params.Count-1 do begin lParam := Result.Parameters.Add(); lParam.Name := AnsiToUtf8(aTable.Params[j].Name); lParam.Value := aTable.Params[j].Value; end; end; destructor TDARemoteDataAdapter.Destroy; begin FreeAndNil(fGetSchemaCall); FreeAndNil(fGetDataCall); FreeAndNil(fUpdateDataCall); FreeAndNil(fGetScriptsCall); FreeAndNil(fSchema); inherited; end; procedure TDARemoteDataAdapter.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if Operation = opRemove then begin if AComponent = DataStreamer then DataStreamer := nil else if AComponent = RemoteService then RemoteService := nil; end; end; procedure TDARemoteDataAdapter.SetDataStreamer(const Value: TDADataStreamer); begin if Value <> fDataStreamer then begin fDataStreamer := Value; if assigned(fDataStreamer) then fDataStreamer.FreeNotification(self); end; end; procedure TDARemoteDataAdapter.SetRemoteService(const Value: TRORemoteService); begin if Value <> fRemoteService then begin fRemoteService := Value; if assigned(fRemoteService) then fRemoteService.FreeNotification(self); GetSchemaCall.RemoteService := fRemoteService; GetDataCall.RemoteService := fRemoteService; UpdateDataCall.RemoteService := fRemoteService; GetScriptsCall.RemoteService := fRemoteService; end; end; { Schema } procedure TDARemoteDataAdapter.SetCacheSchema(const Value: boolean); begin fCacheSchema := Value; if not fCacheSchema then FlushSchema(); end; function TDARemoteDataAdapter.GetSchema: TDASchema; begin result := ReadSchema(not fCacheSchema); end; function TDARemoteDataAdapter.Get_GetDataCall: TDARemoteRequest; begin result := GetDataCall; end; function TDARemoteDataAdapter.Get_GetSchemaCall: TDARemoteRequest; begin result := GetSchemaCall; end; function TDARemoteDataAdapter.Get_GetScriptsCall: TDARemoteRequest; begin result := GetScriptsCall; end; function TDARemoteDataAdapter.Get_UpdateDataCall: TDARemoteRequest; begin result := UpdateDataCall; end; function TDARemoteDataAdapter.ReadSchema(aForceReRead: boolean): TDASchema; var lResultParam: TRORequestParam; begin CheckProperties; lResultParam := GetSchemaCall.Params.FindParam(GetSchemaCall.IncomingSchemaParameter); if not assigned(lResultParam) then raise Exception.Create('Result parameter of GetSchemaCall is not defined.'); if not (lResultParam.DataType in [rtString]) then raise Exception.Create('Result parameter of GetSchemaCall is not properly defined as String.'); if aForceReRead then FreeAndNil(fSchema); if not assigned(fSchema) then try DoGetSchemaCall(); FreeAndNil(fSchema); fSchema := TDASchema.Create(nil); fSchema.LoadFromXml(lResultParam.AsString); finally if Assigned(lResultParam) then lResultParam.ClearValue; end; result := fSchema; end; procedure TDARemoteDataAdapter.FlushSchema; begin FreeAndNil(fSchema); end; procedure TDARemoteDataAdapter.SetupDefaultRequest; begin GetSchemaCall.SetupDefaultRequest(); GetDataCall.SetupDefaultRequest(); UpdateDataCall.SetupDefaultRequest(); GetScriptsCall.SetupDefaultRequest(); end; procedure TDARemoteDataAdapter.SetupDefaultRequestV3; begin GetSchemaCall.SetupDefaultRequestV3(); GetDataCall.SetupDefaultRequestV3(); UpdateDataCall.SetupDefaultRequestV3(); GetScriptsCall.SetupDefaultRequestV3(); end; procedure TDARemoteDataAdapter.CheckProperties; begin Check(not assigned(DataStreamer), Name + '.DataStreamer must be assigned.'); Check(not assigned(RemoteService), Name + '.RemoteService must be assigned.'); RemoteService.CheckProperties(); end; procedure TDARemoteDataAdapter.Loaded; begin inherited; {$IFDEF DELPHI6} // Delphi 6 doesn't call Loaded of any of the sub components. fGetDataCall.Loaded; fGetSchemaCall.Loaded; fUpdateDataCall.Loaded; fGetScriptsCall.Loaded; {$ENDIF} end; procedure TDARemoteDataAdapter.ThrowFailures(ATableList, AFailedDeltas: TList); var lFailureBehavior: TDAFailureBehavior; lExceptionMessage: string; i,j: integer; lHandled: boolean; begin if AFailedDeltas.Count >0 then begin lFailureBehavior:= FFailureBehavior; if Assigned(fBeforeProcessFailures) then fBeforeProcessFailures(Self, ATableList, AFailedDeltas, lFailureBehavior); //(fbNone, fbRaiseException, fbShowReconcile, fbBoth); if lFailureBehavior in [fbShowReconcile, fbBoth] then begin lHandled := false; if assigned(OnShowReconcleDialog) then OnShowReconcleDialog(self, AFailedDeltas, ATableList, lHandled); if not lHandled then ReconcileDialog(Self, AFailedDeltas, ATableList); end; if (AFailedDeltas.Count >0) and (lFailureBehavior in [fbRaiseException, fbBoth]) then begin lExceptionMessage := 'One or more updates failed to apply on the server.'+sLineBreak; for i := 0 to AFailedDeltas.Count-1 do begin lExceptionMessage := lExceptionMessage + sLineBreak ; With TDADeltaChange(AFailedDeltas[i]), Delta do for j := 0 to KeyFieldCount-1 do begin if ChangeType = uDAInterfaces.ctDelete then lExceptionMessage := lExceptionMessage + VarToStr(OldValueByName[KeyFieldNames[j]]) else lExceptionMessage := lExceptionMessage + VarToStr(NewValueByName[KeyFieldNames[j]]); if j = KeyFieldCount-1 then lExceptionMessage := lExceptionMessage + ': ' else lExceptionMessage := lExceptionMessage + ', '; end; lExceptionMessage := lExceptionMessage + TDADeltaChange(AFailedDeltas[i]).Message; if i = 10 then break; end; RaiseError(lExceptionMessage); end; end; end; end.