david
2a98435b14
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@68 b6239004-a887-0f4b-9937-50029ccdca16
749 lines
29 KiB
ObjectPascal
749 lines
29 KiB
ObjectPascal
unit uDADataAdapter;
|
|
{----------------------------------------------------------------------------}
|
|
{ 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
|
|
SysUtils, Variants, Classes, DB,
|
|
uROClasses, uROClient,
|
|
uDAInterfaces, uDAClasses, DataAbstract4_Intf, uDADataTable, uDADataStreamer, uDADelta;
|
|
|
|
type
|
|
TDATableOptions = record
|
|
// Fill
|
|
Bookmark: TBookMark;
|
|
GoFirst, OldLogChanges: boolean;
|
|
OldPos: cardinal;
|
|
// FillSchema
|
|
FieldHandlers : TStringList;
|
|
AppendMode: Boolean;
|
|
end;
|
|
|
|
TDAFailureBehavior = (fbNone, fbRaiseException, fbShowReconcile, fbBoth);
|
|
TDAApplyUpdatesEvent = procedure(Sender: TObject; aTable: TDADataTable; const Delta: IDADelta) of object;
|
|
TDABeforeProcessFailuresEvent = procedure(Sender: TObject; aTablesList: TList; aFailedDeltas: TList; var aFailureBehavior: TDAFailureBehavior) of object;
|
|
TDAShowReconcleDialogEvent = procedure(Sender: TObject; var AFailedDeltaList: TList; aTableList: TList; var aHandled: boolean) of object;
|
|
TDAOnGenerateRecordMessage = procedure(Sender: TObject; aChange: TDADeltaChange; ADatatable: TDADataTable; var aMessage: string) of object;
|
|
TDAReconcileDialogAction = (rdlgNone,rdlgSkip,rdlgCancel, rdlgRepost, rdlgRevert);
|
|
TDAShowReconcileRecordInAppUIEvent = procedure(Sender: TObject; aChange: TDADeltaChange; aDatatable: TDADataTable; var aHandled: Boolean; var aAction: TDAReconcileDialogAction) of object;
|
|
|
|
TDATableOptionsArray = array of TDATableOptions;
|
|
|
|
TDABaseDataAdapter = class(TDACustomDataAdapter)
|
|
private
|
|
FDataStreamer: TDADataStreamer;
|
|
fBeforeApplyUpdates, fAfterApplyUpdates: TDAApplyUpdatesEvent;
|
|
FFailureBehavior: TDAFailureBehavior;
|
|
fBeforeProcessFailures: TDABeforeProcessFailuresEvent;
|
|
fOnShowReconcleDialog: TDAShowReconcleDialogEvent;
|
|
FOnGenerateRecordMessage: TDAOnGenerateRecordMessage;
|
|
fOnShowReconcleRecordInAppUI: TDAShowReconcileRecordinAppUIEvent;
|
|
FDynamicSelect: Boolean;
|
|
fAutoFillScripts: Boolean;
|
|
fCacheSchema: boolean;
|
|
fSchema: TDASchema;
|
|
procedure ThrowFailures(ATableList,AFailedDeltas:TList);
|
|
procedure SetCacheSchema(const Value: boolean);
|
|
function GetSchema: TDASchema;
|
|
protected
|
|
{ abstract }
|
|
procedure InternalApplyUpdates(aTables,aTablesWithDetails: array of TDADataTable); virtual; abstract;
|
|
procedure InternalFill(aTableArray: array of TDADataTable; aArray: TableRequestInfoArray; const aIncludeSchema, aAppendMode: boolean; aSavedOptions: TDATableOptionsArray);virtual; abstract;
|
|
function InternalFillSchema(var aStream: TROBinaryMemoryStream): TRODataType; virtual; abstract;
|
|
function InternalFillScripts(aTables: array of TDADataTable):UTF8String; virtual; abstract;
|
|
function InternalReadSchema: UTF8String; virtual; abstract;
|
|
protected
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
function GetDataStreamer: TDADataStreamer; override;
|
|
procedure SetDataStreamer(const Value: TDADataStreamer); override;
|
|
function CreateTableRequestInfo(aTable: TDADataTable; aIncludeSchema: boolean; aDynamicWhereExpression: TDAWhereExpression = nil): TableRequestInfo;
|
|
function GetTableNamesAsCommaText(aTableArray: array of TDADataTable): UTF8String;
|
|
property CacheSchema: boolean read fCacheSchema write SetCacheSchema default false;
|
|
property DataStreamer: TDADataStreamer read GetDataStreamer write SetDataStreamer;
|
|
public
|
|
constructor Create(aOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure Assign(Source: TPersistent); override;
|
|
function ApplyUpdates(aTables: array of TDADataTable; aRefetchAll: boolean = false): boolean; override;
|
|
procedure FillSchema(aTables: array of TDADataTable; aPreserveLookupFields: boolean = false; aPreserveClientCalcFields : boolean = false);override;
|
|
procedure CheckProperties; virtual;
|
|
function ReadSchema(aForceReRead: boolean = false): TDASchema;
|
|
procedure FillScripts(aTables: array of TDADataTable); override;
|
|
procedure Fill(aTables: array of TDADataTable; aTableRequestInfoArray: array of TableRequestInfo; aSaveCursor: boolean=false;aIncludeSchema: boolean=false; aAppendMode:Boolean = False); overload;
|
|
procedure Fill(aTables: array of TDADataTable; aWhereClauses : array of TDAWhereExpression; aSaveCursor: boolean=false; aIncludeSchema: boolean=false; aAppendMode:Boolean = False); overload;
|
|
procedure Fill(aTables: array of TDADataTable; aSaveCursor: boolean = False; aIncludeSchema: boolean = False; aAppendMode:Boolean = False); overload; override;
|
|
procedure FlushSchema;
|
|
property Schema: TDASchema read GetSchema;
|
|
published
|
|
property BeforeApplyUpdates: TDAApplyUpdatesEvent read fBeforeApplyUpdates write fBeforeApplyUpdates;
|
|
property AfterApplyUpdates: TDAApplyUpdatesEvent read fAfterApplyUpdates write fAfterApplyUpdates;
|
|
property FailureBehavior: TDAFailureBehavior read FFailureBehavior write FFailureBehavior default fbBoth;
|
|
property BeforeProcessFailures: TDABeforeProcessFailuresEvent read fBeforeProcessFailures write fBeforeProcessFailures;
|
|
property OnShowReconcleDialog:TDAShowReconcleDialogEvent read fOnShowReconcleDialog write fOnShowReconcleDialog;
|
|
property OnGenerateRecordMessage: TDAOnGenerateRecordMessage read FOnGenerateRecordMessage write FOnGenerateRecordMessage;
|
|
property OnShowReconcileRecordInAppUI: TDAShowReconcileRecordInAppUIEvent read fOnShowReconcleRecordInAppUI write fOnShowReconcleRecordInAppUI;
|
|
property AutoFillScripts: Boolean read fAutoFillScripts write fAutoFillScripts default false;
|
|
property DynamicSelect: Boolean read FDynamicSelect write FDynamicSelect default False;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
TypInfo,
|
|
uROBinaryHelpers, uROXMLIntf,
|
|
uDAEngine, uDAReconcileDialog;
|
|
|
|
{ TDABaseDataAdapter }
|
|
|
|
function TDABaseDataAdapter.ApplyUpdates(aTables: array of TDADataTable;
|
|
aRefetchAll: boolean): boolean;
|
|
|
|
procedure CheckTable(ATable: TDADataTable);
|
|
begin
|
|
if ATable.RemoteDataAdapter <> Self then EDAException.CreateFmt('Can not do ApplyUpdate:%s.RemoteDataAdapter must use %s',[ATable.Name, Self.Name]);
|
|
end;
|
|
|
|
procedure List_RemoveDuplicates(AList: TList);
|
|
var
|
|
i,j: integer;
|
|
p: pointer;
|
|
begin
|
|
i := 0;
|
|
while i < AList.Count do begin
|
|
p:=AList[i];
|
|
for j := AList.Count - 1 downto i+1 do
|
|
if p = AList[j] then
|
|
AList.Delete(j);
|
|
inc(i);
|
|
end;
|
|
end;
|
|
|
|
var
|
|
i,k,j : Integer;
|
|
details: TList;
|
|
lTables: TList;
|
|
dt: TDADataTable;
|
|
aTables2,aTables3: array of TDADataTable;
|
|
lFailedDeltas: TList;
|
|
begin
|
|
CheckProperties;
|
|
Result := False;
|
|
|
|
// we need to process correctly case when MasterTables and DetailTable use different RDAs
|
|
// currently we don't support it
|
|
// probably we should do apply updates for each RDA separately
|
|
SetLength(aTables2, Length(aTables));
|
|
j:=0;
|
|
lTables := TList.Create;
|
|
try
|
|
for i := Low(aTables) to High(aTables) do begin
|
|
if Assigned(aTables[i]) and aTables[i].Active and aTables[i].DeltaInitialized then begin
|
|
CheckTable(aTables[i]);
|
|
aTables2[j] := aTables[i];
|
|
inc(j);
|
|
lTables.Add(aTables[i]);
|
|
details:= aTables[i].GetDetailTablesforApplyUpdate;
|
|
try
|
|
for k := 0 to details.Count-1 do begin
|
|
CheckTable(TDADataTable(details[k]));
|
|
lTables.Add(TDADataTable(details[k]));
|
|
end;
|
|
finally
|
|
details.free;
|
|
end;
|
|
end;
|
|
end;
|
|
SetLength(aTables2,j);
|
|
List_RemoveDuplicates(lTables);
|
|
if lTables.Count = 0 then Exit;
|
|
SetLength(aTables3,lTables.Count);
|
|
for I := 0 to lTables.Count - 1 do
|
|
aTables3[i] := TDADataTable(lTables[i]);
|
|
|
|
// post all unposted records
|
|
for i := 0 to lTables.Count-1 do
|
|
with TDADataTable(lTables[i]) do
|
|
if not (ruoOnPost in RemoteUpdatesOptions) then Delta.EndChangesInAllTables;
|
|
|
|
// BeforeApplyUpdates
|
|
for i := 0 to lTables.Count-1 do begin
|
|
dt := TDADataTable(lTables[i]);
|
|
if Assigned(dt.RemoteDataAdapter) and (dt.RemoteDataAdapter is TDABaseDataAdapter) and Assigned(TDABaseDataAdapter(dt.RemoteDataAdapter).BeforeApplyUpdates) then
|
|
TDABaseDataAdapter(dt.RemoteDataAdapter).BeforeApplyUpdates(dt.RemoteDataAdapter, dt, dt.Delta);
|
|
end;
|
|
|
|
InternalApplyUpdates(aTables2, aTables3);
|
|
lFailedDeltas := TList.Create;
|
|
try
|
|
for i := 0 to lTables.Count-1 do
|
|
with TDADataTable(lTables[i]).Delta do
|
|
for j := 0 to Count - 1 do
|
|
if Changes[j].Status = csFailed then lFailedDeltas.Add(Changes[j]);
|
|
|
|
for i := 0 to lTables.Count-1 do
|
|
TDADataTable(lTables[i]).MergeDelta;
|
|
ThrowFailures(lTables,lFailedDeltas);
|
|
finally
|
|
lFailedDeltas.Free;
|
|
end;
|
|
|
|
// AfterApplyUpdates
|
|
for i := 0 to lTables.Count-1 do begin
|
|
dt := TDADataTable(lTables[i]);
|
|
if Assigned(dt.RemoteDataAdapter) and (dt.RemoteDataAdapter is TDABaseDataAdapter) and Assigned(TDABaseDataAdapter(dt.RemoteDataAdapter).AfterApplyUpdates) then
|
|
TDABaseDataAdapter(dt.RemoteDataAdapter).AfterApplyUpdates(dt.RemoteDataAdapter, dt, nil);
|
|
end;
|
|
|
|
Result := True;
|
|
if aRefetchAll then begin
|
|
for i := 0 to lTables.Count-1 do
|
|
with TDADataTable(lTables[i]) do
|
|
if Active then Close();
|
|
for i := 0 to lTables.Count-1 do
|
|
TDADataTable(lTables[i]).Open;
|
|
end;
|
|
finally
|
|
lTables.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TDABaseDataAdapter.Assign(Source: TPersistent);
|
|
var
|
|
lSource: TDABaseDataAdapter;
|
|
begin
|
|
inherited;
|
|
if Source is TDABaseDataAdapter then begin
|
|
lSource := TDABaseDataAdapter(Source);
|
|
|
|
AfterApplyUpdates := lSource.AfterApplyUpdates;
|
|
AutoFillScripts := lSource.AutoFillScripts;
|
|
BeforeApplyUpdates := lSource.BeforeApplyUpdates;
|
|
BeforeProcessFailures := lSource.BeforeProcessFailures;
|
|
CacheSchema := lSource.CacheSchema;
|
|
DataStreamer := lSource.DataStreamer;
|
|
DynamicSelect := lSource.DynamicSelect;
|
|
FailureBehavior := lSource.FailureBehavior;
|
|
OnGenerateRecordMessage := lSource.OnGenerateRecordMessage;
|
|
OnShowReconcileRecordInAppUI := lSource.OnShowReconcileRecordInAppUI;
|
|
OnShowReconcleDialog := lSource.OnShowReconcleDialog;
|
|
end;
|
|
end;
|
|
|
|
procedure TDABaseDataAdapter.CheckProperties;
|
|
begin
|
|
// nothing
|
|
end;
|
|
|
|
constructor TDABaseDataAdapter.Create(aOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FFailureBehavior := fbBoth;
|
|
FDynamicSelect := False;
|
|
fCacheSchema := False;
|
|
end;
|
|
|
|
function TDABaseDataAdapter.CreateTableRequestInfo(aTable: TDADataTable;
|
|
aIncludeSchema: boolean;
|
|
aDynamicWhereExpression: TDAWhereExpression): 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 TDABaseDataAdapter.Destroy;
|
|
begin
|
|
DataStreamer := nil;
|
|
FlushSchema;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDABaseDataAdapter.Fill(aTables: array of TDADataTable;
|
|
aWhereClauses: array of TDAWhereExpression; aSaveCursor, aIncludeSchema,
|
|
aAppendMode: 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,aAppendMode);
|
|
end;
|
|
|
|
procedure TDABaseDataAdapter.Fill(aTables: array of TDADataTable; aSaveCursor,
|
|
aIncludeSchema, aAppendMode: Boolean);
|
|
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, aAppendMode);
|
|
end;
|
|
|
|
procedure TDABaseDataAdapter.Fill(aTables: array of TDADataTable;
|
|
aTableRequestInfoArray: array of TableRequestInfo; aSaveCursor,
|
|
aIncludeSchema, aAppendMode: Boolean);
|
|
var
|
|
lSavedOptions: TDATableOptionsArray;
|
|
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);
|
|
if not aAppendMode then 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];
|
|
if aAppendMode then begin
|
|
for i := 0 to High(ltablearray) do
|
|
Check(ltablearray[i].HasDelta and (ltablearray[i].Delta.Count > 0),
|
|
'%s.Fill: %s contains uncommited changes. AppendMode is incompatible with this.',
|
|
[Self.Name,ltablearray[i].Name]);
|
|
end;
|
|
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;
|
|
lSavedOptions[i].AppendMode := ltbl.Active and aAppendMode;
|
|
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
|
|
InternalFill(lTableArray,lArray,aIncludeSchema,aIncludeSchema, lSavedOptions);
|
|
finally
|
|
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
|
|
if ltbl.BookmarkValid(lSavedOptions[i].Bookmark) then ltbl.GotoBookmark(lSavedOptions[i].Bookmark);
|
|
ltbl.FreeBookmark(lSavedOptions[i].Bookmark);
|
|
end;
|
|
end;
|
|
end;
|
|
ltbl.LogChanges := lSavedOptions[i].OldLogChanges;
|
|
ltbl.InternalSetFetching(false);
|
|
end;
|
|
end;
|
|
finally
|
|
SetLength(lSavedOptions,0);
|
|
SetLength(ltablearray,0);
|
|
end;
|
|
finally
|
|
lArray.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TDABaseDataAdapter.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;
|
|
lSchema: TDASchema;
|
|
lDataTableSchema: TDADataset;
|
|
lookupfields : TDAFieldCollection;
|
|
clientcalcfields : TDAFieldCollection;
|
|
lField: TDAField;
|
|
lBinary: TROBinaryMemoryStream;
|
|
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
|
|
lBinary := nil;
|
|
case InternalFillSchema(lBinary) of
|
|
rtBinary:begin
|
|
// only RDA
|
|
DataStreamer.Initialize(lBinary, 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, rtUTF8String:begin
|
|
//LDA+RDA
|
|
lSchema := GetSchema;
|
|
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;
|
|
end;
|
|
finally
|
|
FreeAndNil(lBinary);
|
|
{ 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]);
|
|
end;
|
|
end;
|
|
{ deallocating memory used to store the old event handler pointers }
|
|
for j := 0 to lSavedOptions[i-Low(aTables)].FieldHandlers.Count - 1 do
|
|
Dispose(PHandlerArray(lSavedOptions[i-Low(aTables)].FieldHandlers.Objects[j]));
|
|
lSavedOptions[i-Low(aTables)].FieldHandlers.Free();
|
|
end;
|
|
end;
|
|
finally
|
|
clientcalcfields.Free;
|
|
lookupfields.Free;
|
|
for i := Low(aTables) to High(aTables) do
|
|
aTables[i].Fields.FieldEventsDisabled := false;
|
|
end;
|
|
end;
|
|
|
|
procedure TDABaseDataAdapter.FillScripts(aTables: array of TDADataTable);
|
|
var
|
|
lXmlStr: UTF8String;
|
|
lXml: IXMLDocument;
|
|
lScriptNode: IXMLNode;
|
|
i: integer;
|
|
begin
|
|
CheckProperties;
|
|
lXmlStr := InternalFillScripts(aTables);
|
|
lXml := NewROXmlDocument;
|
|
lXml.New;
|
|
lXml.XML := UTF8ToString(lXmlStr);
|
|
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;
|
|
end;
|
|
|
|
|
|
procedure TDABaseDataAdapter.FlushSchema;
|
|
begin
|
|
FreeAndNil(fSchema);
|
|
end;
|
|
|
|
function TDABaseDataAdapter.GetDataStreamer: TDADataStreamer;
|
|
begin
|
|
Result := FDataStreamer;
|
|
end;
|
|
|
|
function TDABaseDataAdapter.GetSchema: TDASchema;
|
|
begin
|
|
Result := ReadSchema(not fCacheSchema);
|
|
end;
|
|
|
|
function TDABaseDataAdapter.GetTableNamesAsCommaText(
|
|
aTableArray: array of TDADataTable): UTF8String;
|
|
var
|
|
names: TStringList;
|
|
i: integer;
|
|
begin
|
|
names := TStringList.Create;
|
|
names.Duplicates := dupIgnore;
|
|
try
|
|
for i := 0 to Length(aTableArray) - 1 do
|
|
names.Add(aTableArray[i].LogicalName);
|
|
Result := UTF8Encode(names.CommaText);
|
|
finally
|
|
names.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TDABaseDataAdapter.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited;
|
|
if (Operation = opRemove) and (AComponent = FDataStreamer) then FDataStreamer := nil
|
|
end;
|
|
|
|
function TDABaseDataAdapter.ReadSchema(aForceReRead: boolean): TDASchema;
|
|
var
|
|
lSchemaAsXmlString: UTF8String;
|
|
begin
|
|
CheckProperties;
|
|
if aForceReRead then FlushSchema;
|
|
if not assigned(fSchema) then begin
|
|
lSchemaAsXmlString := InternalReadSchema;
|
|
fSchema := TDASchema.Create(nil);
|
|
fSchema.LoadFromXml(AnsiString(lSchemaAsXmlString));
|
|
end;
|
|
result := fSchema;
|
|
end;
|
|
|
|
procedure TDABaseDataAdapter.SetCacheSchema(const Value: boolean);
|
|
begin
|
|
fCacheSchema := Value;
|
|
if not fCacheSchema then FlushSchema();
|
|
end;
|
|
|
|
procedure TDABaseDataAdapter.SetDataStreamer(
|
|
const Value: TDADataStreamer);
|
|
begin
|
|
if Value <> fDataStreamer then begin
|
|
if assigned(fDataStreamer) then fDataStreamer.RORemoveFreeNotification(self);
|
|
fDataStreamer := Value;
|
|
if assigned(fDataStreamer) then fDataStreamer.ROFreeNotification(self);
|
|
end;
|
|
end;
|
|
|
|
procedure TDABaseDataAdapter.ThrowFailures(ATableList,
|
|
AFailedDeltas: TList);
|
|
|
|
function FindDatatable(ADelta: IDADelta): TDADatatable;
|
|
var
|
|
i: integer;
|
|
begin
|
|
Result := nil;
|
|
for i := 0 to ATableList.Count - 1 do
|
|
if SameText(ADelta.LogicalName, TDADatatable(ATableList[i]).LogicalName) then begin
|
|
Result := TDADatatable(ATableList[i]);
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
function _VarToStr(AValue: variant; ADataType: TDADataType): string;
|
|
begin
|
|
if ADataType = datDecimal then
|
|
Result := DecimalVariantToString(AValue)
|
|
else
|
|
Result := VarToStr(AValue)
|
|
end;
|
|
|
|
var
|
|
lFailureBehavior: TDAFailureBehavior;
|
|
lExceptionMessage: string;
|
|
i,j: integer;
|
|
lHandled: boolean;
|
|
lMes: string;
|
|
begin
|
|
// we need to process correctly case when MasterTables and DetailTable use different RDA
|
|
// currently we don't support it
|
|
// probably we should ThrowFailures for each RDA separately
|
|
|
|
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]], LoggedFieldTypes[j])
|
|
else
|
|
lExceptionMessage := lExceptionMessage + _VarToStr(NewValueByName[KeyFieldNames[j]], LoggedFieldTypes[j]);
|
|
|
|
if j = KeyFieldCount-1 then
|
|
lExceptionMessage := lExceptionMessage + ': '
|
|
else
|
|
lExceptionMessage := lExceptionMessage + ', ';
|
|
end;
|
|
|
|
lMes := TDADeltaChange(AFailedDeltas[i]).Message;
|
|
if Assigned(FOnGenerateRecordMessage) then
|
|
FOnGenerateRecordMessage(Self, TDADeltaChange(AFailedDeltas[i]),FindDatatable(TDADeltaChange(AFailedDeltas[i]).Delta),lMes);
|
|
lExceptionMessage := lExceptionMessage + lMes;
|
|
if i = 10 then break;
|
|
end;
|
|
RaiseError(lExceptionMessage);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end.
|