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
761 lines
22 KiB
ObjectPascal
761 lines
22 KiB
ObjectPascal
unit uDACDSDataTable;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ Data Abstract Library - Core Library }
|
|
{ }
|
|
{ compiler: Delphi 6 and up }
|
|
{ platform: Win32 }
|
|
{ }
|
|
{ (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, uDAInterfaces, uDADataTable, DBClient;
|
|
|
|
|
|
const
|
|
DAFormatToCDSFormat : array[TDANativeDataFormat] of TDataPacketFormat = (dfBinary, dfXML);
|
|
|
|
type
|
|
TDACDSDataTable = class;
|
|
|
|
{ IDAClonedCursorsSupport }
|
|
IDAClonedCursorsSupport = interface
|
|
['{A43A70A2-7438-4C21-B2E2-A5212082EFD0}']
|
|
function GetCloneSource : TDACDSDataTable; safecall;
|
|
procedure CloneCursor(Source : TDACDSDataTable); safecall;
|
|
function GetUsingClonedCursor : boolean; safecall;
|
|
|
|
property CloneSource : TDACDSDataTable read GetCloneSource;
|
|
property UsingClonedCursor : boolean read GetUsingClonedCursor;
|
|
end;
|
|
|
|
{ TDAClientdataset }
|
|
TDAClientdataset = class(TClientDataset, IDADataTableDataset)
|
|
private
|
|
function GetActive: boolean;
|
|
|
|
protected
|
|
function GetDataTable: TDADataTable; safecall;
|
|
procedure InternalRefresh; override;
|
|
function GetStateFieldValue(State: TDataSetState;
|
|
Field: TField): Variant; override;
|
|
public
|
|
{$IFDEF DELPHI7UP}
|
|
procedure GetFieldNames(List: TStrings); override;
|
|
{$ENDIF}
|
|
published
|
|
property Active: boolean read GetActive;
|
|
end;
|
|
|
|
{ TDACDSDataTable }
|
|
TDACDSDataTable = class(TDADataTable, IDAClonedCursorsSupport, IDARangeController, IDANativeDatasetStreaming,IDASimpleClonedCursorsSupport)
|
|
private
|
|
fMasterSource : TDADataSource;
|
|
fClientDataset: TClientDataSet;
|
|
fCloneSource : TDACDSDataTable;
|
|
fWasReadonly : Boolean;
|
|
fOldValues : array of Variant;
|
|
protected
|
|
function GetCurrRecId: integer; override;
|
|
procedure SetCurrRecId(const Value: integer); override;
|
|
|
|
function GetAutoIncs: TAutoIncArray; override;
|
|
procedure SetAutoIncs(const Value: TAutoIncArray); override;
|
|
|
|
function GetDatasetClass: TDatasetClass; override;
|
|
procedure CreateInternalFields(aDataset: TDataset; someFieldDefinitions: TDAFieldCollection); override;
|
|
procedure DoSort(const FieldNames: array of string; const Directions: array of TDASortDirection); override;
|
|
|
|
procedure DoBeforeOpenDataset; override;
|
|
procedure DoAfterCloseDataset; override;
|
|
|
|
procedure SetMasterSource(const Value: TDADataSource); override;
|
|
function GetMasterSource: TDADataSource; override;
|
|
procedure SetDetailsFields(const Value: string); override;
|
|
procedure SetMasterFields(const Value: string); override;
|
|
function GetDetailFields: string; override;
|
|
function GetMasterFields: string; override;
|
|
|
|
function GetIndexDefs: TIndexDefs;
|
|
procedure SetIndexDefs(const Value: TIndexDefs);
|
|
function GetIndexName: string;
|
|
procedure SetIndexName(const Value: string);
|
|
|
|
function GetFilter: string; override;
|
|
function GetFiltered: boolean; override;
|
|
procedure SetFilter(const Value: string); override;
|
|
procedure SetFiltered(const Value: boolean); override;
|
|
|
|
function GetReadOnly: boolean; override;
|
|
procedure SetReadOnly(const Value: boolean); override;
|
|
|
|
{ Overrides to support IDAClonedCursorsSupport }
|
|
procedure InternalAfterPost(Sender: TDataset); override;
|
|
procedure InternalBeforeInsert(Sender: TDataset); override;
|
|
procedure InternalBeforeDelete(Sender: TDataset); override;
|
|
procedure InternalBeforeEdit(Sender: TDataset); override;
|
|
procedure DoBeforeCloseDataset; override;
|
|
|
|
public
|
|
constructor Create(aOwner: TComponent); override;
|
|
|
|
function ApplyUpdates(RefetchAll: boolean = FALSE): boolean; override;
|
|
|
|
procedure FindNearest(const KeyValues: array of const);
|
|
|
|
{ IDASimpleClonedCursorsSupport }
|
|
function GetSimpleCloneSource : TObject;
|
|
{ IDAClonedCursorsSupport }
|
|
procedure CloneCursor(Source : TDACDSDataTable); safecall;
|
|
function GetCloneSource : TDACDSDataTable; safecall;
|
|
function GetUsingClonedCursor : boolean; safecall;
|
|
|
|
{ IDANativeDatasetStreaming }
|
|
procedure NativeSaveToFile(const aFileName : string; DataFormat : TDANativeDataFormat = ndfBinary);
|
|
procedure NativeLoadFromFile(const aFileName : string);
|
|
procedure NativeSaveToStream(aStream : TStream; DataFormat : TDANativeDataFormat = ndfBinary);
|
|
procedure NativeLoadFromStream(aStream : TStream);
|
|
|
|
{ IDARangeController }
|
|
procedure ApplyRange; safecall;
|
|
procedure CancelRange; safecall;
|
|
procedure SetRange(const StartValues, EndValues: array of const); safecall;
|
|
procedure EditRangeEnd; safecall;
|
|
procedure EditRangeStart; safecall;
|
|
procedure SetRangeEnd; safecall;
|
|
procedure SetRangeStart; safecall;
|
|
|
|
property CloneSource : TDACDSDataTable read GetCloneSource;
|
|
property UsingClonedCursor : boolean read GetUsingClonedCursor;
|
|
procedure DisableConstraints; override; safecall;
|
|
procedure EnableConstraints; override; safecall;
|
|
procedure CheckProperties(ACheckRemoteFetching: Boolean=False); override;
|
|
published
|
|
property IndexDefs: TIndexDefs read GetIndexDefs write SetIndexDefs;
|
|
property IndexName: string read GetIndexName write SetIndexName;
|
|
|
|
end;
|
|
|
|
// Table for quick CRC Calculations. Used to generate unique index names when sorting
|
|
const crctable : array [0..255] of cardinal =
|
|
(
|
|
$00000000, $77073096, $EE0E612C, $990951BA,
|
|
$076DC419, $706AF48F, $E963A535, $9E6495A3,
|
|
$0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988,
|
|
$09B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91,
|
|
$1DB71064, $6AB020F2, $F3B97148, $84BE41DE,
|
|
$1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7,
|
|
$136C9856, $646BA8C0, $FD62F97A, $8A65C9EC,
|
|
$14015C4F, $63066CD9, $FA0F3D63, $8D080DF5,
|
|
$3B6E20C8, $4C69105E, $D56041E4, $A2677172,
|
|
$3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B,
|
|
$35B5A8FA, $42B2986C, $DBBBC9D6, $ACBCF940,
|
|
$32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59,
|
|
$26D930AC, $51DE003A, $C8D75180, $BFD06116,
|
|
$21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F,
|
|
$2802B89E, $5F058808, $C60CD9B2, $B10BE924,
|
|
$2F6F7C87, $58684C11, $C1611DAB, $B6662D3D,
|
|
$76DC4190, $01DB7106, $98D220BC, $EFD5102A,
|
|
$71B18589, $06B6B51F, $9FBFE4A5, $E8B8D433,
|
|
$7807C9A2, $0F00F934, $9609A88E, $E10E9818,
|
|
$7F6A0DBB, $086D3D2D, $91646C97, $E6635C01,
|
|
$6B6B51F4, $1C6C6162, $856530D8, $F262004E,
|
|
$6C0695ED, $1B01A57B, $8208F4C1, $F50FC457,
|
|
$65B0D9C6, $12B7E950, $8BBEB8EA, $FCB9887C,
|
|
$62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65,
|
|
$4DB26158, $3AB551CE, $A3BC0074, $D4BB30E2,
|
|
$4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB,
|
|
$4369E96A, $346ED9FC, $AD678846, $DA60B8D0,
|
|
$44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9,
|
|
$5005713C, $270241AA, $BE0B1010, $C90C2086,
|
|
$5768B525, $206F85B3, $B966D409, $CE61E49F,
|
|
$5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4,
|
|
$59B33D17, $2EB40D81, $B7BD5C3B, $C0BA6CAD,
|
|
$EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A,
|
|
$EAD54739, $9DD277AF, $04DB2615, $73DC1683,
|
|
$E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8,
|
|
$E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1,
|
|
$F00F9344, $8708A3D2, $1E01F268, $6906C2FE,
|
|
$F762575D, $806567CB, $196C3671, $6E6B06E7,
|
|
$FED41B76, $89D32BE0, $10DA7A5A, $67DD4ACC,
|
|
$F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5,
|
|
$D6D6A3E8, $A1D1937E, $38D8C2C4, $4FDFF252,
|
|
$D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B,
|
|
$D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60,
|
|
$DF60EFC3, $A867DF55, $316E8EEF, $4669BE79,
|
|
$CB61B38C, $BC66831A, $256FD2A0, $5268E236,
|
|
$CC0C7795, $BB0B4703, $220216B9, $5505262F,
|
|
$C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04,
|
|
$C2D7FFA7, $B5D0CF31, $2CD99E8B, $5BDEAE1D,
|
|
$9B64C2B0, $EC63F226, $756AA39C, $026D930A,
|
|
$9C0906A9, $EB0E363F, $72076785, $05005713,
|
|
$95BF4A82, $E2B87A14, $7BB12BAE, $0CB61B38,
|
|
$92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21,
|
|
$86D3D2D4, $F1D4E242, $68DDB3F8, $1FDA836E,
|
|
$81BE16CD, $F6B9265B, $6FB077E1, $18B74777,
|
|
$88085AE6, $FF0F6A70, $66063BCA, $11010B5C,
|
|
$8F659EFF, $F862AE69, $616BFFD3, $166CCF45,
|
|
$A00AE278, $D70DD2EE, $4E048354, $3903B3C2,
|
|
$A7672661, $D06016F7, $4969474D, $3E6E77DB,
|
|
$AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0,
|
|
$A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9,
|
|
$BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6,
|
|
$BAD03605, $CDD70693, $54DE5729, $23D967BF,
|
|
$B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94,
|
|
$B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D
|
|
);
|
|
|
|
function CRC(S : String):LongInt;
|
|
|
|
implementation
|
|
|
|
uses Variants, SysUtils, uDAClasses;
|
|
|
|
{ TDACDSDataTable }
|
|
|
|
constructor TDACDSDataTable.Create(aOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
|
|
fClientDataset := TClientDataSet(Dataset);
|
|
fClientDataset.FetchOnDemand := FALSE;
|
|
fClientDataset.FilterOptions := [foCaseInsensitive];
|
|
end;
|
|
|
|
procedure TDACDSDataTable.CreateInternalFields(aDataset: TDataset; someFieldDefinitions: TDAFieldCollection);
|
|
begin
|
|
inherited;
|
|
|
|
// Creates the dataset
|
|
if not MasterLink.Active then begin
|
|
// This should actually never happen since its mutually exclusive with IndexFieldNames...
|
|
if (fClientDataset.IndexName<>'') then
|
|
fClientDataset.IndexName := '';
|
|
end;
|
|
|
|
fClientDataset.CreateDataSet;
|
|
//fClientDataset.LogChanges := FALSE;
|
|
{ Unfortunately a bug in the CDS provents us to disable the log.
|
|
Tables with multiple blob fields behave weird and lose data otherwise.
|
|
The Issue has been reported to Borland. }
|
|
end;
|
|
|
|
// CRC routine in ASM.
|
|
// NOTE: This routine strips the signed bit from the CRC.
|
|
// Written and posted on Google by Clifford Hammerschmidt
|
|
// http://www.engr.uvic.ca/~chammers/
|
|
// http://www.ultranet.ca/chcc/
|
|
function CRC(S : String):LongInt;
|
|
var
|
|
Len,crc : LongInt;
|
|
K : PChar;
|
|
begin
|
|
Len := Length(S);
|
|
K := PChar(S);
|
|
asm
|
|
mov dword ptr [crc],$ffffffff
|
|
@@2:
|
|
dec dword ptr [len]
|
|
cmp dword ptr [len],$FFFFFFFF
|
|
je @@1
|
|
mov eax,dword ptr [K]
|
|
movsx eax,byte ptr [eax]
|
|
mov ecx,dword ptr [crc]
|
|
sar ecx,$18
|
|
xor eax,ecx
|
|
and eax,$000000ff
|
|
mov eax,dword ptr [crctable+eax*$4]
|
|
mov ecx,dword ptr [crc]
|
|
shl ecx,$08
|
|
xor eax,ecx
|
|
mov dword ptr [crc],eax
|
|
inc dword ptr [K]
|
|
jmp @@2
|
|
@@1:
|
|
// NOTE: From here on the asm is optional...
|
|
mov eax,dword ptr [crc]
|
|
not eax
|
|
// Next line strips signed bit...
|
|
and eax,$7fffffff
|
|
mov dword ptr [crc],eax
|
|
end;
|
|
|
|
Result := crc;
|
|
end;
|
|
|
|
procedure TDACDSDataTable.DoSort(const FieldNames: array of string; const Directions: array of TDASortDirection);
|
|
const
|
|
DirectionStr: array[TDASortDirection] of string = ('ASC', 'DESC');
|
|
var
|
|
ascfields, descfields,
|
|
idxname: string;
|
|
i: integer;
|
|
idx: TIndexDef;
|
|
begin
|
|
with fClientDataset do begin
|
|
if (Length(FieldNames) = 0) then begin
|
|
IndexName := '';
|
|
Exit;
|
|
end;
|
|
|
|
idxname := '';
|
|
for i := 0 to Length(FieldNames) - 1 do
|
|
idxname := idxname + FieldNames[i] + '_' + DirectionStr[Directions[i]];
|
|
|
|
idxname := 'IDX'+IntToStr(CRC(idxname));
|
|
|
|
idx := TDefCollection(IndexDefs).Find(idxname) as TIndexDef;
|
|
if (idx = nil) then begin
|
|
ascfields := '';
|
|
descfields := '';
|
|
|
|
for i := 0 to Length(Directions) - 1 do begin
|
|
ascfields := ascfields + FieldNames[i] + ';'; //<-- IDX.Fields must include ALL Fieldnames
|
|
if Directions[i] = sdDescending then
|
|
descfields := descfields + FieldNames[i] + ';';
|
|
end;
|
|
|
|
idx := fClientDataset.IndexDefs.AddIndexDef;
|
|
idx.Name := idxname;
|
|
idx.DescFields := descfields;
|
|
idx.Fields := ascfields;
|
|
end;
|
|
|
|
IndexName := idxname;
|
|
end;
|
|
end;
|
|
|
|
function TDACDSDataTable.GetDatasetClass: TDatasetClass;
|
|
begin
|
|
result := TDAClientDataset;
|
|
end;
|
|
|
|
function TDACDSDataTable.GetMasterSource: TDADataSource;
|
|
begin
|
|
result := fMasterSource;
|
|
end;
|
|
|
|
procedure TDACDSDataTable.DoAfterCloseDataset;
|
|
begin
|
|
inherited;
|
|
fClientDataset.Data := Null;
|
|
fCloneSource := NIL;
|
|
end;
|
|
|
|
function TDACDSDataTable.GetFilter: string;
|
|
begin
|
|
result := fClientDataset.Filter
|
|
end;
|
|
|
|
//////////////
|
|
procedure TDACDSDataTable.DoBeforeOpenDataset;
|
|
begin
|
|
inherited;
|
|
|
|
// This helps prevending a design time problem which results in DetailFields being reset
|
|
// whenever something is wrong or the dataset cannot be open properly
|
|
// Keep in this orders!!!
|
|
|
|
{ fClientDataset.IndexFieldNames := fDetailFields;
|
|
fClientDataset.MasterFields := fMasterFields;
|
|
fClientDataset.MasterSource := fMasterSource;}
|
|
end;
|
|
|
|
procedure TDACDSDataTable.SetMasterSource(const Value: TDADataSource);
|
|
begin
|
|
fClientDataset.MasterSource := Value;
|
|
fMasterSource := Value;
|
|
|
|
inherited SetMasterSource(Value);
|
|
end;
|
|
|
|
procedure TDACDSDataTable.SetMasterFields(const Value: string);
|
|
begin
|
|
fClientDataset.MasterFields := Value;
|
|
|
|
inherited;
|
|
//fMasterFields := Value;
|
|
end;
|
|
|
|
procedure TDACDSDataTable.SetDetailsFields(const Value: string);
|
|
begin
|
|
fClientDataset.IndexFieldNames := Value
|
|
//fDetailFields := Value;
|
|
end;
|
|
|
|
function TDACDSDataTable.GetDetailFields: string;
|
|
begin
|
|
result := fClientDataset.IndexFieldNames
|
|
//result := fDetailFields
|
|
end;
|
|
|
|
function TDACDSDataTable.GetMasterFields: string;
|
|
begin
|
|
result := fClientDataset.MasterFields
|
|
//result := fMasterFields
|
|
end;
|
|
///////////
|
|
|
|
function TDACDSDataTable.GetFiltered: boolean;
|
|
begin
|
|
result := fClientDataset.Filtered
|
|
end;
|
|
|
|
procedure TDACDSDataTable.SetFilter(const Value: string);
|
|
begin
|
|
fClientDataset.Filter := Value
|
|
end;
|
|
|
|
procedure TDACDSDataTable.SetFiltered(const Value: boolean);
|
|
begin
|
|
fClientDataset.Filtered := Value
|
|
end;
|
|
|
|
function TDACDSDataTable.GetIndexDefs: TIndexDefs;
|
|
begin
|
|
result := fClientDataset.IndexDefs
|
|
end;
|
|
|
|
procedure TDACDSDataTable.SetIndexDefs(const Value: TIndexDefs);
|
|
begin
|
|
fClientDataset.IndexDefs.Assign(Value);
|
|
end;
|
|
|
|
function TDACDSDataTable.GetIndexName: string;
|
|
begin
|
|
result := fClientDataset.IndexName
|
|
end;
|
|
|
|
procedure TDACDSDataTable.SetIndexName(const Value: string);
|
|
begin
|
|
fClientDataset.IndexName := Value
|
|
end;
|
|
|
|
function TDACDSDataTable.GetReadOnly: boolean;
|
|
begin
|
|
result := fClientDataset.ReadOnly
|
|
end;
|
|
|
|
procedure TDACDSDataTable.SetReadOnly(const Value: boolean);
|
|
begin
|
|
fClientDataset.ReadOnly := Value
|
|
end;
|
|
|
|
procedure TDACDSDataTable.CloneCursor(Source: TDACDSDataTable);
|
|
var i: integer;
|
|
begin
|
|
if Active then raise Exception.Create('Datatable is already open');
|
|
|
|
try
|
|
fCloneSource := Source;
|
|
|
|
Fields.Clear;
|
|
Fields.Assign(Source.Fields);
|
|
|
|
// Lookup fields are not cloned by the CDS. We must remove them
|
|
for i := (Fields.Count-1) downto 0 do
|
|
if Fields[i].Lookup then Fields.Delete(i);
|
|
|
|
// Proceeds
|
|
fClientDataset.CloneCursor(Source.Dataset as TClientDataset, False);
|
|
|
|
RecIDField := fClientDataset.FieldByName(RecIDFieldName) as TIntegerField;
|
|
RecIDField.Visible := FALSE;
|
|
|
|
Fields.Bind(fClientDataset);
|
|
|
|
// Prepares the delta
|
|
Delta := Source.Delta;
|
|
|
|
// Finishes to prepare the internal dataset (descendant might need additional customization and might not be open)
|
|
DoBeforeOpenDataset;
|
|
if not Dataset.Active then Dataset.Open;
|
|
DoAfterOpenDataset;
|
|
except
|
|
// Restores the previous state
|
|
fCloneSource := NIL;
|
|
Delta := NIL;
|
|
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
procedure TDACDSDataTable.ApplyRange;
|
|
begin
|
|
fClientDataset.ApplyRange
|
|
end;
|
|
|
|
procedure TDACDSDataTable.CancelRange;
|
|
begin
|
|
fClientDataset.CancelRange
|
|
end;
|
|
|
|
procedure TDACDSDataTable.EditRangeEnd;
|
|
begin
|
|
fClientDataset.EditRangeEnd
|
|
end;
|
|
|
|
procedure TDACDSDataTable.EditRangeStart;
|
|
begin
|
|
fClientDataset.EditRangeStart
|
|
end;
|
|
|
|
procedure TDACDSDataTable.SetRange(const StartValues,
|
|
EndValues: array of const);
|
|
begin
|
|
fClientDataset.SetRange(StartValues, EndValues);
|
|
end;
|
|
|
|
procedure TDACDSDataTable.SetRangeEnd;
|
|
begin
|
|
fClientDataset.SetRangeEnd
|
|
end;
|
|
|
|
procedure TDACDSDataTable.SetRangeStart;
|
|
begin
|
|
fClientDataset.SetRangeStart
|
|
end;
|
|
|
|
procedure TDACDSDataTable.InternalBeforeDelete(Sender: TDataset);
|
|
begin
|
|
if UsingClonedCursor and DeltaInitialized then Delta.AssignDataTable(Self);
|
|
try
|
|
inherited;
|
|
finally
|
|
if UsingClonedCursor and HasDelta then Delta.AssignDataTable(fCloneSource);
|
|
end;
|
|
end;
|
|
|
|
procedure TDACDSDataTable.InternalBeforeEdit(Sender: TDataset);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if UsingClonedCursor and DeltaInitialized then Delta.AssignDataTable(Self);
|
|
try
|
|
inherited;
|
|
SetLength(fOldValues, Dataset.Fields.Count);
|
|
for i := 0 to Length(fOldValues) -1 do
|
|
fOldValues[i] := Dataset.Fields[i].Value;
|
|
except
|
|
// Somehow the edit failed, so we restore the original data table to the delta
|
|
if UsingClonedCursor and HasDelta then Delta.AssignDataTable(fCloneSource);
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
procedure TDACDSDataTable.InternalBeforeInsert(Sender: TDataset);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if UsingClonedCursor and DeltaInitialized then Delta.AssignDataTable(Self);
|
|
try
|
|
inherited;
|
|
SetLength(fOldValues, FieldCount);
|
|
for i := 0 to Length(fOldValues) -1 do
|
|
fOldValues[i] := null;
|
|
except
|
|
// Somehow the insert failed, so we restore the original data table to the delta
|
|
if UsingClonedCursor and HasDelta then Delta.AssignDataTable(fCloneSource);
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
procedure TDACDSDataTable.InternalAfterPost(Sender: TDataset);
|
|
begin
|
|
try
|
|
inherited;
|
|
finally
|
|
// Finally restores the original datatable to the delta
|
|
if UsingClonedCursor and DeltaInitialized then Delta.AssignDataTable(fCloneSource);
|
|
end;
|
|
end;
|
|
|
|
function TDACDSDataTable.GetCloneSource: TDACDSDataTable;
|
|
begin
|
|
result := fCloneSource
|
|
end;
|
|
|
|
procedure TDACDSDataTable.DoBeforeCloseDataset;
|
|
begin
|
|
if (fCloneSource<>NIL)
|
|
then Fields.Clear;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDACDSDataTable.NativeLoadFromFile(const aFileName: string);
|
|
var fs : TFileStream;
|
|
begin
|
|
fs := TFileStream.Create(aFileName, fmOpenRead+fmShareDenyWrite);
|
|
try
|
|
NativeLoadFromStream(fs);
|
|
finally
|
|
fs.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TDACDSDataTable.NativeSaveToFile(const aFileName: string;
|
|
DataFormat: TDANativeDataFormat);
|
|
var fs : TFileStream;
|
|
begin
|
|
fs := TFileStream.Create(aFileName, fmCreate);
|
|
try
|
|
NativeSaveToStream(fs, DataFormat);
|
|
finally
|
|
fs.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TDACDSDataTable.NativeLoadFromStream(aStream : TStream);
|
|
var oldrf : boolean;
|
|
ls : TDASchema;
|
|
begin
|
|
oldrf := RemoteFetchEnabled;
|
|
ls := LocalSchema;
|
|
try
|
|
RemoteFetchEnabled := FALSE;
|
|
ls := NIL;
|
|
|
|
if not Active then Active := TRUE
|
|
else if DeltaInitialized then Delta.Clear;
|
|
|
|
fClientDataset.LoadFromStream(aStream);
|
|
finally
|
|
RemoteFetchEnabled := oldrf;
|
|
LocalSchema := ls;
|
|
end;
|
|
end;
|
|
|
|
procedure TDACDSDataTable.NativeSaveToStream(aStream : TStream;
|
|
DataFormat: TDANativeDataFormat);
|
|
begin
|
|
fClientDataset.SaveToStream(aStream, DAFormatToCDSFormat[DataFormat]);
|
|
end;
|
|
|
|
function TDACDSDataTable.ApplyUpdates(RefetchAll: boolean): boolean;
|
|
begin
|
|
if (fCloneSource<>NIL)
|
|
then result := fCloneSource.ApplyUpdates(RefetchAll)
|
|
|
|
else result := inherited ApplyUpdates(RefetchAll);
|
|
end;
|
|
|
|
function TDACDSDataTable.GetUsingClonedCursor: boolean;
|
|
begin
|
|
result := fCloneSource<>NIL
|
|
end;
|
|
|
|
function TDACDSDataTable.GetCurrRecId: integer;
|
|
begin
|
|
if CloneSource = nil then
|
|
result := inherited GetCurrRecId
|
|
else
|
|
result := CloneSource.CurrRecId;
|
|
end;
|
|
|
|
procedure TDACDSDataTable.SetCurrRecId(const Value: integer);
|
|
begin
|
|
if CloneSource = nil then
|
|
inherited SetCurrRecId(Value)
|
|
else
|
|
CloneSource.CurrRecId := Value
|
|
end;
|
|
|
|
function TDACDSDataTable.GetAutoIncs: TAutoIncArray;
|
|
begin
|
|
if CloneSource = nil then
|
|
result := inherited GetAutoIncs
|
|
else
|
|
result := CloneSource.AutoIncs;
|
|
end;
|
|
|
|
procedure TDACDSDataTable.SetAutoIncs(const Value: TAutoIncArray);
|
|
begin
|
|
if CloneSource = nil then
|
|
inherited SetAutoIncs(Value)
|
|
else
|
|
CloneSource.AutoIncs := Value
|
|
end;
|
|
|
|
procedure TDACDSDataTable.DisableConstraints;
|
|
begin
|
|
fWasReadonly := ReadOnly;
|
|
ReadOnly := False;
|
|
fClientDataset.DisableConstraints;
|
|
end;
|
|
|
|
procedure TDACDSDataTable.EnableConstraints;
|
|
begin
|
|
fClientDataset.EnableConstraints;
|
|
ReadOnly := fWasReadonly;
|
|
end;
|
|
|
|
procedure TDACDSDataTable.FindNearest(const KeyValues: array of const);
|
|
begin
|
|
fClientDataset.FindNearest(KeyValues);
|
|
end;
|
|
|
|
procedure TDACDSDataTable.CheckProperties(ACheckRemoteFetching: Boolean);
|
|
begin
|
|
if (fCloneSource<>NIL) then
|
|
fCloneSource.CheckProperties
|
|
else
|
|
inherited CheckProperties;
|
|
end;
|
|
|
|
function TDACDSDataTable.GetSimpleCloneSource: TObject;
|
|
begin
|
|
Result:=GetCloneSource;
|
|
end;
|
|
|
|
{ TDAClientdataset }
|
|
|
|
function TDAClientdataset.GetActive: boolean;
|
|
begin
|
|
result := inherited Active;
|
|
end;
|
|
|
|
function TDAClientdataset.GetDataTable: TDADataTable;
|
|
begin
|
|
result := TDADataTable(Owner);
|
|
end;
|
|
{$IFDEF DELPHI7UP}
|
|
procedure TDAClientdataset.GetFieldNames(List: TStrings);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if (not inherited Active) then
|
|
begin
|
|
for i := 0 to TDADataTable(Owner).FieldCount -1 do
|
|
List.Add(TDADataTable(Owner).Fields[i].Name);
|
|
exit;
|
|
end;
|
|
{$IFDEF DELPHI10UP}{$WARN SYMBOL_DEPRECATED OFF}{$ENDIF}
|
|
inherited GetFieldNames(List);
|
|
{$IFDEF DELPHI10UP}{$WARN SYMBOL_DEPRECATED ON}{$ENDIF}
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TDAClientdataset.GetStateFieldValue(State: TDataSetState;
|
|
Field: TField): Variant;
|
|
begin
|
|
if (State = dsOldValue) and (Self.State in [dsEdit, dsInsert]) then
|
|
Result := TDACDSDataTable(Owner).fOldValues[Field.Index]
|
|
else
|
|
result := Inherited GetStateFieldValue(State, Field);
|
|
end;
|
|
|
|
procedure TDAClientdataset.InternalRefresh;
|
|
begin
|
|
// Does nothing
|
|
end;
|
|
|
|
end.
|