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
1031 lines
32 KiB
ObjectPascal
1031 lines
32 KiB
ObjectPascal
unit uDADelta;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ Data Abstract Library - Core Library }
|
|
{ }
|
|
{ compiler: Delphi 6 and up, Kylix 3 and up }
|
|
{ platform: Win32, Linux }
|
|
{ }
|
|
{ (c)opyright RemObjects Software. all rights reserved. }
|
|
{ }
|
|
{ Using this code requires a valid license of the Data Abstract }
|
|
{ which can be obtained at http://www.remobjects.com. }
|
|
{----------------------------------------------------------------------------}
|
|
|
|
{$I DataAbstract.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, DB, SysUtils,
|
|
// {$IFDEF MSWINDOWS}ActiveX,{$ENDIF}
|
|
uRODL, uROTypes, uROClasses, uROClientIntf,
|
|
uDAInterfaces, uDAEngine,
|
|
DataAbstract3_Intf, DataAbstract4_Intf;
|
|
|
|
const
|
|
UndefinedRecordID = -1;
|
|
|
|
type
|
|
IDADelta = interface;
|
|
TDADelta = class;
|
|
TDADeltaChange = class;
|
|
|
|
TVariantArray = array of variant;
|
|
|
|
{ Exceptions }
|
|
EDAApplyUpdateFailed = class(EROException)
|
|
private
|
|
fRecID: integer;
|
|
fDeltaName: string;
|
|
|
|
public
|
|
constructor Create(aChange: TDADeltaChange; anOriginalException: Exception);
|
|
|
|
published
|
|
property RecID: integer read fRecID write fRecID;
|
|
property DeltaName: string read fDeltaName write fDeltaName;
|
|
end;
|
|
|
|
IDADataTable = interface
|
|
['{BC6CD610-6D6E-4CD7-B181-73B3A5F9DE4F}']
|
|
end;
|
|
|
|
{ IDADeltaOwner }
|
|
IDADeltaOwner = interface
|
|
['{A92ECD00-14B2-4147-AE49-9493C56763A0}']
|
|
function GetDelta: IDADelta; safecall;
|
|
end;
|
|
|
|
{ TDADeltaChange }
|
|
TDADeltaChange = class
|
|
private
|
|
fDelta: TDADelta;
|
|
fRecID: integer;
|
|
fNewValues: TVariantArray;
|
|
fOldValues: TVariantArray;
|
|
fChangeType: TDAChangeType;
|
|
fStatus: TDAChangeStatus;
|
|
fMessage: string;
|
|
fRefreshedByServer: boolean;
|
|
|
|
procedure SetNewValue(const aName: string; const Value: Variant);
|
|
procedure SetOldValue(const aName: string; const Value: Variant);
|
|
function GetNewValue(const aName: string): Variant;
|
|
function GetOldValue(const aName: string): Variant;
|
|
function GetDelta: IDADelta;
|
|
protected
|
|
|
|
public
|
|
constructor Create(aDelta: TDADelta;
|
|
aRecID: integer;
|
|
aChangeType: TDAChangeType;
|
|
aStatus: TDAChangeStatus = csPending;
|
|
aMessage: string = '');
|
|
destructor Destroy; override;
|
|
|
|
property RecID: integer read fRecID write fRecID;
|
|
property ChangeType: TDAChangeType read fChangeType write fChangeType;
|
|
property OldValues: TVariantArray read fOldValues write fOldValues;
|
|
property NewValues: TVariantArray read fNewValues write fNewValues;
|
|
|
|
property OldValueByName[const aName: string]: Variant read GetOldValue write SetOldValue;
|
|
property NewValueByName[const aName: string]: Variant read GetNewValue write SetNewValue;
|
|
|
|
property Status: TDAChangeStatus read fStatus write fStatus;
|
|
property Message: string read fMessage write fMessage;
|
|
|
|
property Delta : IDADelta read GetDelta;
|
|
|
|
property RefreshedByServer : boolean read fRefreshedByServer write fRefreshedByServer;
|
|
end;
|
|
|
|
{ IDADelta }
|
|
IDADelta = interface
|
|
['{0FD17DDB-3C34-4520-9106-4D3D540BA3D3}']
|
|
// Property readers/writers
|
|
function GetLoggedFieldCount: integer;
|
|
function GetInChange: boolean;
|
|
function GetCount: integer;
|
|
function GetChange(Index: integer): TDADeltaChange;
|
|
function GetLoggedFieldNames(Index: integer): string;
|
|
function GetKeyFieldCount: integer;
|
|
function GetKeyFieldNames(Index: integer): string;
|
|
function GetLoggedFieldTypes(Index : integer): TDADataType;
|
|
procedure SetLoggedFieldTypes(anIndex : integer; aFieldType : TDADataType);
|
|
function GetLogicalName : string;
|
|
procedure SetLogicalName(const aName : string);
|
|
|
|
// Methods
|
|
procedure AssignDataTable(aDataTable : TComponent);
|
|
|
|
function FindChange(aRecID: integer): TDADeltaChange;
|
|
procedure RemoveChange(aChange: TDADeltaChange);
|
|
|
|
procedure Clear(DoClearFieldNames: boolean = FALSE; DoClearKeyFieldNames: boolean = FALSE);
|
|
|
|
procedure AddFieldName(const aFieldName: string);
|
|
procedure AddKeyFieldName(const aKeyFieldName: string);
|
|
|
|
procedure ClearFieldNames;
|
|
procedure ClearKeyFieldNames;
|
|
|
|
procedure StartChange(aChangeType: TDAChangeType);
|
|
procedure CancelChange;
|
|
procedure EndChange;
|
|
procedure RestoreLastChange;
|
|
|
|
function IsNewRecord(aRecordID: integer = -1): boolean;
|
|
|
|
procedure Add(aChange: TDADeltaChange); overload;
|
|
function Add(aRecordID: integer; aChangeType: TDAChangeType;
|
|
aStatus: TDAChangeStatus = csPending; const aMessage: string = ''): TDADeltaChange; overload;
|
|
procedure Delete(Index: integer);
|
|
|
|
function GetCountByStatus(aChangeStatus : TDAChangeStatus) : integer;
|
|
|
|
function IndexOfLoggedField(const aName: string): integer;
|
|
property LoggedFieldNames[Index: integer]: string read GetLoggedFieldNames;
|
|
property LoggedFieldCount: integer read GetLoggedFieldCount;
|
|
|
|
property KeyFieldNames[Index: integer]: string read GetKeyFieldNames;
|
|
property KeyFieldCount: integer read GetKeyFieldCount;
|
|
|
|
property LoggedFieldTypes[Index : integer]: TDADataType read GetLoggedFieldTypes write SetLoggedFieldTypes;
|
|
|
|
function GetDelta: TDADelta;
|
|
|
|
property LogicalName : string read GetLogicalName write SetLogicalName;
|
|
property Changes[Index: integer]: TDADeltaChange read GetChange; default;
|
|
property Count: integer read GetCount;
|
|
end;
|
|
|
|
{ IDADataReader }
|
|
IDADataReader = interface
|
|
['{7D2FC996-7A04-4ECE-91B0-4F17EFEC4985}']
|
|
function GetFieldNames(Index: integer): string; safecall;
|
|
function GetFieldIndexes(const aName: string): integer; safecall;
|
|
function GetFieldCount: integer; safecall;
|
|
function GetRecordCount: integer; safecall;
|
|
|
|
function GetAsBoolean(Index: integer): boolean; overload; safecall;
|
|
function GetAsCurrency(Index: integer): currency; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function GetAsDateTime(Index: integer): TDateTime; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function GetAsFloat(Index: integer): double; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function GetAsInteger(Index: integer): integer; overload; safecall;
|
|
function GetAsString(Index: integer): string; overload; safecall;
|
|
function GetAsVariant(Index: integer): variant; overload; safecall;
|
|
|
|
function GetAsBoolean(const FieldName: string): boolean; overload; safecall;
|
|
function GetAsCurrency(const FieldName: string): currency; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function GetAsDateTime(const FieldName: string): TDateTime; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function GetAsFloat(const FieldName: string): double; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function GetAsInteger(const FieldName: string): integer; overload; safecall;
|
|
function GetAsString(const FieldName: string): string; overload; safecall;
|
|
function GetAsVariant(const FieldName: string): variant; overload; safecall;
|
|
|
|
function First: boolean; safecall;
|
|
function Next: boolean; safecall;
|
|
|
|
function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; safecall;
|
|
|
|
property FieldNames[Index: integer]: string read GetFieldNames;
|
|
property FieldIndexes[const aFieldName: string]: integer read GetFieldIndexes;
|
|
property FieldCount: integer read GetFieldCount;
|
|
|
|
property RecordCount: integer read GetRecordCount;
|
|
end;
|
|
|
|
{ TDADeltaList }
|
|
TDADeltaList = class(TInterfaceList)
|
|
private
|
|
function GetDeltas(Index: integer): IDADelta;
|
|
|
|
protected
|
|
public
|
|
function Add(const aDelta : IDADelta) : integer; reintroduce;
|
|
procedure Insert(Index: Integer; const aDelta: IDADelta); reintroduce;
|
|
|
|
function DeltaByName(const aDeltaName : string) : IDADelta;
|
|
function FindDelta(const aDeltaName : string) : IDADelta;
|
|
|
|
property Deltas[Index : integer] : IDADelta read GetDeltas; default;
|
|
end;
|
|
|
|
{ TDADelta }
|
|
TDADelta = class(TDAEngineBaseObject, IDADelta, IDADataReader)
|
|
private
|
|
fDataTable: TComponent;
|
|
fChanges: TStringList;
|
|
fLastChange,
|
|
fCurrentChange: TDADeltaChange;
|
|
fNewChange: boolean;
|
|
fCurrentChangeType: TDAChangeType;
|
|
fKeyFields,
|
|
fFieldNames: TStringList;
|
|
fCurrPosition: integer;
|
|
fLogicalName : string;
|
|
|
|
function GetLoggedFieldCount: integer;
|
|
function GetInChange: boolean;
|
|
function GetCount: integer;
|
|
function GetChange(Index: integer): TDADeltaChange;
|
|
function GetLoggedFieldNames(Index: integer): string;
|
|
function GetKeyFieldCount: integer;
|
|
function GetKeyFieldNames(Index: integer): string;
|
|
function GetLoggedFieldTypes(Index : integer): TDADataType;
|
|
procedure SetLoggedFieldTypes(anIndex : integer; aFieldType : TDADataType);
|
|
|
|
protected
|
|
function GetDelta: TDADelta;
|
|
function GetLogicalName : string;
|
|
procedure SetLogicalName(const aName : string);
|
|
|
|
// IDADataReader
|
|
function GetFieldNames(Index: integer): string; safecall;
|
|
function GetFieldIndexes(const aName: string): integer; safecall;
|
|
function GetFieldCount: integer; safecall;
|
|
function GetAsBoolean(Index: integer): boolean; overload; safecall;
|
|
function GetAsCurrency(Index: integer): currency; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function GetAsDateTime(Index: integer): TDateTime; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function GetAsFloat(Index: integer): double; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function GetAsInteger(Index: integer): integer; overload; safecall;
|
|
function GetAsString(Index: integer): string; overload; safecall;
|
|
function GetAsVariant(Index: integer): variant; overload; safecall;
|
|
function GetAsBoolean(const FieldName: string): boolean; overload; safecall;
|
|
function GetAsCurrency(const FieldName: string): currency; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function GetAsDateTime(const FieldName: string): TDateTime; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function GetAsFloat(const FieldName: string): double; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function GetAsInteger(const FieldName: string): integer; overload; safecall;
|
|
function GetAsString(const FieldName: string): string; overload; safecall;
|
|
function GetAsVariant(const FieldName: string): variant; overload; safecall;
|
|
function GetRecordCount: integer; safecall;
|
|
function First: boolean; safecall;
|
|
function Next: boolean; safecall;
|
|
function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; safecall;
|
|
|
|
public
|
|
constructor Create(aDataTable: TComponent); overload;
|
|
constructor Create(const aLogicalName : string); overload;
|
|
constructor Create; overload;
|
|
destructor Destroy; override;
|
|
|
|
function FindChange(aRecID: integer): TDADeltaChange;
|
|
procedure RemoveChange(aChange: TDADeltaChange);
|
|
|
|
procedure Clear(DoClearFieldNames: boolean = FALSE; DoClearKeyFieldNames: boolean = FALSE);
|
|
|
|
procedure AssignDataTable(aDataTable : TComponent);
|
|
|
|
procedure AddFieldName(const aFieldName: string);
|
|
procedure AddKeyFieldName(const aKeyFieldName: string);
|
|
procedure ClearFieldNames;
|
|
procedure ClearKeyFieldNames;
|
|
|
|
procedure Add(aChange: TDADeltaChange); overload;
|
|
function Add(aRecordID: integer; aChangeType: TDAChangeType;
|
|
aStatus: TDAChangeStatus = csPending; const aMessage: string = ''): TDADeltaChange; overload;
|
|
procedure Delete(Index: integer);
|
|
|
|
procedure StartChange(aChangeType: TDAChangeType);
|
|
procedure CancelChange;
|
|
procedure EndChange;
|
|
procedure RestoreLastChange;
|
|
|
|
function IsNewRecord(aRecordID: integer = -1): boolean;
|
|
|
|
function IndexOfLoggedField(const aName: string): integer;
|
|
|
|
function GetCountByStatus(aChangeStatus : TDAChangeStatus) : integer;
|
|
|
|
property CurrentChange: TDADeltaChange read fCurrentChange;
|
|
|
|
property KeyFieldNames[Index: integer]: string read GetKeyFieldNames;
|
|
property KeyFieldCount: integer read GetKeyFieldCount;
|
|
|
|
property LoggedFieldNames[Index: integer]: string read GetLoggedFieldNames;
|
|
property LoggedFieldCount: integer read GetLoggedFieldCount;
|
|
property LoggedFieldTypes[Index : integer]: TDADataType read GetLoggedFieldTypes write SetLoggedFieldTypes;
|
|
property InChange: boolean read GetInChange;
|
|
|
|
property Changes[Index: integer]: TDADeltaChange read GetChange; default;
|
|
property Count: integer read GetCount;
|
|
//property DataTable: TComponent read fDataTable;
|
|
end;
|
|
|
|
function FormatRecIDString(aRecID: integer): string;
|
|
function NewDelta(aDeltaName: string): IDADelta; overload;
|
|
|
|
function FieldValueToVariant(aSourceField : TDAField) : Variant;
|
|
procedure VariantToFieldValue(const aSourceVariant : Variant; aField : TDAField);
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
Variants, TypInfo,
|
|
uROClient, uROSessions, uROXMLIntf,
|
|
uDARes, uDARegExpr, uDADataTable;
|
|
|
|
function FormatRecIDString(aRecID: integer): string;
|
|
begin
|
|
result := FormatFloat('0000000000', aRecID);
|
|
end;
|
|
|
|
function NewDelta(aDeltaName: string): IDADelta;
|
|
begin
|
|
result := TDADelta.Create(aDeltaName);
|
|
end;
|
|
|
|
{ TDADeltaList }
|
|
|
|
function TDADeltaList.Add(const aDelta: IDADelta): integer;
|
|
begin
|
|
result := inherited Add(aDelta);
|
|
end;
|
|
|
|
function TDADeltaList.DeltaByName(const aDeltaName: string): IDADelta;
|
|
begin
|
|
result := FindDelta(aDeltaName);
|
|
if (result=NIL) then raise Exception.Create('Cannot find delta '+aDeltaName);
|
|
end;
|
|
|
|
function TDADeltaList.FindDelta(const aDeltaName: string): IDADelta;
|
|
var i : integer;
|
|
begin
|
|
result := NIL;
|
|
for i := 0 to (Count-1) do
|
|
if SameText(Deltas[i].LogicalName, aDeltaName) then begin
|
|
result := Deltas[i];
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
function TDADeltaList.GetDeltas(Index: integer): IDADelta;
|
|
begin
|
|
result := inherited Items[Index] as IDADelta;
|
|
end;
|
|
|
|
procedure TDADeltaList.Insert(Index: Integer; const aDelta: IDADelta);
|
|
begin
|
|
inherited Insert(Index, aDelta);
|
|
end;
|
|
|
|
{ TDADelta }
|
|
|
|
constructor TDADelta.Create(const aLogicalName: string);
|
|
begin
|
|
inherited Create;
|
|
|
|
// This error is often generated if the user forgets to set LogicalName in the data table
|
|
if (aLogicalName='') then raise Exception.Create('Cannot create a delta without a name');
|
|
|
|
fLogicalName := aLogicalName;
|
|
|
|
fKeyFields := TStringList.Create;
|
|
fFieldNames := TStringList.Create;
|
|
|
|
fChanges := TStringList.Create;
|
|
fChanges.Duplicates := dupError;
|
|
fChanges.Sorted := TRUE;
|
|
end;
|
|
|
|
constructor TDADelta.Create;
|
|
begin
|
|
Create(NewGuidAsString);
|
|
end;
|
|
|
|
constructor TDADelta.Create(aDataTable: TComponent);
|
|
var i: integer;
|
|
dnme : string;
|
|
dt: TDADataTable;
|
|
begin
|
|
{ AleF: Changed the logic of how delta creation works. The name of the delta is required and, if using
|
|
this overloaded version of create, it will be taken from the datatable.LogicalName.
|
|
This was made to optimize the adapters which, right noiw, require a list of delta names and
|
|
one of deltas. Because of this change, adapters can find the name from the delta itself.
|
|
}
|
|
if (aDataTable=NIL) then raise Exception.Create('Datatable must be assigned');
|
|
dt:=aDataTable as TDADataTable;
|
|
if (dt.LogicalName<>'') then
|
|
dnme := dt.LogicalName
|
|
else
|
|
dnme := dt.Name;
|
|
|
|
Create(dnme); // Calls the constructor above;
|
|
fDataTable := aDataTable;
|
|
|
|
for i := 0 to (dt.Fields.Count - 1) do
|
|
with dt.Fields[i] do begin
|
|
if LogChanges or InPrimaryKey then fFieldNames.Add(Name);
|
|
if InPrimaryKey then fKeyFields.Add(Name);
|
|
end;
|
|
|
|
for i := 0 to (fFieldNames.Count-1) do
|
|
fFieldNames.Objects[i] := TObject(ord(dt.FieldByName(fFieldNames[i]).DataType));
|
|
end;
|
|
|
|
destructor TDADelta.Destroy;
|
|
begin
|
|
// Removes the current change (if new and not yet in the changes list)
|
|
if (fCurrentChange<>NIL) then begin
|
|
if (FindChange(fCurrentChange.RecID)=NIL)
|
|
then FreeAndNIL(fCurrentChange);
|
|
end;
|
|
|
|
if (fChanges<>NIL) then begin
|
|
Clear;
|
|
fChanges.Free;
|
|
end;
|
|
|
|
fFieldNames.Free;
|
|
fKeyFields.Free;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
function TDADelta.GetLoggedFieldCount: integer;
|
|
begin
|
|
result := fFieldNames.Count;
|
|
end;
|
|
|
|
function FieldValueToVariant(aSourceField : TDAField) : Variant;
|
|
var stream : IROStream;
|
|
p : pointer;
|
|
sze : cardinal;
|
|
begin
|
|
case aSourceField.DataType of
|
|
datBlob : begin
|
|
if aSourceField.IsNull {or (aSourceField.BlobSize = 0)} then result := Unassigned
|
|
else begin
|
|
stream := NewROStream;
|
|
aSourceField.SaveToStream(stream);
|
|
sze := stream.Size;
|
|
if stream.Size = 0 then
|
|
result := Unassigned
|
|
else begin
|
|
stream.Position := 0;
|
|
result := VarArrayCreate([0, sze-1], varByte);
|
|
p := VarArrayLock(result);
|
|
try
|
|
stream.Read(p^, sze);
|
|
finally
|
|
VarArrayUnlock(result);
|
|
end;
|
|
stream.Position := 0;
|
|
end;
|
|
end;
|
|
end;
|
|
{$IFDEF DELPHI10UP}
|
|
datWideMemo: Result:= aSourceField.AsWideString;
|
|
{$ENDIF DELPHI10UP}
|
|
else result := aSourceField.Value;
|
|
end;
|
|
end;
|
|
|
|
procedure VariantToFieldValue(const aSourceVariant : Variant; aField : TDAField);
|
|
var stream : IROStream;
|
|
p : pointer;
|
|
readcount, sze : cardinal;
|
|
begin
|
|
case aField.DataType of
|
|
datBlob:
|
|
if VarIsEmpty(aSourceVariant) then begin
|
|
aField.Value := Unassigned;
|
|
end
|
|
else begin
|
|
stream := NewROStream;
|
|
|
|
sze := VarArrayHighBound(aSourceVariant, 1) - VarArrayLowBound(aSourceVariant, 1) + 1;
|
|
p := VarArrayLock(aSourceVariant);
|
|
try
|
|
readcount := stream.Write(p^, sze);
|
|
finally
|
|
VarArrayUnlock(aSourceVariant);
|
|
end;
|
|
|
|
if (readcount<>sze)
|
|
then raise Exception.CreateFmt('Couldn''t read all data. Expected %d read %d', [sze, readcount]);
|
|
|
|
stream.Position := 0;
|
|
aField.LoadFromStream(stream);
|
|
end;
|
|
{$IFDEF DELPHI10UP}
|
|
datWideMemo: aField.AsWideString:=aSourceVariant;
|
|
{$ENDIF DELPHI10UP}
|
|
else aField.Value := aSourceVariant;
|
|
end;
|
|
end;
|
|
|
|
procedure TDADelta.StartChange(aChangeType: TDAChangeType);
|
|
var
|
|
recid: integer;
|
|
x, i: integer;
|
|
begin
|
|
if InChange then RaiseError(err_ChangeLogAlreadyStarted);
|
|
|
|
if not Assigned(fDataTable) then RaiseError(err_NotAttachedToDataTable);
|
|
|
|
fCurrentChangeType := aChangeType;
|
|
|
|
// Checks to see if this is the first time this record was changed
|
|
if (aChangeType <> ctInsert) then begin
|
|
recid := (fDataTable as TDADataTable).RecIDField.AsInteger; // CurrRecId;
|
|
fCurrentChange := FindChange(recid);
|
|
fNewChange := (fCurrentChange = nil);
|
|
end
|
|
else begin
|
|
recid := UndefinedRecordID;
|
|
fNewChange := TRUE;
|
|
end;
|
|
|
|
if fNewChange then begin
|
|
fCurrentChange := TDADeltaChange.Create(Self, recid, aChangeType);
|
|
|
|
// For deletes and edit, we want to store the original values.
|
|
// This happens only once.
|
|
case aChangeType of
|
|
ctDelete, ctUpdate: begin
|
|
with (fDataTable as TDADataTable).Fields do begin
|
|
x := 0;
|
|
for i := 0 to ((fDataTable as TDADataTable).FieldCount - 1) do begin
|
|
if Fields[i].LogChanges or Fields[i].InPrimaryKey then begin
|
|
fCurrentChange.OldValues[x] := FieldValueToVariant(Fields[i]);
|
|
Inc(x);
|
|
end;
|
|
end;
|
|
end;
|
|
end
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TDADelta.CancelChange;
|
|
begin
|
|
//if not Assigned(fDataTable) then RaiseError(err_NotAttachedToDataTable);
|
|
|
|
if fNewChange
|
|
then FreeAndNIL(fCurrentChange); // if it is not a new change (i.e. cancelling an edit) should not free!
|
|
fCurrentChange := nil; // nil it in either case!
|
|
end;
|
|
|
|
procedure TDADelta.EndChange;
|
|
var
|
|
x, i: integer;
|
|
lWasChanged: Boolean;
|
|
lLoggedFieldName: string;
|
|
lNewValue, lOldValue: Variant;
|
|
lDataTable: TDAdataTable;
|
|
begin
|
|
if not Assigned(fDataTable) then RaiseError(err_NotAttachedToDataTable);
|
|
|
|
lDataTable := (fDataTable as TDADataTable);
|
|
|
|
try
|
|
if (fCurrentChange.RecID = UndefinedRecordID)
|
|
then fCurrentChange.RecID := lDataTable.RecIDField.AsInteger // Happens on inserts and first time changes (except deletes)
|
|
|
|
else if (fCurrentChange.RecID <> lDataTable.RecIDField.AsInteger)
|
|
then raise Exception.Create('Record pointer changed!');
|
|
|
|
// Doing a new operation on the same record
|
|
if (fCurrentChange.ChangeType <> fCurrentChangeType) then begin
|
|
case fCurrentChangeType of
|
|
ctDelete: begin
|
|
if (fCurrentChange.ChangeType = ctInsert) then begin // No need to track new records that have been deleted
|
|
RemoveChange(fCurrentChange);
|
|
Exit; // Done!
|
|
end
|
|
else begin
|
|
fCurrentChange.ChangeType := fCurrentChangeType; // Deletes have precedence over anything else
|
|
for i := 0 to (LoggedFieldCount - 1) do
|
|
fCurrentChange.NewValues[i] := UnAssigned;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
case fCurrentChange.ChangeType of
|
|
ctUpdate, ctInsert: begin
|
|
with lDataTable.Fields do begin
|
|
lWasChanged := False;
|
|
x := 0;
|
|
for i := 0 to (lDataTable.FieldCount - 1) do begin
|
|
if Fields[i].LogChanges or Fields[i].InPrimaryKey then begin
|
|
fCurrentChange.NewValues[x] := FieldValueToVariant(Fields[i]);
|
|
|
|
lOldValue := fCurrentChange.OldValues[x];
|
|
lNewValue := fCurrentChange.NewValues[x];
|
|
if fCurrentChange.ChangeType = ctUpdate then begin
|
|
lWasChanged := lWasChanged or not ROVariantsEqual(lOldValue, lNewValue);
|
|
end else begin
|
|
lLoggedFieldName := fCurrentChange.Delta.LoggedFieldNames[x];
|
|
if FieldByName(lLoggedFieldName).InPrimaryKey and VarIsEmpty(lOldValue) then begin
|
|
fCurrentChange.OldValues[x] := lNewValue;
|
|
end;
|
|
end;
|
|
Inc(x);
|
|
end;
|
|
end;
|
|
if (fCurrentChange.ChangeType = ctUpdate) and (not lWasChanged) then begin //The change doesn't affect any fields with LogChanges
|
|
CancelChange;
|
|
Exit; // Done!
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if fNewChange then fChanges.AddObject(FormatRecIDString(fCurrentChange.RecID), fCurrentChange);
|
|
|
|
finally
|
|
// ALEF: added to keep a log of the last change in case a post fails. It will be restored in such case
|
|
// via the InternalOnPostError through a call to RestoreLastChange
|
|
fLastChange := fCurrentChange;
|
|
|
|
fCurrentChange := nil;
|
|
end;
|
|
end;
|
|
|
|
function TDADelta.GetInChange: boolean;
|
|
begin
|
|
result := fCurrentChange <> nil
|
|
end;
|
|
|
|
function TDADelta.FindChange(aRecID: integer): TDADeltaChange;
|
|
var
|
|
idx: integer;
|
|
begin
|
|
result := nil;
|
|
idx := fChanges.IndexOf(FormatRecIDString(aRecID));
|
|
if (idx >= 0) then result := TDADeltaChange(fChanges.Objects[idx]);
|
|
end;
|
|
|
|
function TDADelta.GetCount: integer;
|
|
begin
|
|
result := fChanges.Count;
|
|
end;
|
|
|
|
procedure TDADelta.Clear(DoClearFieldNames: boolean = FALSE; DoClearKeyFieldNames: boolean = FALSE);
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 0 to (fChanges.Count - 1) do
|
|
if (fChanges.Objects[i]<>NIL)
|
|
then fChanges.Objects[i].Free;
|
|
|
|
fChanges.Clear;
|
|
|
|
if DoClearFieldNames then ClearFieldNames;
|
|
if DoClearKeyFieldNames then ClearKeyFieldNames;
|
|
|
|
fCurrPosition := 0;
|
|
end;
|
|
|
|
function TDADelta.GetChange(Index: integer): TDADeltaChange;
|
|
begin
|
|
result := TDADeltaChange(fChanges.Objects[Index]);
|
|
end;
|
|
|
|
procedure TDADelta.RemoveChange(aChange: TDADeltaChange);
|
|
var
|
|
idx: integer;
|
|
begin
|
|
idx := fChanges.IndexOfObject(aChange);
|
|
if (idx >= 0) then begin
|
|
fChanges.Objects[idx].Free;
|
|
fChanges.Delete(idx);
|
|
end;
|
|
end;
|
|
|
|
function TDADelta.GetLoggedFieldNames(Index: integer): string;
|
|
begin
|
|
result := fFieldNames[Index]
|
|
end;
|
|
|
|
procedure TDADelta.AddFieldName(const aFieldName: string);
|
|
begin
|
|
fFieldNames.Add(aFieldName);
|
|
end;
|
|
|
|
procedure TDADelta.ClearFieldNames;
|
|
begin
|
|
fFieldNames.Clear;
|
|
end;
|
|
|
|
procedure TDADelta.Add(aChange: TDADeltaChange);
|
|
begin
|
|
fChanges.AddObject(FormatRecIDString(aChange.RecId), aChange);
|
|
end;
|
|
|
|
procedure TDADelta.Delete(Index: integer);
|
|
begin
|
|
fChanges.Objects[Index].Free;
|
|
fChanges.Delete(Index);
|
|
end;
|
|
|
|
function TDADelta.IndexOfLoggedField(const aName: string): integer;
|
|
begin
|
|
result := fFieldNames.IndexOf(aName)
|
|
end;
|
|
|
|
function TDADelta.GetDelta: TDADelta;
|
|
begin
|
|
result := Self;
|
|
end;
|
|
|
|
function TDADelta.IsNewRecord(aRecordID: integer = -1): boolean;
|
|
var
|
|
recid, i: integer;
|
|
begin
|
|
result := FALSE;
|
|
recid := aRecordID;
|
|
|
|
if (aRecordID = -1) then begin
|
|
if ((fDataTable as TDADataTable).RecordCount > 0) then
|
|
recid := (fDataTable as TDADataTable).GetRowRecIDValue
|
|
else
|
|
Exit;
|
|
end;
|
|
|
|
for i := 0 to Count - 1 do
|
|
if (Changes[i].RecID = recid) then begin
|
|
result := Changes[i].ChangeType = ctInsert;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
function TDADelta.GetKeyFieldCount: integer;
|
|
begin
|
|
result := fKeyFields.Count
|
|
end;
|
|
|
|
function TDADelta.GetKeyFieldNames(Index: integer): string;
|
|
begin
|
|
result := fKeyFields[Index]
|
|
end;
|
|
|
|
procedure TDADelta.ClearKeyFieldNames;
|
|
begin
|
|
fKeyFields.Clear;
|
|
end;
|
|
|
|
procedure TDADelta.AddKeyFieldName(const aKeyFieldName: string);
|
|
begin
|
|
fKeyFields.Add(aKeyFieldName)
|
|
end;
|
|
|
|
function TDADelta.Add(aRecordID: integer; aChangeType: TDAChangeType;
|
|
aStatus: TDAChangeStatus; const aMessage: string): TDADeltaChange;
|
|
begin
|
|
result := TDADeltaChange.Create(Self, aRecordID, aChangeType, aStatus, aMessage);
|
|
Add(result);
|
|
end;
|
|
|
|
function TDADelta.GetFieldCount: integer;
|
|
begin
|
|
result := fFieldNames.Count;
|
|
end;
|
|
|
|
function TDADelta.GetFieldIndexes(const aName: string): integer;
|
|
begin
|
|
result := fFieldNames.IndexOf(aName);
|
|
end;
|
|
|
|
function TDADelta.GetFieldNames(Index: integer): string;
|
|
begin
|
|
result := fFieldNames[Index];
|
|
end;
|
|
|
|
function TDADelta.GetAsBoolean(const FieldName: string): boolean;
|
|
begin
|
|
result := GetVarBoolean(Changes[fCurrPosition].NewValueByName[FieldName]);
|
|
end;
|
|
|
|
function TDADelta.GetAsBoolean(Index: integer): boolean;
|
|
begin
|
|
result := GetVarBoolean(Changes[fCurrPosition].NewValues[Index]);
|
|
end;
|
|
|
|
function TDADelta.GetAsCurrency(Index: integer): currency;
|
|
begin
|
|
result := GetVarCurrency(Changes[fCurrPosition].NewValues[Index]);
|
|
end;
|
|
|
|
function TDADelta.GetAsCurrency(const FieldName: string): currency;
|
|
begin
|
|
result := GetVarCurrency(Changes[fCurrPosition].NewValueByName[FieldName]);
|
|
end;
|
|
|
|
function TDADelta.GetAsDateTime(Index: integer): TDateTime;
|
|
begin
|
|
result := GetVarDateTime(Changes[fCurrPosition].NewValues[Index]);
|
|
end;
|
|
|
|
function TDADelta.GetAsDateTime(const FieldName: string): TDateTime;
|
|
begin
|
|
result := GetVarDateTime(Changes[fCurrPosition].NewValueByName[FieldName]);
|
|
end;
|
|
|
|
function TDADelta.GetAsFloat(Index: integer): double;
|
|
begin
|
|
result := GetVarFloat(Changes[fCurrPosition].NewValues[Index]);
|
|
end;
|
|
|
|
function TDADelta.GetAsFloat(const FieldName: string): double;
|
|
begin
|
|
result := GetVarFloat(Changes[fCurrPosition].NewValueByName[FieldName]);
|
|
end;
|
|
|
|
function TDADelta.GetAsInteger(Index: integer): integer;
|
|
begin
|
|
result := GetVarInteger(Changes[fCurrPosition].NewValues[Index]);
|
|
end;
|
|
|
|
function TDADelta.GetAsInteger(const FieldName: string): integer;
|
|
begin
|
|
result := GetVarInteger(Changes[fCurrPosition].NewValueByName[FieldName]);
|
|
end;
|
|
|
|
function TDADelta.GetAsString(const FieldName: string): string;
|
|
begin
|
|
result := GetVarString(Changes[fCurrPosition].NewValueByName[FieldName]);
|
|
end;
|
|
|
|
function TDADelta.GetAsString(Index: integer): string;
|
|
begin
|
|
result := GetVarString(Changes[fCurrPosition].NewValues[Index]);
|
|
end;
|
|
|
|
function TDADelta.GetAsVariant(Index: integer): variant;
|
|
begin
|
|
result := Changes[fCurrPosition].NewValues[Index];
|
|
end;
|
|
|
|
function TDADelta.GetAsVariant(const FieldName: string): variant;
|
|
begin
|
|
result := Changes[fCurrPosition].NewValueByName[FieldName];
|
|
end;
|
|
|
|
function TDADelta.First: boolean;
|
|
begin
|
|
result := (fChanges.Count > 0);
|
|
if result then fCurrPosition := 0;
|
|
end;
|
|
|
|
function TDADelta.GetRecordCount: integer;
|
|
begin
|
|
result := fChanges.Count;
|
|
end;
|
|
|
|
function TDADelta.Next: boolean;
|
|
begin
|
|
result := (fCurrPosition < fChanges.Count - 1);
|
|
|
|
if result then Inc(fCurrPosition);
|
|
end;
|
|
|
|
function TDADelta.Locate(const KeyFields: string; const KeyValues: Variant;
|
|
Options: TLocateOptions): Boolean;
|
|
begin
|
|
result := FALSE; // Deltas don't support searches for now
|
|
end;
|
|
|
|
function TDADelta.GetLoggedFieldTypes(Index: integer): TDADataType;
|
|
begin
|
|
result := TDADataType(Cardinal(fFieldNames.Objects[Index]));
|
|
end;
|
|
|
|
procedure TDADelta.SetLoggedFieldTypes(anIndex: integer;
|
|
aFieldType: TDADataType);
|
|
begin
|
|
fFieldNames.Objects[anIndex] := TObject(ord(aFieldType));
|
|
end;
|
|
|
|
procedure TDADelta.RestoreLastChange;
|
|
var
|
|
i: integer;
|
|
begin
|
|
fCurrentChange := fLastChange;
|
|
if fNewChange then begin
|
|
i:=fChanges.IndexOf(FormatRecIDString(fCurrentChange.RecID));
|
|
if i <> -1 then fChanges.Delete(i);
|
|
fCurrentChange.RecID := UndefinedRecordID;
|
|
// basically nulls this --> fChanges.AddObject(FormatRecIDString(fCurrentChange.RecID), fCurrentChange);
|
|
end;
|
|
end;
|
|
|
|
function TDADelta.GetCountByStatus(
|
|
aChangeStatus: TDAChangeStatus): integer;
|
|
var i : integer;
|
|
begin
|
|
result := 0;
|
|
for i := 0 to fChanges.Count-1 do begin
|
|
if (Changes[i].Status=aChangeStatus) then Inc(result);
|
|
end;
|
|
end;
|
|
|
|
function TDADelta.GetLogicalName: string;
|
|
begin
|
|
result := fLogicalName;
|
|
end;
|
|
|
|
procedure TDADelta.SetLogicalName(const aName: string);
|
|
begin
|
|
fLogicalName := aName;
|
|
end;
|
|
|
|
procedure TDADelta.AssignDataTable(aDataTable: TComponent);
|
|
begin
|
|
fDataTable := aDataTable as TDADataTable;
|
|
end;
|
|
|
|
{ TDADeltaChange }
|
|
|
|
constructor TDADeltaChange.Create(aDelta: TDADelta;
|
|
aRecID: integer;
|
|
aChangeType: TDAChangeType;
|
|
aStatus: TDAChangeStatus = csPending;
|
|
aMessage: string = '');
|
|
begin
|
|
inherited Create;
|
|
|
|
fRefreshedByServer := FALSE;
|
|
fStatus := aStatus;
|
|
fDelta := aDelta;
|
|
fRecID := aRecID;
|
|
fChangeType := aChangeType;
|
|
fMessage := aMessage;
|
|
|
|
SetLength(fOldValues, aDelta.LoggedFieldCount);
|
|
SetLength(fNewValues, aDelta.LoggedFieldCount);
|
|
end;
|
|
|
|
destructor TDADeltaChange.Destroy;
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
function TDADeltaChange.GetDelta: IDADelta;
|
|
begin
|
|
result := fDelta as IDADelta;
|
|
end;
|
|
|
|
function TDADeltaChange.GetNewValue(const aName: string): Variant;
|
|
var
|
|
idx: integer;
|
|
begin
|
|
idx := fDelta.IndexOfLoggedField(aName);
|
|
if (idx < 0) then RaiseError(err_CannotFindField, [aName]);
|
|
result := fNewValues[idx];
|
|
end;
|
|
|
|
function TDADeltaChange.GetOldValue(const aName: string): Variant;
|
|
var
|
|
idx: integer;
|
|
begin
|
|
idx := fDelta.IndexOfLoggedField(aName);
|
|
if (idx < 0) then RaiseError(err_CannotFindField, [aName]);
|
|
result := fOldValues[idx];
|
|
end;
|
|
|
|
procedure TDADeltaChange.SetNewValue(const aName: string; const Value: Variant);
|
|
var
|
|
idx: integer;
|
|
begin
|
|
idx := fDelta.IndexOfLoggedField(aName);
|
|
if (idx < 0) then RaiseError(err_CannotFindField, [aName]);
|
|
if idx >= Length(fNewValues) then
|
|
SetLength(fNewValues, idx + 1);
|
|
fNewValues[idx] := Value;
|
|
end;
|
|
|
|
procedure TDADeltaChange.SetOldValue(const aName: string; const Value: Variant);
|
|
var
|
|
idx: integer;
|
|
begin
|
|
idx := fDelta.IndexOfLoggedField(aName);
|
|
if (idx < 0) then RaiseError(err_CannotFindField, [aName]);
|
|
if idx >= Length(fOldValues) then
|
|
SetLength(fOldValues, idx + 1);
|
|
fOldValues[idx] := Value;
|
|
end;
|
|
|
|
{ EDAApplyUpdateFailed }
|
|
|
|
constructor EDAApplyUpdateFailed.Create(aChange: TDADeltaChange; anOriginalException: Exception);
|
|
begin
|
|
if (anOriginalException<>NIL) then begin
|
|
inherited Create(anOriginalException.Message);
|
|
end
|
|
else inherited Create('');
|
|
|
|
fRecID := aChange.RecID;
|
|
fDeltaName := aChange.Delta.LogicalName;
|
|
end;
|
|
|
|
initialization
|
|
RegisterExceptionClass(EDAApplyUpdateFailed);
|
|
finalization
|
|
UnregisterExceptionClass(EDAApplyUpdateFailed);
|
|
end.
|