[fpc-devel]Some questions about tdataset and a small patch
Joost van der Sluis
joost at cnoc.nl
Tue Aug 3 01:06:06 CEST 2004
Hi all,
i have some fixes/additions:
- With the patch in the attached dataset.inc.diff(2) tdataset now posts
changes before scrolling to another record (ie first, next etc.) like
Delphi does.
- In interbase.pp.diff(2) the ExecuteDirect method is added to TIBDatabase
And further i've implemented an BufferAllRecords property for
TDataset like i suggested earlier. I don't know if you guys like this
solution, but have a look at it. It works perfect with
interbase (tibquery doesn't work properly without it) but also with
tDbf.
If BufferAllRecords is set to true, all fetched records will be kept in
memory. For tibquery this is the default.
(patch is in db.pp.diff, interbase.pp.diff, dataset.inc.diff)
Joost van der Sluis.
(reminder:)
> 3: Add a property to TDataset, which changes the behaviour of the buffers,
> so that they are 'infinitive'. All fetched records are kept in memory. The
> descendents that need this can set this property in their
> create-functions. Delphi has something like this, if you set the
> buffercount to -1.
>
> I think i'm going to try to implement option three. But what do you all
> think about this issue?
-------------- next part --------------
Index: interbase.pp
===================================================================
RCS file: /FPC/CVS/fpc/fcl/db/interbase/interbase.pp,v
retrieving revision 1.13
diff -u -r1.13 interbase.pp
--- interbase.pp 25 Jul 2004 11:32:40 -0000 1.13
+++ interbase.pp 2 Aug 2004 22:20:43 -0000
@@ -1068,7 +1086,7 @@
procedure TIBQuery.InternalFirst;
begin
- FCurrentRecord := -1;
+// FCurrentRecord := -1;
end;
procedure TIBQuery.InternalGotoBookmark(ABookmark: Pointer);
@@ -1189,6 +1207,7 @@
constructor TIBQuery.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
+ setBufferAllRecords(true);
FSQL := TStringList.Create;
FCurrentRecord := -1;
AllocSQLDA(10);
-------------- next part --------------
Index: interbase.pp
===================================================================
RCS file: /FPC/CVS/fpc/fcl/db/interbase/interbase.pp,v
retrieving revision 1.13
diff -u -r1.13 interbase.pp
--- interbase.pp 25 Jul 2004 11:32:40 -0000 1.13
+++ interbase.pp 2 Aug 2004 22:20:43 -0000
@@ -68,6 +68,7 @@
public
procedure StartTransaction; override;
procedure EndTransaction; override;
+ function ExecuteDirect(SQL : string) : integer;
destructor Destroy; override;
property Handle: Pointer read GetHandle;
published
@@ -391,6 +392,23 @@
raise EInterBaseError.Create('Cannot assign transaction while old transaction active!');
end;
+function TIBDatabase.ExecuteDirect(SQL : string) : integer;
+
+var tr : pointer;
+
+begin
+ if FTransaction = nil then
+ raise EDatabaseError.Create('TIBDatabase.ExecuteDirect: Transaction not set');
+
+// tr has to be zero to create a database
+{ if not FTransaction.Active then
+ FTransaction.StartTransaction;}
+
+ tr := FTransaction.GetHandle;
+
+ result := isc_dsql_execute_immediate(@FStatus[0], @FIBDatabaseHandle, @tr,0, at SQL[1],1,nil);
+end;
+
function TIBDatabase.GetHandle: pointer;
begin
Result := FIBDatabaseHandle;
-------------- next part --------------
Index: db.pp
===================================================================
RCS file: /FPC/CVS/fpc/fcl/db/db.pp,v
retrieving revision 1.19
diff -u -r1.19 db.pp
--- db.pp 25 Jul 2004 11:32:40 -0000 1.19
+++ db.pp 2 Aug 2004 22:25:31 -0000
@@ -827,6 +827,7 @@
FRecordCount: Longint;
FRecordSize: Word;
FState : TDataSetState;
+ FBufferAllRecords : Boolean;
Procedure DoInsertAppend(DoAppend : Boolean);
Procedure DoInternalOpen;
Procedure DoInternalClose;
@@ -913,6 +914,7 @@
procedure SetOnFilterRecord(const Value: TFilterRecordEvent); virtual;
procedure SetRecNo(Value: Longint); virtual;
procedure SetState(Value: TDataSetState);
+ procedure SetBufferAllRecords(Value : Boolean);
function SetTempState(const Value: TDataSetState): TDataSetState;
function TempBuffer: PChar;
procedure UpdateIndexDefs; virtual;
@@ -1020,6 +1022,7 @@
property FilterOptions: TFilterOptions read FFilterOptions write FFilterOptions;
property Active: Boolean read FActive write SetActive default False;
property AutoCalcFields: Boolean read FAutoCalcFields write FAutoCalcFields;
+ property BufferAllRecords : Boolean read FBufferAllRecords write SetBufferAllRecords;
property BeforeOpen: TDataSetNotifyEvent read FBeforeOpen write FBeforeOpen;
property AfterOpen: TDataSetNotifyEvent read FAfterOpen write FAfterOpen;
property BeforeClose: TDataSetNotifyEvent read FBeforeClose write FBeforeClose;
-------------- next part --------------
Index: dataset.inc
===================================================================
RCS file: /FPC/CVS/fpc/fcl/db/dataset.inc,v
retrieving revision 1.15
diff -u -r1.15 dataset.inc
--- dataset.inc 25 Jul 2004 11:32:40 -0000 1.15
+++ dataset.inc 2 Aug 2004 22:28:29 -0000
@@ -523,11 +524,14 @@
Writeln ('Getting next record. Internal RecordCount : ',FRecordCount);
{$endif}
Shifted:=FRecordCount=FBufferCount;
- If Shifted then
- begin
- ShiftBuffers(0,1);
- Dec(FRecordCount);
- end;
+ if shifted then
+ if FBufferAllRecords then
+ SetBufListSize(FBuffercount+5)
+ else
+ begin
+ ShiftBuffers(0,1);
+ Dec(FRecordCount);
+ end;
{$ifdef dsdebug}
Writeln ('Getting data into buffer : ',FRecordCount);
{$endif}
@@ -827,6 +831,14 @@
end;
end;
+Procedure TDataset.SetBufferAllRecords(Value : Boolean);
+
+begin
+ if Value <> FBufferAllRecords then
+ if not active then FBufferAllRecords := Value
+ else DatabaseError('Can not set BufferAllRecords on an open dataset.',self);
+end;
+
Procedure TDataset.SetField (Index : Longint;Value : TField);
begin
@@ -1192,10 +1204,15 @@
begin
CheckBrowseMode;
DoBeforeScroll;
- ClearBuffers;
+ if not FBufferAllRecords then ClearBuffers
+ else
+ begin
+ FactiveRecord:=0;
+ FBOF:=True;
+ end;
try
InternalFirst;
- GetNextRecords;
+ if not FBufferAllRecords then GetNextRecords;
finally
FBOF:=True;
DataEvent(deDatasetChange,0);
@@ -1312,11 +1329,14 @@
begin
CheckBrowseMode;
DoBeforeScroll;
- ClearBuffers;
try
- InternalLast;
- GetPriorRecords;
- FActiveRecord:=FRecordCount-1;
+ if fBufferAllRecords then moveby(2147483646) else
+ begin
+ ClearBuffers;
+ InternalLast;
+ GetPriorRecords;
+ FActiveRecord:=FRecordCount-1;
+ end;
finally
FEOF:=true;
DataEvent(deDataSetChange, 0);
@@ -1354,6 +1374,7 @@
{$endif}
If GetNextRecord then
begin
+ if FBufferAllRecords then inc(FActiveRecord);
Dec(Distance);
Dec(Result);
Inc(TheResult); //Inc(Result);
-------------- next part --------------
Index: dataset.inc
===================================================================
RCS file: /FPC/CVS/fpc/fcl/db/dataset.inc,v
retrieving revision 1.15
diff -u -r1.15 dataset.inc
--- dataset.inc 25 Jul 2004 11:32:40 -0000 1.15
+++ dataset.inc 2 Aug 2004 22:28:29 -0000
@@ -308,6 +308,7 @@
begin
If assigned(FBeforeScroll) then
FBeforeScroll(Self);
+ if state in [dsedit,dsinsert] then post;
end;
Procedure TDataset.DoInternalOpen;
More information about the fpc-devel
mailing list