Archivado/Componentes.Terceros.RemObjects
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
e3a5cfc500
Componentes.Terceros.RemObj.../internal/6.0.43.801/1/Data Abstract for Delphi/Source/uDADelta.pas
david 2a98435b14 Importación inicial 
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@68 b6239004-a887-0f4b-9937-50029ccdca16
2010-01-29 16:17:43 +00:00

1456 lines
48 KiB
ObjectPascal
Raw Blame History

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}
{.$DEFINE uDADelta_DEBUG}
interface
uses
Classes, DB, SysUtils,
{$IFDEF MSWINDOWS}Windows,{$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; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
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(aDataTable: TComponent = nil): boolean;
function GetCount: integer;
function GetBlockedRecordCount: 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; const aDataType: TDADataType = datUnknown);
procedure AddKeyFieldName(const aKeyFieldName: string);
procedure ClearFieldNames;
procedure ClearKeyFieldNames;
procedure StartChange(aChangeType: TDAChangeType; aDataTable : TComponent = nil);
procedure CancelChange(aDataTable : TComponent = nil);
procedure CancelChangesInAllTables;
procedure EndChange(aDataTable : TComponent = nil);
procedure EndChangesInAllTables;
procedure RestoreLastChange(aDataTable : TComponent = nil);
function IsCanEditCurrentRow(aDataTable : TComponent): Boolean;
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;
procedure RemoveUnchangedChanges;
procedure RemoveLoggedField(Index: integer); overload;
procedure RemoveLoggedField(AFieldName: string);overload;
property LogicalName : string read GetLogicalName write SetLogicalName;
property Changes[Index: integer]: TDADeltaChange read GetChange; default;
property Count: integer read GetCount;
property BlockedRecordCount: integer read GetBlockedRecordCount;
end;
{ IDADataReader }
IDADataReader = interface
['{7D2FC996-7A04-4ECE-91B0-4F17EFEC4985}']
function GetFieldNames(Index: integer): string; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
function GetFieldIndexes(const aName: string): integer; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
function GetFieldCount: integer; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
function GetRecordCount: integer; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
function GetAsBoolean(Index: integer): boolean; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
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; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
function GetAsString(Index: integer): string; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
function GetAsVariant(Index: integer): variant; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
function GetAsBoolean(const FieldName: string): boolean; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
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; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
function GetAsString(const FieldName: string): string; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
function GetAsVariant(const FieldName: string): variant; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
function First: boolean; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
function Next: boolean; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
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;
PDAChangeRecord = ^TDAChangeRecord;
TDAChangeRecord = record
DataTable: TComponent;
LastChange,
CurrentChange: TDADeltaChange;
NewChange: boolean;
CurrentChangeType: TDAChangeType;
end;
{ TDADelta }
TDADelta = class(TDAEngineBaseObject, IDADelta, IDADataReader)
private
fDataTable: TComponent;
fChanges: TStringList;
fKeyFields,
fFieldNames: TStringList;
fCurrPosition: integer;
fLogicalName : string;
fChangeRecordList: TThreadList;
fBlockedRecordList: TThreadList;
function GetLoggedFieldCount: integer;
function GetInChange(aDataTable: TComponent = nil): 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);
procedure DeleteChange(anIndex : integer);
function GetChangeRecord(aDataTable: TComponent = nil; aCreateIfEmpty: Boolean = False): PDAChangeRecord;
function IsBlockedRecord(aChange: TDADeltaChange):Boolean;overload;
function IsBlockedRecord(aRecID: integer):Boolean;overload;
function BlockRecord(aChange: TDADeltaChange): Boolean;
procedure UnblockRecord(aChange: TDADeltaChange);
function GetBlockedRecordCount: integer;
procedure CanApplyDeltaChanges;
procedure intRemoveChange(aChange: TDADeltaChange);
function TryToLockDelta(aDataTable: TComponent; aRaiseException: Boolean): Boolean;
protected
function GetDelta: TDADelta;
function GetLogicalName : string;
procedure SetLogicalName(const aName : string);
// IDADataReader
function GetFieldNames(Index: integer): string; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
function GetFieldIndexes(const aName: string): integer; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
function GetFieldCount: integer; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
function GetAsBoolean(Index: integer): boolean; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
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; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
function GetAsString(Index: integer): string; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
function GetAsVariant(Index: integer): variant; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
function GetAsBoolean(const FieldName: string): boolean; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
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; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
function GetAsString(const FieldName: string): string; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
function GetAsVariant(const FieldName: string): variant; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
function GetRecordCount: integer; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
function First: boolean; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
function Next: boolean; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
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; const aDataType: TDADataType = datUnknown);
procedure AddKeyFieldName(const aKeyFieldName: string);
procedure ClearFieldNames;
procedure ClearKeyFieldNames;
procedure RemoveUnchangedChanges;
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; aDataTable : TComponent = nil);
procedure CancelChange(aDataTable : TComponent = nil);
procedure CancelChangesInAllTables;
procedure EndChange(aDataTable : TComponent = nil);
procedure EndChangesInAllTables;
procedure RestoreLastChange(aDataTable : TComponent = nil);
function IsCanEditCurrentRow(aDataTable : TComponent): Boolean;
function IsNewRecord(aRecordID: integer = -1): boolean;
function IndexOfLoggedField(const aName: string): integer;
function GetCountByStatus(aChangeStatus : TDAChangeStatus) : integer;
procedure RemoveLoggedField(Index: integer); overload;
procedure RemoveLoggedField(AFieldName: string);overload;
function CurrentChange(aDataTable : TComponent = nil): TDADeltaChange;
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;
function InChange(aDataTable : TComponent = nil): boolean;
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 CreateChangeRecord(aDataTable: TComponent): PDAChangeRecord;
begin
GetMem(Result, SizeOf(TDAChangeRecord));
FillChar(Result^, SizeOf(TDAChangeRecord), 0);
Result^.DataTable := aDataTable;
end;
procedure FreeChangeRecord(aRecord: pointer);
begin
FreeMem(aRecord);
end;
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;
fChangeRecordList:= TThreadList.Create;
fBlockedRecordList:= TThreadList.Create;
end;
constructor TDADelta.Create;
begin
Create(NewGuidAsString);
end;
function TDADelta.CurrentChange(aDataTable: TComponent): TDADeltaChange;
var
lRecord : PDAChangeRecord;
begin
if aDataTable = nil then aDataTable := fDataTable;
lRecord := GetChangeRecord(aDataTable, False);
if Assigned(lRecord) then
Result := lRecord^.CurrentChange
else
Result := nil;
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;
var
lList: TList;
lRecord: PDAChangeRecord;
i: integer;
begin
// Removes the current change (if new and not yet in the changes list)
lList := fChangeRecordList.LockList;
try
for I := 0 to lList.Count - 1 do begin
lRecord := PDAChangeRecord(lList[i]);
if (lRecord <> nil) then
if (lRecord^.CurrentChange<>NIL) then
if (FindChange(lRecord^.CurrentChange.RecID)=NIL) then FreeAndNIL(lRecord^.CurrentChange);
end;
finally
fChangeRecordList.UnlockList;
end;
if (fChanges<>NIL) then begin
Clear;
fChanges.Free;
end;
fFieldNames.Free;
fKeyFields.Free;
fChangeRecordList.Free;
fBlockedRecordList.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 DA_WideMemoSupport}
datXml,
datWideMemo:
if aSourceField.IsNull then
Result := Unassigned
else
Result:= aSourceField.AsWideString;
{$ENDIF}
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
if VarType(aSourceVariant) = varString then begin
aField.AsAnsiString:= VarToAnsiStr(aSourceVariant);
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;
end;
{$IFDEF DA_WideMemoSupport}
datXml,
datWideMemo: aField.AsWideString:=aSourceVariant;
{$ENDIF DA_WideMemoSupport}
else aField.Value := aSourceVariant;
end;
end;
procedure TDADelta.StartChange(aChangeType: TDAChangeType; aDataTable : TComponent = nil);
var
recid: integer;
x, i: integer;
lRecord: PDAChangeRecord;
lChange: TDADeltaChange;
begin
{$IFDEF uDADelta_DEBUG}
OutputDebugString(Pchar('StartChange('+inttoStr(ord(aChangeType))+', $'+inttoHex(Cardinal(aDataTable),8)+')'));
{$ENDIF}
if aDataTable = nil then aDataTable := fDataTable;
if not Assigned(aDataTable) then RaiseError(err_NotAttachedToDataTable);
if not Assigned(fDataTable) then RaiseError(err_NotAttachedToDataTable);
TryToLockDelta(aDataTable, True);
lRecord := GetChangeRecord(aDataTable,True);
if lRecord^.CurrentChange <> nil then RaiseError(err_ChangeLogAlreadyStarted);
// Checks to see if this is the first time this record was changed
if (aChangeType <> ctInsert) then begin
recid := (aDataTable as TDADataTable).GetRowRecIDValue; // CurrRecId;
if IsBlockedRecord(recid) then RaiseError('Cannot edit the record because it is edited by other table');
lChange := FindChange(recid);
if (lChange <> nil) and (not BlockRecord(lChange)) then RaiseError('Cannot edit the record because it is edited by other table');
lRecord^.CurrentChange := lChange;
lRecord^.NewChange := (lChange = nil);
end
else begin
recid := UndefinedRecordID;
lRecord^.NewChange := TRUE;
end;
lRecord^.CurrentChangeType := aChangeType;
if lRecord^.NewChange then begin
lRecord^.CurrentChange := TDADeltaChange.Create(Self, recid, aChangeType);
BlockRecord(lRecord^.CurrentChange);
// 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
lRecord^.CurrentChange.OldValues[x] := FieldValueToVariant(Fields[i]);
Inc(x);
end;
end;
end;
end
end;
end;
end;
procedure TDADelta.UnblockRecord(aChange: TDADeltaChange);
begin
if aChange <> nil then fBlockedRecordList.Remove(aChange);
{$IFDEF uDADelta_DEBUG}
OutputDebugString(Pchar('UnblockRecord($'+inttoHex(integer(aChange),8)+')'));
{$ENDIF}
end;
procedure TDADelta.CanApplyDeltaChanges;
begin
if GetBlockedRecordCount <> 0 then RaiseError('Cannot update delta, some records are under editing!');
end;
procedure TDADelta.CancelChange(aDataTable : TComponent = nil);
var
lRecord: PDAChangeRecord;
begin
{$IFDEF uDADelta_DEBUG}
OutputDebugString(Pchar('CancelChange($'+inttoHex(Cardinal(aDataTable),8)+')'));
{$ENDIF}
if aDataTable = nil then aDataTable := fDataTable;
lRecord := GetChangeRecord(aDataTable,False);
if lRecord = nil then Exit; // no changes for this table
UnblockRecord(lRecord^.CurrentChange);
//if not Assigned(fDataTable) then RaiseError(err_NotAttachedToDataTable);
if lRecord^.NewChange then FreeAndNIL(lRecord^.CurrentChange); // if it is not a new change (i.e. cancelling an edit) should not free!
lRecord^.CurrentChange := nil; // nil it in either case!
end;
procedure TDADelta.CancelChangesInAllTables;
var
i: integer;
lList: TList;
lrecord: PDAChangeRecord;
dt: TDADataTable;
begin
lList:= fChangeRecordList.LockList;
try
for I := 0 to lList.Count - 1 do begin
lrecord := PDAChangeRecord(lList[i]);
if (lrecord^.CurrentChange <> nil) then begin
dt := TDADataTable(lrecord^.DataTable);
if dt.State in [dsInsert, dsEdit] then dt.Cancel;
end;
FreeChangeRecord(lrecord);
end;
lList.Clear;
finally
fChangeRecordList.UnlockList;
end;
end;
function TDADelta.IsCanEditCurrentRow(aDataTable: TComponent): Boolean;
var
recid: integer;
lRecord: PDAChangeRecord;
lChange: TDADeltaChange;
begin
Result := False;
if aDataTable = nil then aDataTable := fDataTable;
if not Assigned(aDataTable) or not Assigned(fDataTable) then exit;
if not TryToLockDelta(aDataTable,False) then Exit;
lRecord := GetChangeRecord(aDataTable, False);
if (lRecord <> nil) and (lRecord^.CurrentChange <> nil) then Exit;
recid := (aDataTable as TDADataTable).GetRowRecIDValue; // CurrRecId;
if IsBlockedRecord(recid) then Exit;
lChange := FindChange(recid);
Result := (lChange = nil) or not IsBlockedRecord(lChange);
end;
function TDADelta.TryToLockDelta(aDataTable: TComponent; aRaiseException: Boolean): Boolean;
var
lList: TList;
i,l: integer;
ldatatable: TDADataTable;
begin
Result := True;
l := 0;
ldatatable := nil;
lList := fChangeRecordList.LockList;
try
for I := 0 to lList.Count - 1 do begin
if PDAChangeRecord(lList[i])^.CurrentChange <> nil then begin
Inc(l);
ldatatable := TDADataTable(PDAChangeRecord(lList[i])^.DataTable);
end;
end;
if l = 0 then
Exit
else if (l = 1) and (ruoOnPost in ldatatable.RemoteUpdatesOptions) then begin
Result := False;
if aRaiseException then RaiseError('Cannot StartChange. Another table (%s) exclusively locks delta.',[lDataTable.Name])
end
else if (ruoOnPost in TDADataTable(adatatable).RemoteUpdatesOptions) then begin
Result := False;
if aRaiseException then RaiseError('%s:Cannot exclusively lock delta. %d change(s) are already started.',[aDataTable.Name,l]);
end;
finally
fChangeRecordList.UnlockList;
end;
end;
procedure TDADelta.EndChange(aDataTable : TComponent = nil);
var
x, i: integer;
lWasChanged: Boolean;
lLoggedFieldName: string;
lNewValue, lOldValue: Variant;
lDataTable: TDAdataTable;
lRecord: PDAChangeRecord;
begin
{$IFDEF uDADelta_DEBUG}
OutputDebugString(Pchar('EndChange($'+inttoHex(Cardinal(aDataTable),8)+')'));
{$ENDIF}
if aDataTable = nil then aDataTable := fDataTable;
if not Assigned(aDataTable) then RaiseError(err_NotAttachedToDataTable);
if not Assigned(fDataTable) then RaiseError(err_NotAttachedToDataTable);
lRecord := GetChangeRecord(aDataTable,False);
if not Assigned(lRecord) then begin
if (aDataTable <> fDataTable) then
RaiseError('Delta is not been started for %s',[aDataTable.Name])
else
RaiseError('Delta is not been started');
end;
lDataTable := (aDataTable as TDADataTable);
try
if (lRecord^.CurrentChange.RecID = UndefinedRecordID) then
lRecord^.CurrentChange.RecID := lDataTable.GetRowRecIDValue // Happens on inserts and first time changes (except deletes)
else if (lRecord^.CurrentChange.RecID <> lDataTable.GetRowRecIDValue)then
raise Exception.Create('Record pointer changed!');
// Doing a new operation on the same record
if (lRecord^.CurrentChange.ChangeType <> lRecord^.CurrentChangeType) then begin
case lRecord^.CurrentChangeType of
ctDelete: begin
if (lRecord^.CurrentChange.ChangeType = ctInsert) then begin // No need to track new records that have been deleted
UnblockRecord(lRecord^.CurrentChange);
intRemoveChange(lRecord^.CurrentChange);
lRecord^.CurrentChange := nil;
Exit; // Done!
end
else begin
lRecord^.CurrentChange.ChangeType := lRecord^.CurrentChangeType; // Deletes have precedence over anything else
for i := 0 to (LoggedFieldCount - 1) do
lRecord^.CurrentChange.NewValues[i] := UnAssigned;
end;
end;
end;
end;
case lRecord^.CurrentChange.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
lRecord^.CurrentChange.NewValues[x] := FieldValueToVariant(Fields[i]);
lOldValue := null; // fix for "Invalid Variant Type" exception in Win2000
lNewValue := null; // fix for "Invalid Variant Type" exception in Win2000
lOldValue := lRecord^.CurrentChange.OldValues[x];
lNewValue := lRecord^.CurrentChange.NewValues[x];
if lRecord^.CurrentChange.ChangeType = ctUpdate then begin
lWasChanged := lWasChanged or not ROVariantsEqual(lOldValue, lNewValue);
end else begin
lLoggedFieldName := lRecord^.CurrentChange.Delta.LoggedFieldNames[x];
if FieldByName(lLoggedFieldName).InPrimaryKey {and VarIsEmpty(lOldValue)} then begin
lRecord^.CurrentChange.OldValues[x] := lNewValue;
end;
end;
Inc(x);
end;
end;
if (lRecord^.CurrentChange.ChangeType = ctUpdate) and (not lWasChanged) then begin //The change doesn't affect any fields with LogChanges
CancelChange(aDataTable);
Exit; // Done!
end;
end;
end;
end;
if lRecord^.NewChange then fChanges.AddObject(FormatRecIDString(lRecord^.CurrentChange.RecID), lRecord^.CurrentChange);
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
UnblockRecord(lRecord^.CurrentChange);
lRecord^.LastChange := lRecord^.CurrentChange;
lRecord^.CurrentChange := nil;
end;
end;
procedure TDADelta.EndChangesInAllTables;
var
i: integer;
lList: TList;
lrecord: PDAChangeRecord;
dt: TDADataTable;
begin
lList:= fChangeRecordList.LockList;
try
for I := 0 to lList.Count - 1 do begin
lrecord := PDAChangeRecord(lList[i]);
if (lrecord^.CurrentChange <> nil) then begin
dt := TDADataTable(lrecord^.DataTable);
if dt.State in [dsInsert, dsEdit] then dt.Post;
end;
end;
finally
fChangeRecordList.UnlockList;
end;
end;
function TDADelta.GetInChange(aDataTable: TComponent = nil): boolean;
var
lRecord : PDAChangeRecord;
begin
if aDataTable = nil then aDataTable := fDataTable;
lRecord := GetChangeRecord(aDataTable, False);
Result := Assigned(lRecord) and (lRecord^.CurrentChange <> 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
CancelChangesInAllTables;
CanApplyDeltaChanges;
for i := 0 to (fChanges.Count - 1) do
if (fChanges.Objects[i]<>NIL) then fChanges.Objects[i].Free;
fChanges.Clear;
if DoClearFieldNames then fFieldNames.Clear;
if DoClearKeyFieldNames then ClearKeyFieldNames;
fCurrPosition := 0;
end;
function TDADelta.GetChange(Index: integer): TDADeltaChange;
begin
result := TDADeltaChange(fChanges.Objects[Index]);
end;
function TDADelta.GetChangeRecord(aDataTable: TComponent = nil; aCreateIfEmpty: Boolean = False): PDAChangeRecord;
var
i : integer;
lList: TList;
begin
lList := fChangeRecordList.LockList;
try
for i := 0 to LList.Count - 1 do begin
Result := PDAChangeRecord(lList[i]);
if Result^.DataTable = aDataTable then Exit;
end;
Result := CreateChangeRecord(aDataTable);
llist.Add(Result);
finally
fChangeRecordList.UnlockList;
end;
end;
procedure TDADelta.RemoveChange(aChange: TDADeltaChange);
begin
if IsBlockedRecord(aChange) then RaiseError('Cannot delete change, it is under editing!');
intRemoveChange(aChange);
end;
procedure TDADelta.RemoveLoggedField(Index: integer);
var
i,j: integer;
lChange: TDADeltaChange;
begin
CanApplyDeltaChanges;
// don't have to validate for Index because it is validated in "fFieldNames[Index]"
i := fKeyFields.IndexOf(fFieldNames[Index]);
if i <> -1 then fKeyFields.Delete(i);
for i := 0 to Count - 1 do begin
lChange := GetChange(i);
for j := Index to LoggedFieldCount - 2 do begin
lChange.OldValues[j] := lChange.OldValues[j+1];
lChange.NewValues[j] := lChange.NewValues[j+1];
end;
SetLength(lChange.fOldValues, LoggedFieldCount-1);
SetLength(lChange.fNewValues, LoggedFieldCount-1);
end;
fFieldNames.Delete(Index);
end;
procedure TDADelta.RemoveLoggedField(AFieldName: string);
var
i: integer;
begin
i := IndexOfLoggedField(AFieldName);
if i = -1 then
RaiseError(err_CannotFindField, [aFieldName])
else
RemoveLoggedField(i);
end;
function TDADelta.GetLoggedFieldNames(Index: integer): string;
begin
result := fFieldNames[Index]
end;
procedure TDADelta.AddFieldName(const aFieldName: string; const aDataType: TDADataType = datUnknown);
var
i: integer;
lChange: TDADeltaChange;
begin
CanApplyDeltaChanges;
fFieldNames.AddObject(aFieldName, TObject(ord(aDataType)));
for i := 0 to Count - 1 do begin
lChange := GetChange(i);
SetLength(lChange.fOldValues, LoggedFieldCount);
SetLength(lChange.fNewValues, LoggedFieldCount);
end;
end;
procedure TDADelta.ClearFieldNames;
begin
Clear(True,False);
end;
procedure TDADelta.Add(aChange: TDADeltaChange);
begin
fChanges.AddObject(FormatRecIDString(aChange.RecId), aChange);
end;
procedure TDADelta.Delete(Index: integer);
begin
if IsBlockedRecord(TDADeltaChange(fChanges.Objects[Index])) then RaiseError('Cannot delete change, it is under editing!');
DeleteChange(Index);
end;
function TDADelta.InChange(aDataTable: TComponent = nil): boolean;
begin
if aDataTable = nil then aDataTable := fDataTable;
Result := GetInChange(aDataTable);
end;
function TDADelta.IndexOfLoggedField(const aName: string): integer;
begin
result := fFieldNames.IndexOf(aName)
end;
function TDADelta.GetDelta: TDADelta;
begin
result := Self;
end;
function TDADelta.IsBlockedRecord(aChange: TDADeltaChange): Boolean;
var
lList: TList;
begin
lList := fBlockedRecordList.LockList;
try
Result := lList.IndexOf(aChange) <> -1;
finally
fBlockedRecordList.UnlockList;
end;
{$IFDEF uDADelta_DEBUG}
OutputDebugString(Pchar('IsBlockedRecord($'+inttoHex(integer(aChange),8)+')= ' + BoolToStr(Result,True)));
{$ENDIF}
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
if IndexOfLoggedField(aKeyFieldName) = -1 then raise EDAException.CreateFmt('%s should be in LoggedField', [aKeyFieldName]);
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.GetBlockedRecordCount: integer;
var
lList: TList;
begin
lList := fBlockedRecordList.LockList;
try
Result := lList.Count;
finally
fBlockedRecordList.UnlockList;
end;
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(aDataTable : TComponent = nil);
var
i: integer;
lRecord: PDAChangeRecord;
begin
{$IFDEF uDADelta_DEBUG}
OutputDebugString(Pchar('RestoreLastChange($'+inttoHex(Cardinal(aDataTable),8)+')'));
{$ENDIF}
if aDataTable = nil then aDataTable := fDataTable;
lRecord := GetChangeRecord(aDataTable,False);
if lRecord = nil then Exit; // we can't restore if no operations were here
if (lRecord^.LastChange = nil) and (fChanges.Count=1) and (aDataTable = fDataTable) and
(fDataTable <>nil) and (fDataTable is TDADataTable) and
(ruoOnPost in TDADataTable(fDataTable).RemoteUpdatesOptions) and
(TDADataTable(fDataTable).State in [dsEdit,dsInsert]) then
lRecord^.LastChange := Changes[0];
if (lRecord^.LastChange <> nil) and (FindChange(lRecord^.LastChange.fRecID) = nil) then lRecord^.LastChange := nil;
lRecord^.CurrentChange := lRecord^.LastChange;
if lRecord^.NewChange and (lRecord^.CurrentChange <> nil) then begin
i:=fChanges.IndexOf(FormatRecIDString(lRecord^.CurrentChange.RecID));
if i <> -1 then fChanges.Delete(i);
lRecord^.CurrentChange.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;
function TDADelta.BlockRecord(aChange: TDADeltaChange): Boolean;
begin
Result := not IsBlockedRecord(aChange);
if Result then fBlockedRecordList.Add(aChange);
{$IFDEF uDADelta_DEBUG}
OutputDebugString(Pchar('BlockRecord($'+inttoHex(integer(aChange),8)+')= ' + BoolToStr(Result,True)));
{$ENDIF}
end;
procedure TDADelta.RemoveUnchangedChanges;
function isUnchangedChange(aChange: TDADeltaChange): boolean;
var
i: integer;
begin
Result:= (aChange.Status = csPending) and (aChange.fChangeType = ctUpdate);
if result then
For i := 0 to LoggedFieldCount-1 do begin
if not ROVariantsEqual(aChange.OldValues[i],aChange.NewValues[i]) then begin
Result:=False;
Break;
end;
end;
end;
var
i,j: integer;
lList: TList;
lRecord: PDAChangeRecord;
begin
CanApplyDeltaChanges;
lList := fChangeRecordList.LockList;
try
For i:= Count-1 downto 0 do
if isUnchangedChange(Changes[i]) then begin
for j := 0 to lList.Count - 1 do begin
lRecord := PDAChangeRecord(lList[j]);
if Assigned(lRecord) then
if lRecord^.CurrentChange = Changes[i] then lRecord^.CurrentChange := nil;
end;
DeleteChange(i);
end;
finally
fChangeRecordList.UnlockList;
end;
end;
procedure TDADelta.DeleteChange(anIndex: integer);
begin
fChanges.Objects[anIndex].Free;
fChanges.Delete(anIndex);
end;
procedure TDADelta.intRemoveChange(aChange: TDADeltaChange);
var
idx: integer;
begin
idx := fChanges.IndexOfObject(aChange);
if (idx >= 0) then DeleteChange(idx);
end;
function TDADelta.IsBlockedRecord(aRecID: integer): Boolean;
var
lList: TList;
i: integer;
begin
Result := False;
lList := fBlockedRecordList.LockList;
try
for i := 0 to lList.Count -1 do begin
if TDADeltaChange(lList[i]).fRecID = aRecID then begin
Result := True;
Break;
end;
end;
finally
fBlockedRecordList.UnlockList;
end;
{$IFDEF uDADelta_DEBUG}
OutputDebugString(Pchar('IsBlockedRecord('+inttoStr(aRecID)+')= ' + BoolToStr(Result,True)));
{$ENDIF}
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]);
//exists problem with uninitialized variant in Win 2000
result := Null;
//
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]);
//exists problem with uninitialized variant in Win 2000
result := Null;
//
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.
Reference in New Issue View Git Blame Copy Permalink