david
2824855ea7
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 - Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
1026 lines
41 KiB
ObjectPascal
1026 lines
41 KiB
ObjectPascal
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.
|