933 lines
36 KiB
ObjectPascal
933 lines
36 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, uROTypes, uROClasses,
|
|
uDAInterfaces, uDAClasses, uDADataStreamer, uDADataTable,
|
|
uDARemoteDataAdapterRequests, DataAbstract4_Intf;
|
|
|
|
// for backward compatibility
|
|
const
|
|
fbNone = uDADataTable.fbNone;
|
|
fbRaiseException = uDADataTable.fbRaiseException;
|
|
fbShowReconcile = uDADataTable.fbShowReconcile;
|
|
fbBoth = uDADataTable.fbBoth;
|
|
rdlgNone = uDADataTable.rdlgNone;
|
|
rdlgSkip = uDADataTable.rdlgSkip;
|
|
rdlgCancel = uDADataTable.rdlgCancel;
|
|
rdlgRepost = uDADataTable.rdlgRepost;
|
|
rdlgRevert = uDADataTable.rdlgRevert;
|
|
type
|
|
TDAApplyUpdatesEvent = uDADataTable.TDAApplyUpdatesEvent;
|
|
TDAFailureBehavior = uDADataTable.TDAFailureBehavior;
|
|
TDABeforeProcessFailuresEvent = uDADataTable.TDABeforeProcessFailuresEvent;
|
|
TDAOnGenerateRecordMessage = uDADataTable.TDAOnGenerateRecordMessage;
|
|
TDAShowReconcleDialogEvent = uDADataTable.TDAShowReconcleDialogEvent;
|
|
TDAShowReconcileRecordInAppUIEvent = uDADataTable.TDAShowReconcileRecordInAppUIEvent;
|
|
TDAReconcileDialogAction = uDADataTable.TDAReconcileDialogAction;
|
|
// end for backward compatibility
|
|
|
|
type
|
|
TDARequestEvent = procedure(Sender: TObject; Request: TRODynamicRequest) of object;
|
|
|
|
{ TDARemoteDataAdapter }
|
|
TDARemoteDataAdapter = class(TDABaseRemoteDataAdapter)
|
|
private
|
|
fGetDataCall: TDAGetDataRequest;
|
|
fGetSchemaCall: TDAGetSchemaRequest;
|
|
fUpdateDataCall: TDAUpdateDataRequest;
|
|
fGetScriptsCall: TDAGetScriptsRequest;
|
|
fRemoteService: TRORemoteService;
|
|
fSchema: TDASchema;
|
|
fCacheSchema: boolean;
|
|
|
|
fBeforeGetDataCall, fAfterGetDataCall,
|
|
fBeforeGetSchemaCall, fAfterGetSchemaCall,
|
|
fBeforeGetScriptsCall, fAfterGetScriptsCall,
|
|
fBeforeUpdateDataCall, fAfterUpdateDataCall: TDARequestEvent;
|
|
|
|
procedure SetCacheSchema(const Value: boolean);
|
|
function CreateTableRequestInfo(aTable: TDADataTable; aIncludeSchema: boolean; aDynamicWhereExpression: TDAWhereExpression = nil): TableRequestInfo;
|
|
procedure DoGetSchemaCall;
|
|
|
|
procedure FillTableNamesParam(aTables: array of TDADataTable; aParam: TRORequestParam);
|
|
procedure SetRemoteService(const Value: TRORemoteService);
|
|
procedure FillTableParams(aTables: array of TDADataTable; aParam: TRORequestParam);
|
|
protected
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
procedure Loaded; override;
|
|
function InternalFillSchema: TRODataType; override;
|
|
procedure InternalFillSchema_ClearParams; override;
|
|
function InternalApplyUpdates(aTables,aTablesWithDetails: array of TDADataTable): boolean; override;
|
|
procedure InternalReconcileDialog(RemoteDataAdapter: TDABaseRemoteDataAdapter; var AFailedDeltaList: TList; aTableList: TList);override;
|
|
function GetSchemaStream: Binary; 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;
|
|
function GetSchema: TDASchema; override;
|
|
public
|
|
constructor Create(aOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure SetupDefaultRequestV3;
|
|
procedure SetupDefaultRequest;
|
|
|
|
procedure CheckProperties; 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;override;
|
|
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 CacheSchema: boolean read fCacheSchema write SetCacheSchema 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;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
SysUtils, DB, TypInfo, Variants,
|
|
uRODL, uROXMLIntf, uDAReconcileDialog, uROBinaryHelpers;
|
|
|
|
{ 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;
|
|
|
|
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;
|
|
|
|
lArray:= TableRequestInfoArray.Create;
|
|
try
|
|
ltableList := TList.Create;
|
|
llocalList := TList.Create;
|
|
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;
|
|
if length(ltablearray) = 0 then Exit;
|
|
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 AutoFillScripts 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;
|
|
lTables: array of TDADataTable;
|
|
i,j: integer;
|
|
begin
|
|
SetLength(lTableRequestInfoArray, Length(aTables));
|
|
SetLength(lTables, Length(aTables));
|
|
j:=0;
|
|
for i := 0 to High(aTables) do begin
|
|
if aTables[i] <> nil then begin
|
|
lTables[j]:=aTables[i];
|
|
lTableRequestInfoArray[j]:= CreateTableRequestInfo(aTables[j],aIncludeSchema);
|
|
inc(j);
|
|
end;
|
|
end;
|
|
SetLength(lTables, j);
|
|
SetLength(lTableRequestInfoArray, j);
|
|
Fill(lTables, lTableRequestInfoArray, aSaveCursor, aIncludeSchema);
|
|
end;
|
|
|
|
procedure TDARemoteDataAdapter.Fill(aTables: array of TDADataTable; aWhereClauses: array of TDAWhereExpression; aSaveCursor, aIncludeSchema: boolean);
|
|
var
|
|
lTableRequestInfoArray: array of TableRequestInfo;
|
|
lTables: array of TDADataTable;
|
|
i,j: integer;
|
|
begin
|
|
if Length(aTables) <> Length(aWhereClauses) then raise Exception.Create('aTables and aWhereClauses should contain equal members count.');
|
|
SetLength(lTableRequestInfoArray, Length(aTables));
|
|
SetLength(lTables, Length(aTables));
|
|
j:=0;
|
|
for i := 0 to High(aTables) do begin
|
|
if aTables[i] <> nil then begin
|
|
lTables[j]:=aTables[i];
|
|
lTableRequestInfoArray[j]:= CreateTableRequestInfo(aTables[j],aIncludeSchema, aWhereClauses[i]);
|
|
inc(j);
|
|
end;
|
|
end;
|
|
SetLength(lTables, j);
|
|
SetLength(lTableRequestInfoArray, j);
|
|
Fill(lTables, 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
|
|
lSchema := Schema;
|
|
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;
|
|
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 := UTF8ToString(lResultParam.AsAnsiString);
|
|
for i := Low(aTables) to High(aTables) do begin
|
|
lScriptNode := lXml.DocumentNode.GetNodeByName(aTables[i].Logicalname);
|
|
if assigned(lScriptNode) then
|
|
aTables[i].ScriptCode.Text := VarToWideStr(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;
|
|
|
|
|
|
{$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.InternalApplyUpdates(aTables,aTablesWithDetails: array of TDADataTable): boolean;
|
|
var
|
|
i: integer;
|
|
lParam, lResultparam: TRORequestParam;
|
|
begin
|
|
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
|
|
for i := Low(aTables) to High(aTables) do
|
|
aTables[i].WriteDeltaToStream(DataStreamer);
|
|
finally
|
|
DataStreamer.Finalize;
|
|
end;
|
|
|
|
{ Make call }
|
|
if DataStreamer.DeltaCount > 0 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);
|
|
try
|
|
for i := Low(aTables) to High(aTables) do
|
|
aTables[i].ReadDeltaFromStream(DataStreamer);
|
|
finally
|
|
DataStreamer.Finalize;
|
|
end;
|
|
end;
|
|
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;
|
|
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';
|
|
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 lExpression <> nil then lExpression.Validate;
|
|
|
|
if DynamicSelect or (lExpression <> nil) then begin
|
|
Result := TableRequestInfoV5.Create();
|
|
if DynamicSelect then begin
|
|
TableRequestInfoV5(Result).DynamicSelectFieldNames := StringArray.Create;
|
|
For j:=0 to aTable.FieldCount-1 do
|
|
if not (aTable.Fields[j].Lookup or (aTable.Fields[j].Calculated and not aTable.Fields[j].ServerCalculated)) 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) and (AComponent = RemoteService) then RemoteService := nil;
|
|
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);
|
|
try
|
|
fSchema.LoadFromXml(Utf8ToAnsi(lResultParam.AsAnsiString));
|
|
except
|
|
fSchema.LoadFromXml(lResultParam.AsString); // try to load schema as plain text
|
|
end;
|
|
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
|
|
inherited;
|
|
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;
|
|
|
|
|
|
function TDARemoteDataAdapter.InternalFillSchema: TRODataType;
|
|
var
|
|
lResultParam: TRORequestParam;
|
|
begin
|
|
lResultParam := GetSchemaCall.Params.FindParam(GetSchemaCall.IncomingSchemaParameter);
|
|
if not assigned(lResultParam) then
|
|
raise Exception.Create('Result parameter of GetSchemaCall is not defined.');
|
|
Result := lResultParam.DataType;
|
|
case Result 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.');
|
|
end;
|
|
rtString: begin
|
|
Schema;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TDARemoteDataAdapter.GetSchemaStream: Binary;
|
|
var
|
|
lResultParam: TRORequestParam;
|
|
begin
|
|
lResultParam := GetSchemaCall.Params.FindParam(GetSchemaCall.IncomingSchemaParameter);
|
|
if not assigned(lResultParam) then
|
|
raise Exception.Create('Result parameter of GetSchemaCall is not defined.');
|
|
if not assigned(lResultParam.AsBinary) or (lResultParam.AsBinary.Size = 0 ) then
|
|
raise Exception.Create('Server returned an empty buffer for schema.');
|
|
Result := lResultParam.AsBinary;
|
|
end;
|
|
|
|
procedure TDARemoteDataAdapter.InternalFillSchema_ClearParams;
|
|
var
|
|
lResultParam: TRORequestParam;
|
|
begin
|
|
lResultParam := GetSchemaCall.Params.FindParam(GetSchemaCall.IncomingSchemaParameter);
|
|
if Assigned(lResultParam) then lResultParam.ClearValue;
|
|
end;
|
|
|
|
procedure TDARemoteDataAdapter.InternalReconcileDialog(
|
|
RemoteDataAdapter: TDABaseRemoteDataAdapter; var AFailedDeltaList: TList;
|
|
aTableList: TList);
|
|
begin
|
|
ReconcileDialog(Self,AFailedDeltaList,aTableList);
|
|
end;
|
|
|
|
end.
|