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?
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);
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,@SQL[1],1,nil); +end; + function TIBDatabase.GetHandle: pointer; begin Result := FIBDatabaseHandle;
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;
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);
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;