561 lines
16 KiB
ObjectPascal
561 lines
16 KiB
ObjectPascal
unit uDAMemDataTable;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ 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, uDAInterfaces,
|
|
uDADataTable, uDAMemDataset;
|
|
|
|
type
|
|
TDAMemDataset = class(TDAMemoryDataset, IDADataTableDataset)
|
|
private
|
|
FDeletedRecordsList: TStringList;
|
|
FLogDeletedRecords: Boolean;
|
|
procedure ClearDeletedRecords;
|
|
protected
|
|
function GetDataTable: TDADataTable; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure InternalRefresh; override;
|
|
procedure InternalInitFieldDefs; override;
|
|
procedure InternalOpen; override;
|
|
function GetStateFieldValue(State: TDataSetState;Field: TField): Variant; {$IFNDEF FPC}override;{$ENDIF}
|
|
procedure InternalDelete; override;
|
|
procedure InternalInsert; override;
|
|
procedure InternalPost; override;
|
|
procedure InternalClose; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy;override;
|
|
end;
|
|
|
|
TDAMemDataTable = class(TDADataTable,IDAMemDatasetBatchAdding,IDARangeController)
|
|
private
|
|
fMemDataset: TDAMemDataset;
|
|
fWasReadonly: Boolean;
|
|
function GetIndexDefs: TIndexDefs;
|
|
function GetIndexName: string;
|
|
procedure SetIndexDefs(const Value: TIndexDefs);
|
|
procedure SetIndexName(const Value: string);
|
|
function GetIndexFieldNames: string;
|
|
procedure SetIndexFieldNames(const Value: string);
|
|
function GetAutoCompactRecords: boolean;
|
|
procedure SetAutoPackRecords(const Value: boolean);
|
|
protected
|
|
// IDAMemDatasetBatchAdding
|
|
function AllocRecordBuffer: PAnsiChar;
|
|
procedure FreeRecordBuffer(var Buffer: PAnsiChar);
|
|
function GetFieldNativeBuffer(Buffer: PAnsiChar; Field: TField): Pointer;
|
|
function MakeBlobFromString(Blob:AnsiString):pointer;
|
|
procedure SetNullMask(Buffer: PAnsiChar; Field: TField; const Value: boolean);
|
|
procedure SetAnsiString(NativeBuf: Pointer; Field: TField; const Value: Ansistring);
|
|
procedure SetWideString(NativeBuf: Pointer; Field: TField; const Value: Widestring);
|
|
procedure AddRecordsfromList(AList: TList);
|
|
protected
|
|
function GetDatasetClass: TDatasetClass; override;
|
|
procedure CreateInternalFields(aDataset: TDataset; someFieldDefinitions: TDAFieldCollection); override;
|
|
// procedure DoAfterCloseDataset; override;
|
|
procedure DoSort(const FieldNames: array of string; const Directions: array of TDASortDirection); 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 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;
|
|
public
|
|
constructor Create(aOwner: TComponent); override;
|
|
procedure EnableConstraints; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure DisableConstraints; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure CloneCursor(Source: TDADataTable); override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
{ IDARangeController }
|
|
procedure ApplyRange; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure CancelRange; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure SetRange(const StartValues, EndValues: array of const); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure EditRangeEnd; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure EditRangeStart; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure SetRangeEnd; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure SetRangeStart; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
//
|
|
procedure SetKey;
|
|
procedure EditKey;
|
|
function FindKey(const KeyValues: array of const): Boolean;
|
|
procedure FindNearest(const KeyValues: array of const);
|
|
function GotoKey: Boolean;
|
|
procedure GotoNearest;
|
|
function LocateByIndex(const aIndexName: string; const KeyValues: Variant): Boolean;
|
|
function LookupByIndex(const aIndexName: string; const KeyValues: Variant; const ResultFields: string): Variant;
|
|
procedure PrepareIndexForSorting(const aIndexName: string = '');
|
|
published
|
|
property IndexDefs: TIndexDefs read GetIndexDefs write SetIndexDefs;
|
|
property IndexName: string read GetIndexName write SetIndexName;
|
|
property IndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames;
|
|
property AutoCompactRecords: boolean read GetAutoCompactRecords write SetAutoPackRecords default False;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
uses SysUtils;
|
|
|
|
{ TDAMemDataset }
|
|
|
|
|
|
procedure TDAMemDataset.ClearDeletedRecords;
|
|
var
|
|
buf: Dataset_PAnsiChar;
|
|
begin
|
|
while FDeletedRecordsList.Count <> 0 do begin
|
|
buf := Pointer(FDeletedRecordsList.Objects[FDeletedRecordsList.Count-1]);
|
|
FreeRecordBuffer(Buf);
|
|
FDeletedRecordsList.Delete(FDeletedRecordsList.Count-1);
|
|
end;
|
|
end;
|
|
|
|
constructor TDAMemDataset.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FDeletedRecordsList := TStringList.Create;
|
|
FLogDeletedRecords := True;
|
|
end;
|
|
|
|
destructor TDAMemDataset.Destroy;
|
|
begin
|
|
inherited;
|
|
ClearDeletedRecords;
|
|
FDeletedRecordsList.Free;
|
|
end;
|
|
|
|
function TDAMemDataset.GetDataTable: TDADataTable;
|
|
begin
|
|
result := TDADataTable(Owner);
|
|
end;
|
|
|
|
function TDAMemDataset.GetStateFieldValue(State: TDataSetState;
|
|
Field: TField): Variant;
|
|
begin
|
|
if (State = dsOldValue) and (Self.State in [dsEdit, dsInsert]) then
|
|
Result := TDAMemDataTable(GetDataTable).fOldValues[Field.Index]
|
|
else
|
|
{$IFNDEF FPC} result := Inherited GetStateFieldValue(State, Field){$ENDIF};
|
|
end;
|
|
|
|
procedure TDAMemDataset.InternalClose;
|
|
begin
|
|
ClearDeletedRecords;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDAMemDataset.InternalDelete;
|
|
var
|
|
buf: pointer;
|
|
begin
|
|
if FLogDeletedRecords and (GetDataTable.LogChanges) then begin
|
|
buf := CreateMemDatasetRecord(mrEmpty,0,True);
|
|
RecordToBuffer(CurrentRecord, buf);
|
|
FDeletedRecordsList.AddObject(Self.Fields[0].AsString, buf);
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDAMemDataset.InternalInitFieldDefs;
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDAMemDataset.InternalInsert;
|
|
var
|
|
fCurRec: String;
|
|
i: integer;
|
|
buf1: Pointer;
|
|
begin
|
|
if FLogDeletedRecords then begin
|
|
fCurRec := IntToStr(GetDataTable.CurrRecId);
|
|
i := FDeletedRecordsList.IndexOf(fCurRec);
|
|
if i <> -1 then begin
|
|
buf1:=ActiveBuffer;
|
|
DuplicateBuffer(Pointer(FDeletedRecordsList.Objects[i]), buf1, True);
|
|
end;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDAMemDataset.InternalOpen;
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDAMemDataset.InternalPost;
|
|
var
|
|
i: integer;
|
|
buf: Dataset_PAnsiChar;
|
|
begin
|
|
inherited;
|
|
if FLogDeletedRecords and (State = dsInsert) then begin
|
|
i := FDeletedRecordsList.IndexOf(Fields[0].AsString);
|
|
if i <> -1 then begin
|
|
buf := pointer(FDeletedRecordsList.Objects[i]);
|
|
FreeRecordBuffer(buf);
|
|
FDeletedRecordsList.Delete(i);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAMemDataset.InternalRefresh;
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
{ TDAMemDataTable }
|
|
|
|
|
|
procedure TDAMemDataTable.AddRecordsfromList(AList: TList);
|
|
var
|
|
i: integer;
|
|
Buffer: PAnsiChar;
|
|
FRecIDOffset: Cardinal;
|
|
begin
|
|
FRecIDOffset := fMemDataset.GetBin2FieldOffset(0);
|
|
// setup RecID
|
|
For i:=0 to AList.Count-1 do begin
|
|
buffer:=AList[i];
|
|
PCardinal(PMemDatasetrecord_Native(Buffer)^.Data+FRecIDOffset)^:=CurrRecId;
|
|
fMemDataset.SetNullMask(PMemDatasetrecord_Native(Buffer)^.Data,0,False); //RECID
|
|
CurrRecId:=CurrRecId+1;
|
|
end;
|
|
fMemDataset.AddRecordsfromList(AList);
|
|
fMemDataset.ProcessFilter;
|
|
end;
|
|
|
|
function TDAMemDataTable.AllocRecordBuffer: PAnsiChar;
|
|
begin
|
|
Result:= Pointer(fMemDataset.CreateMemDatasetRecord(mrBin2Style,0,False));
|
|
end;
|
|
|
|
procedure TDAMemDataTable.ApplyRange;
|
|
begin
|
|
fMemDataset.ApplyRange;
|
|
end;
|
|
|
|
procedure TDAMemDataTable.CancelRange;
|
|
begin
|
|
fMemDataset.CancelRange;
|
|
end;
|
|
|
|
procedure TDAMemDataTable.CloneCursor(Source: TDADataTable);
|
|
begin
|
|
if Source = nil then Exception.Create('CloneCursor. Source should be specified.');
|
|
if not (Source is TDAMemDataTable) then Exception.Create('Can''t clone cursor from ' + Source.ClassName);
|
|
|
|
if Active then raise Exception.Create('Datatable is already open');
|
|
|
|
try
|
|
fCloneSource := Source;
|
|
|
|
Fields.Clear;
|
|
Fields.Assign(Source.Fields);
|
|
|
|
// Proceeds
|
|
fMemDataset.CloneCursor(Source.Dataset as TDAMemDataset, False);
|
|
|
|
RecIDField := fMemDataset.FieldByName(RecIDFieldName) as TIntegerField;
|
|
RecIDField.Visible := FALSE;
|
|
|
|
Fields.Bind(fMemDataset);
|
|
|
|
// 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;
|
|
|
|
constructor TDAMemDataTable.Create(aOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
fMemDataset := TDAMemDataset(Dataset);
|
|
end;
|
|
|
|
procedure TDAMemDataTable.CreateInternalFields(aDataset: TDataset;
|
|
someFieldDefinitions: TDAFieldCollection);
|
|
begin
|
|
inherited;
|
|
fMemDataset.Open;
|
|
end;
|
|
|
|
procedure TDAMemDataTable.DisableConstraints;
|
|
begin
|
|
fWasReadonly := ReadOnly;
|
|
ReadOnly := False;
|
|
// fMemDataset.DisableConstraints;
|
|
end;
|
|
|
|
procedure TDAMemDataTable.DoSort(const FieldNames: array of string;
|
|
const Directions: array of TDASortDirection);
|
|
var
|
|
i: integer;
|
|
s,s1: string;
|
|
begin
|
|
if Length(FieldNames) <> Length(Directions) then DatabaseError('Can''t perform sorting: FieldNames and Directions should have same dimension.');
|
|
s := '';
|
|
s1:='';
|
|
for i := Low(FieldNames) to High(FieldNames) do begin
|
|
s := s + FieldNames[i] + ';';
|
|
if Directions[i] = sdDescending then
|
|
s1 := s1 + FieldNames[i] + ';';
|
|
end;
|
|
fMemDataset.SortOnFields(s,'',s1);
|
|
end;
|
|
|
|
procedure TDAMemDataTable.EditKey;
|
|
begin
|
|
fMemDataset.EditKey;
|
|
end;
|
|
|
|
procedure TDAMemDataTable.EditRangeEnd;
|
|
begin
|
|
fMemDataset.EditRangeEnd;
|
|
end;
|
|
|
|
procedure TDAMemDataTable.EditRangeStart;
|
|
begin
|
|
fMemDataset.EditRangeStart;
|
|
end;
|
|
|
|
procedure TDAMemDataTable.EnableConstraints;
|
|
begin
|
|
//fMemDataset.EnableConstraints;
|
|
ReadOnly := fWasReadonly;
|
|
end;
|
|
|
|
function TDAMemDataTable.FindKey(const KeyValues: array of const): Boolean;
|
|
begin
|
|
Result := fMemDataset.FindKey(KeyValues);
|
|
end;
|
|
|
|
procedure TDAMemDataTable.FindNearest(const KeyValues: array of const);
|
|
begin
|
|
fMemDataset.FindNearest(KeyValues);
|
|
end;
|
|
|
|
procedure TDAMemDataTable.FreeRecordBuffer(var Buffer: PAnsiChar);
|
|
begin
|
|
fMemDataset.FreeMemDatasetRecord(PMemDatasetrecord_Native(Buffer));
|
|
Buffer := nil;
|
|
end;
|
|
|
|
function TDAMemDataTable.GetAutoCompactRecords: boolean;
|
|
begin
|
|
Result := fMemDataset.AutoCompactRecords;
|
|
end;
|
|
|
|
function TDAMemDataTable.GetDatasetClass: TDatasetClass;
|
|
begin
|
|
Result := TDAMemDataset;
|
|
end;
|
|
|
|
function TDAMemDataTable.GetDetailFields: string;
|
|
begin
|
|
result := fMemDataset.DetailFields;
|
|
end;
|
|
|
|
function TDAMemDataTable.GetFieldNativeBuffer(Buffer: PAnsiChar;
|
|
Field: TField): Pointer;
|
|
begin
|
|
Result:= fMemDataset.IntFindFieldData(PMemDatasetrecord_Native(Buffer)^.Data, Field, True);
|
|
end;
|
|
|
|
function TDAMemDataTable.GetFilter: string;
|
|
begin
|
|
Result := fMemDataset.Filter;
|
|
end;
|
|
|
|
function TDAMemDataTable.GetFiltered: boolean;
|
|
begin
|
|
Result := fMemDataset.Filtered;
|
|
end;
|
|
|
|
function TDAMemDataTable.GetIndexDefs: TIndexDefs;
|
|
begin
|
|
result := fMemDataset.IndexDefs;
|
|
end;
|
|
|
|
function TDAMemDataTable.GetIndexFieldNames: string;
|
|
begin
|
|
Result := fMemDataset.IndexFieldNames;
|
|
end;
|
|
|
|
function TDAMemDataTable.GetIndexName: string;
|
|
begin
|
|
result := fMemDataset.IndexName;
|
|
end;
|
|
|
|
function TDAMemDataTable.GetMasterFields: string;
|
|
begin
|
|
result := fMemDataset.MasterFields
|
|
end;
|
|
|
|
function TDAMemDataTable.GetMasterSource: TDADataSource;
|
|
begin
|
|
result := TDADataSource(fMemDataset.DataSource);
|
|
end;
|
|
|
|
function TDAMemDataTable.GetReadOnly: boolean;
|
|
begin
|
|
Result := fMemDataset.ReadOnly;
|
|
end;
|
|
|
|
function TDAMemDataTable.GotoKey: Boolean;
|
|
begin
|
|
Result := fMemDataset.GotoKey;
|
|
end;
|
|
|
|
procedure TDAMemDataTable.GotoNearest;
|
|
begin
|
|
fMemDataset.GotoNearest;
|
|
end;
|
|
|
|
function TDAMemDataTable.LocateByIndex(const aIndexName: string;
|
|
const KeyValues: Variant): Boolean;
|
|
begin
|
|
Result:= fMemDataset.LocateByIndex(aIndexName,KeyValues);
|
|
end;
|
|
|
|
function TDAMemDataTable.LookupByIndex(const aIndexName: string;
|
|
const KeyValues: Variant; const ResultFields: string): Variant;
|
|
begin
|
|
Result:= fMemDataset.LookupByIndex(aIndexName,KeyValues,ResultFields);
|
|
end;
|
|
|
|
function TDAMemDataTable.MakeBlobFromString(Blob: AnsiString): pointer;
|
|
begin
|
|
Result:= fMemDataset.MakeBlobFromString(Blob);
|
|
end;
|
|
|
|
procedure TDAMemDataTable.PrepareIndexForSorting(const aIndexName: string);
|
|
begin
|
|
fMemDataset.PrepareIndexForSorting(aIndexName);
|
|
end;
|
|
|
|
procedure TDAMemDataTable.SetAnsiString(NativeBuf: Pointer; Field: TField;
|
|
const Value: Ansistring);
|
|
begin
|
|
fMemDataset.SetAnsiString(NativeBuf,Field, Value);
|
|
end;
|
|
|
|
procedure TDAMemDataTable.SetAutoPackRecords(const Value: boolean);
|
|
begin
|
|
fMemDataset.AutoCompactRecords := Value;
|
|
end;
|
|
|
|
procedure TDAMemDataTable.SetDetailsFields(const Value: string);
|
|
begin
|
|
fMemDataset.DetailFields := Value
|
|
end;
|
|
|
|
procedure TDAMemDataTable.SetFilter(const Value: string);
|
|
begin
|
|
fMemDataset.Filter := Value;
|
|
end;
|
|
|
|
procedure TDAMemDataTable.SetFiltered(const Value: boolean);
|
|
begin
|
|
fMemDataset.Filtered := Value;
|
|
end;
|
|
|
|
procedure TDAMemDataTable.SetIndexDefs(const Value: TIndexDefs);
|
|
begin
|
|
fMemDataset.IndexDefs.Assign(Value);
|
|
end;
|
|
|
|
procedure TDAMemDataTable.SetIndexFieldNames(const Value: string);
|
|
begin
|
|
fMemDataset.IndexFieldNames := Value;
|
|
end;
|
|
|
|
procedure TDAMemDataTable.SetIndexName(const Value: string);
|
|
begin
|
|
fMemDataset.IndexName:=Value;
|
|
end;
|
|
|
|
procedure TDAMemDataTable.SetKey;
|
|
begin
|
|
fMemDataset.SetKey;
|
|
end;
|
|
|
|
procedure TDAMemDataTable.SetMasterFields(const Value: string);
|
|
begin
|
|
inherited;
|
|
fMemDataset.MasterFields := Value
|
|
end;
|
|
|
|
procedure TDAMemDataTable.SetMasterSource(const Value: TDADataSource);
|
|
begin
|
|
fMemDataset.MasterSource := Value;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDAMemDataTable.SetNullMask(Buffer: PAnsiChar; Field: TField;
|
|
const Value: boolean);
|
|
begin
|
|
fMemDataset.SetNullMask(Dataset_PAnsiChar(Buffer),Field.Index,Value);
|
|
end;
|
|
|
|
procedure TDAMemDataTable.SetRange(const StartValues,
|
|
EndValues: array of const);
|
|
begin
|
|
fMemDataset.SetRange(StartValues, EndValues);
|
|
end;
|
|
|
|
procedure TDAMemDataTable.SetRangeEnd;
|
|
begin
|
|
fMemDataset.SetRangeEnd;
|
|
end;
|
|
|
|
procedure TDAMemDataTable.SetRangeStart;
|
|
begin
|
|
fMemDataset.SetRangeStart;
|
|
end;
|
|
|
|
procedure TDAMemDataTable.SetReadOnly(const Value: boolean);
|
|
begin
|
|
fMemDataset.ReadOnly := Value;
|
|
end;
|
|
|
|
procedure TDAMemDataTable.SetWideString(NativeBuf: Pointer; Field: TField;
|
|
const Value: Widestring);
|
|
begin
|
|
fMemDataset.SetWideString(NativeBuf, Field, Value);
|
|
end;
|
|
|
|
end.
|
|
|