diff --git a/packages/fcl-db/src/base/bufdataset.pas b/packages/fcl-db/src/base/bufdataset.pas index 2f709c8f09..0173548424 100644 --- a/packages/fcl-db/src/base/bufdataset.pas +++ b/packages/fcl-db/src/base/bufdataset.pas @@ -157,7 +157,7 @@ type procedure BeginUpdate; virtual; abstract; // Adds a record to the end of the index as the new last record (spare record) // Normally only used in GetNextPacket - procedure AddRecord(Const ARecord : PChar); virtual; abstract; + procedure AddRecord; virtual; abstract; // Inserts a record before the current record, or if the record is sorted, // insert it to the proper position procedure InsertRecordBeforeCurrentRecord(Const ARecord : PChar); virtual; abstract; @@ -226,11 +226,57 @@ type Function GetRecNo(const ABookmark : PBufBookmark) : integer; override; procedure BeginUpdate; override; - procedure AddRecord(Const ARecord : PChar); override; + procedure AddRecord; override; procedure InsertRecordBeforeCurrentRecord(Const ARecord : PChar); override; procedure EndUpdate; override; end; + { TUniDirectionalBufIndex } + + TUniDirectionalBufIndex = class(TBufIndex) + private + FSPareBuffer: PChar; + protected + function GetBookmarkSize: integer; override; + function GetCurrentBuffer: Pointer; override; + function GetCurrentRecord: PChar; override; + function GetIsInitialized: boolean; override; + function GetSpareBuffer: PChar; override; + function GetSpareRecord: PChar; override; + public + function ScrollBackward : TGetResult; override; + function ScrollForward : TGetResult; override; + function GetCurrent : TGetResult; override; + function ScrollFirst : TGetResult; override; + procedure ScrollLast; override; + + procedure SetToFirstRecord; override; + procedure SetToLastRecord; override; + + procedure StoreCurrentRecord; override; + procedure RestoreCurrentRecord; override; + + function CanScrollForward : Boolean; override; + procedure DoScrollForward; override; + + procedure StoreCurrentRecIntoBookmark(const ABookmark: PBufBookmark); override; + procedure StoreSpareRecIntoBookmark(const ABookmark: PBufBookmark); override; + procedure GotoBookmark(const ABookmark : PBufBookmark); override; + + procedure InitialiseIndex; override; + procedure InitialiseSpareRecord(const ASpareRecord : PChar); override; + procedure ReleaseSpareRecord; override; + + procedure RemoveRecordFromIndex(const ABookmark : TBufBookmark); override; + Function GetRecNo(const ABookmark : PBufBookmark) : integer; override; + + procedure BeginUpdate; override; + procedure AddRecord; override; + procedure InsertRecordBeforeCurrentRecord(Const ARecord : PChar); override; + procedure EndUpdate; override; + end; + + { TArrayBufIndex } TArrayBufIndex = class(TBufIndex) @@ -282,7 +328,7 @@ type procedure InsertRecordBeforeCurrentRecord(Const ARecord : PChar); override; procedure BeginUpdate; override; - procedure AddRecord(Const ARecord : PChar); override; + procedure AddRecord; override; procedure EndUpdate; override; end; @@ -387,6 +433,7 @@ type procedure CalcRecordSize; function GetIndexFieldNames: String; function GetIndexName: String; + function GetBufUniDirectional: boolean; function LoadBuffer(Buffer : PChar): TGetResult; function GetFieldSize(FieldDef : TFieldDef) : longint; function GetRecordUpdateBuffer(const ABookmark : TBufBookmark; IncludePrior : boolean = false; AFindNext : boolean = false) : boolean; @@ -403,6 +450,8 @@ type procedure IntLoadFielddefsFromFile; procedure IntLoadRecordsFromFile; procedure CurrentRecordToBuffer(Buffer: PChar); + procedure SetBufUniDirectional(const AValue: boolean); + procedure InitDefaultIndexes; protected procedure UpdateIndexDefs; override; function GetNewBlobBuffer : PBlobBuffer; @@ -486,6 +535,7 @@ type property IndexDefs : TIndexDefs read GetIndexDefs; property IndexName : String read GetIndexName write SetIndexName; property IndexFieldNames : String read GetIndexFieldNames write SetIndexFieldNames; + property UniDirectional: boolean read GetBufUniDirectional write SetBufUniDirectional; end; TBufDataset = class(TCustomBufDataset) @@ -658,16 +708,12 @@ begin Inherited Create(AOwner); FMaxIndexesCount:=2; FIndexesCount:=0; - InternalAddIndex('DEFAULT_ORDER','',[],'',''); - FCurrentIndex:=FIndexes[0]; - InternalAddIndex('','',[],'',''); FIndexDefs := TIndexDefs.Create(Self); SetLength(FUpdateBuffer,0); SetLength(FBlobBuffers,0); SetLength(FUpdateBlobBuffers,0); - BookmarkSize := FCurrentIndex.BookmarkSize; FParser := nil; FPacketRecords := 10; end; @@ -1010,6 +1056,7 @@ procedure TCustomBufDataset.InternalOpen; var IndexNr : integer; begin + InitDefaultIndexes; if not Assigned(FDatasetReader) and (FileName<>'') then begin FFileStream := TFileStream.Create(FileName,fmOpenRead); @@ -1046,7 +1093,7 @@ var r : integer; begin FOpen:=False; - with FIndexes[0] do if IsInitialized then + if FIndexesCount>0 then with FIndexes[0] do if IsInitialized then begin iGetResult:=ScrollFirst; while iGetResult = grOK do @@ -1306,8 +1353,10 @@ begin FCursOnFirstRec := False; end; -procedure TDoubleLinkedBufIndex.AddRecord(Const ARecord : PChar); +procedure TDoubleLinkedBufIndex.AddRecord; +var ARecord: PChar; begin + ARecord := FDataset.IntAllocRecordBuffer; FLastRecBuf[IndNr].next := pointer(ARecord); FLastRecBuf[IndNr].next[IndNr].prior := FLastRecBuf; @@ -1351,6 +1400,30 @@ begin GetCalcFields(Buffer); end; +procedure TCustomBufDataset.SetBufUniDirectional(const AValue: boolean); +begin + CheckInactive; + if (AValue<>IsUniDirectional) then + begin + SetUniDirectional(AValue); + SetLength(FIndexes,0); + FPacketRecords := 1; // temporary + FIndexesCount:=0; + end; +end; + +procedure TCustomBufDataset.InitDefaultIndexes; +begin + if FIndexesCount=0 then + begin + InternalAddIndex('DEFAULT_ORDER','',[],'',''); + FCurrentIndex:=FIndexes[0]; + if not IsUniDirectional then + InternalAddIndex('','',[],'',''); + BookmarkSize := FCurrentIndex.BookmarkSize; + end; +end; + function TCustomBufDataset.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; var Acceptable : Boolean; @@ -1446,6 +1519,8 @@ procedure TCustomBufDataset.SetIndexFieldNames(const AValue: String); begin if AValue<>'' then begin + if FIndexesCount=0 then + InitDefaultIndexes; FIndexes[1].FieldsName:=AValue; FCurrentIndex:=FIndexes[1]; if active then @@ -1534,7 +1609,7 @@ begin begin with FIndexes[0] do begin - AddRecord(IntAllocRecordBuffer); + AddRecord; pb := SpareBuffer; end; inc(i); @@ -2131,6 +2206,11 @@ begin result := FCurrentIndex.Name; end; +function TCustomBufDataset.GetBufUniDirectional: boolean; +begin + result := IsUniDirectional; +end; + function TCustomBufDataset.GetRecordSize : Word; begin @@ -2345,7 +2425,11 @@ end; procedure TCustomBufDataset.AddIndex(const AName, AFields : string; AOptions : TIndexOptions; const ADescFields: string = ''; const ACaseInsFields: string = ''); begin + CheckBiDirectional; if AFields='' then DatabaseError(SNoIndexFieldNameGiven); + + if FIndexesCount=0 then + InitDefaultIndexes; if active and (FIndexesCount=FMaxIndexesCount) then DatabaseError(SMaxIndexes); @@ -2485,6 +2569,7 @@ procedure TCustomBufDataset.LoadFromStream(AStream: TStream; Format: TDataPacket var APacketReaderReg : TDatapacketReaderRegistration; APacketReader : TDataPacketReader; begin + CheckBiDirectional; if GetRegisterDatapacketReader(AStream,format,APacketReaderReg) then APacketReader := APacketReaderReg.ReaderClass.create(AStream) else if TFpcBinaryDatapacketReader.RecognizeStream(AStream) then @@ -2505,6 +2590,7 @@ procedure TCustomBufDataset.SaveToStream(AStream: TStream; Format: TDataPacketFo var APacketReaderReg : TDatapacketReaderRegistration; APacketWriter : TDataPacketReader; begin + CheckBiDirectional; if GetRegisterDatapacketReader(Nil,format,APacketReaderReg) then APacketWriter := APacketReaderReg.ReaderClass.create(AStream) else if Format = dfBinary then @@ -2538,7 +2624,7 @@ end; function TCustomBufDataset.BookmarkValid(ABookmark: TBookmark): Boolean; begin - Result:=FCurrentIndex.BookmarkValid(ABookmark); + Result:=assigned(FCurrentIndex) and FCurrentIndex.BookmarkValid(ABookmark); end; function TCustomBufDataset.CompareBookmarks(Bookmark1, Bookmark2: TBookmark @@ -2566,6 +2652,7 @@ var StoreState : TDataSetState; x : integer; begin + CheckBiDirectional; FDatasetReader.InitLoadRecords; StoreState:=SetTempState(dsFilter); @@ -2598,7 +2685,7 @@ begin fillchar(FFilterBuffer^,FNullmaskSize,0); FDatasetReader.RestoreRecord(self); - FIndexes[0].AddRecord(IntAllocRecordBuffer); + FIndexes[0].AddRecord; inc(FBRecordCount); AddRecordBuffer:=False; @@ -2618,7 +2705,7 @@ begin FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind:= ukDelete; FIndexes[0].StoreSpareRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData); - FIndexes[0].AddRecord(IntAllocRecordBuffer); + FIndexes[0].AddRecord; FIndexes[0].RemoveRecordFromIndex(FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData); FIndexes[0].StoreSpareRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData); @@ -2647,7 +2734,7 @@ begin FCurrentIndex.StoreSpareRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData); end; - FIndexes[0].AddRecord(IntAllocRecordBuffer); + FIndexes[0].AddRecord; inc(FBRecordCount); end; @@ -2676,7 +2763,10 @@ begin inc(FIndexesCount); setlength(FIndexes,FIndexesCount); // This invalidates the currentindex! -> not anymore FCurrentIndex:=FIndexes[StoreIndNr]; - FIndexes[FIndexesCount-1] := TDoubleLinkedBufIndex.Create(self); + if IsUniDirectional then + FIndexes[FIndexesCount-1] := TUniDirectionalBufIndex.Create(self) + else + FIndexes[FIndexesCount-1] := TDoubleLinkedBufIndex.Create(self); // FIndexes[FIndexesCount-1] := TArrayBufIndex.Create(self); FIndexes[FIndexesCount-1].InitialiseIndex; with (FIndexes[FIndexesCount-1] as TBufIndex) do @@ -3107,8 +3197,10 @@ begin // inherited BeginUpdate; end; -procedure TArrayBufIndex.AddRecord(const ARecord: PChar); +procedure TArrayBufIndex.AddRecord; +var ARecord: PChar; begin + ARecord := FDataset.IntAllocRecordBuffer; inc(FLastRecInd); if FLastRecInd >= length(FRecordArray) then SetLength(FRecordArray,length(FRecordArray)+FGrowBuffer); @@ -3257,6 +3349,162 @@ begin Result := False; end; +{ TUniDirectionalBufIndex } + +function TUniDirectionalBufIndex.GetBookmarkSize: integer; +begin + // In principle there are no bookmarks, and the size should be 0. + // But there is quite some code in TCustomBufDataset that relies on + // an existing bookmark of the TBufBookmark type. + // This code could be moved to the TBufIndex but that would make things + // more complicated and probably slower. So use a 'fake' bookmark of + // size TBufBookmark. + // When there are other TBufIndexes which also need special bookmark-code + // this can be adapted. + Result:=sizeof(TBufBookmark); +end; + +function TUniDirectionalBufIndex.GetCurrentBuffer: Pointer; +begin + result := FSPareBuffer; +end; + +function TUniDirectionalBufIndex.GetCurrentRecord: PChar; +begin +// Result:=inherited GetCurrentRecord; +end; + +function TUniDirectionalBufIndex.GetIsInitialized: boolean; +begin + Result := Assigned(FSPareBuffer); +end; + +function TUniDirectionalBufIndex.GetSpareBuffer: PChar; +begin + result := FSPareBuffer; +end; + +function TUniDirectionalBufIndex.GetSpareRecord: PChar; +begin + result := FSPareBuffer; +end; + +function TUniDirectionalBufIndex.ScrollBackward: TGetResult; +begin + result := grError; +end; + +function TUniDirectionalBufIndex.ScrollForward: TGetResult; +begin + result := grOk; +end; + +function TUniDirectionalBufIndex.GetCurrent: TGetResult; +begin + result := grOk; +end; + +function TUniDirectionalBufIndex.ScrollFirst: TGetResult; +begin + Result:=grError; +end; + +procedure TUniDirectionalBufIndex.ScrollLast; +begin + DatabaseError(SUniDirectional); +end; + +procedure TUniDirectionalBufIndex.SetToFirstRecord; +begin + DatabaseError(SUniDirectional); +end; + +procedure TUniDirectionalBufIndex.SetToLastRecord; +begin + DatabaseError(SUniDirectional); +end; + +procedure TUniDirectionalBufIndex.StoreCurrentRecord; +begin + DatabaseError(SUniDirectional); +end; + +procedure TUniDirectionalBufIndex.RestoreCurrentRecord; +begin + DatabaseError(SUniDirectional); +end; + +function TUniDirectionalBufIndex.CanScrollForward: Boolean; +begin + // should return true if a next record is already fetched + result := false; +end; + +procedure TUniDirectionalBufIndex.DoScrollForward; +begin + // do nothing +end; + +procedure TUniDirectionalBufIndex.StoreCurrentRecIntoBookmark(const ABookmark: PBufBookmark); +begin + // do nothing +end; + +procedure TUniDirectionalBufIndex.StoreSpareRecIntoBookmark(const ABookmark: PBufBookmark); +begin + // do nothing +end; + +procedure TUniDirectionalBufIndex.GotoBookmark(const ABookmark: PBufBookmark); +begin + DatabaseError(SUniDirectional); +end; + +procedure TUniDirectionalBufIndex.InitialiseIndex; +begin + // do nothing +end; + +procedure TUniDirectionalBufIndex.InitialiseSpareRecord(const ASpareRecord: PChar); +begin + FSPareBuffer:=ASpareRecord; +end; + +procedure TUniDirectionalBufIndex.ReleaseSpareRecord; +begin + FSPareBuffer:=nil; +end; + +procedure TUniDirectionalBufIndex.RemoveRecordFromIndex(const ABookmark: TBufBookmark); +begin + DatabaseError(SUniDirectional); +end; + +function TUniDirectionalBufIndex.GetRecNo(const ABookmark: PBufBookmark): integer; +begin + result := -1; +end; + +procedure TUniDirectionalBufIndex.BeginUpdate; +begin + // Do nothing +end; + +procedure TUniDirectionalBufIndex.AddRecord; +begin + // Do nothing +end; + +procedure TUniDirectionalBufIndex.InsertRecordBeforeCurrentRecord(const ARecord: PChar); +begin + // Do nothing +end; + +procedure TUniDirectionalBufIndex.EndUpdate; +begin + // Do nothing +end; + initialization setlength(RegisteredDatapacketReaders,0); finalization diff --git a/packages/fcl-db/src/base/dataset.inc b/packages/fcl-db/src/base/dataset.inc index 7bfce0c28f..b14b13baa6 100644 --- a/packages/fcl-db/src/base/dataset.inc +++ b/packages/fcl-db/src/base/dataset.inc @@ -1133,7 +1133,7 @@ begin Writeln('Getting next buffers'); {$endif} GetNextRecords; - if FRecordCount < FBufferCount then + if (FRecordCount < FBufferCount) and not IsUniDirectional then begin FActiveRecord := FActiveRecord + GetPriorRecords; CursorPosChanged; diff --git a/packages/fcl-db/src/sqldb/sqldb.pp b/packages/fcl-db/src/sqldb/sqldb.pp index 9884aa711f..9675e9af8d 100644 --- a/packages/fcl-db/src/sqldb/sqldb.pp +++ b/packages/fcl-db/src/sqldb/sqldb.pp @@ -1244,7 +1244,7 @@ begin // Call UpdateServerIndexDefs before Execute, to avoid problems with connections // which do not allow processing multiple recordsets at a time. (Microsoft // calls this MARS, see bug 13241) - if DefaultFields and FUpdateable and FusePrimaryKeyAsKey then + if DefaultFields and FUpdateable and FusePrimaryKeyAsKey and (not IsUniDirectional) then UpdateServerIndexDefs; Execute; // InternalInitFieldDef is only called after a prepare. i.e. not twice if @@ -1254,7 +1254,7 @@ begin begin CreateFields; - if FUpdateable then + if FUpdateable and (not IsUniDirectional) then begin if FusePrimaryKeyAsKey then begin @@ -1555,7 +1555,7 @@ Function TCustomSQLQuery.GetCanModify: Boolean; begin // the test for assigned(FCursor) is needed for the case that the dataset isn't opened if assigned(FCursor) and (FCursor.FStatementType = stSelect) then - Result:= FUpdateable and (not FReadOnly) + Result:= FUpdateable and (not FReadOnly) and (not IsUniDirectional) else Result := False; end; diff --git a/packages/fcl-db/tests/sqldbtoolsunit.pas b/packages/fcl-db/tests/sqldbtoolsunit.pas index 92fb16c573..aae1f9b52e 100644 --- a/packages/fcl-db/tests/sqldbtoolsunit.pas +++ b/packages/fcl-db/tests/sqldbtoolsunit.pas @@ -63,14 +63,17 @@ const MySQLdbTypes = [mysql40,mysql41,mysql50]; type { TSQLDBConnector } TSQLDBConnector = class(TDBConnector) - FConnection : TSQLConnection; - FTransaction : TSQLTransaction; - FQuery : TSQLQuery; private + FConnection : TSQLConnection; + FTransaction : TSQLTransaction; + FQuery : TSQLQuery; + FUniDirectional: boolean; procedure CreateFConnection; procedure CreateFTransaction; Function CreateQuery : TSQLQuery; protected + procedure SetTestUniDirectional(const AValue: boolean); override; + function GetTestUniDirectional: boolean; override; procedure CreateNDatasets; override; procedure CreateFieldDataset; override; procedure DropNDatasets; override; @@ -167,6 +170,17 @@ begin end; end; +procedure TSQLDBConnector.SetTestUniDirectional(const AValue: boolean); +begin + FUniDirectional:=avalue; + FQuery.UniDirectional:=AValue; +end; + +function TSQLDBConnector.GetTestUniDirectional: boolean; +begin + result := FUniDirectional; +end; + procedure TSQLDBConnector.CreateNDatasets; var CountID : Integer; begin @@ -273,6 +287,7 @@ begin begin sql.clear; sql.add('SELECT * FROM FPDEV WHERE ID < '+inttostr(n+1)); + UniDirectional:=TestUniDirectional; end; end; @@ -283,6 +298,7 @@ begin begin sql.clear; sql.add('SELECT * FROM FPDEV_FIELD'); + tsqlquery(Result).UniDirectional:=TestUniDirectional; end; end; diff --git a/packages/fcl-db/tests/testdbbasics.pas b/packages/fcl-db/tests/testdbbasics.pas index 20f047c9a6..65707c29c6 100644 --- a/packages/fcl-db/tests/testdbbasics.pas +++ b/packages/fcl-db/tests/testdbbasics.pas @@ -8,7 +8,7 @@ interface uses fpcunit, testutils, testregistry, testdecorator, - Classes, SysUtils, db; + Classes, SysUtils, db, ToolsUnit; type @@ -119,9 +119,20 @@ type procedure TestCanModifySpecialFields; end; + TTestUniDirectionalDBBasics = class(TTestDBBasics) + end; + + { TDBBasicsUniDirectionalTestSetup } + + TDBBasicsUniDirectionalTestSetup = class(TDBBasicsTestSetup) + protected + procedure OneTimeSetup; override; + procedure OneTimeTearDown; override; + end; + implementation -uses toolsunit, bufdataset, variants, strutils; +uses bufdataset, variants, strutils, sqldb; type THackDataLink=class(TdataLink); @@ -2170,9 +2181,25 @@ begin cancel; AssertTrue('Field isn''t NULL after cancel',fieldbyname('id').IsNull); end; +end; +{ TDBBasicsUniDirectionalTestSetup } + +procedure TDBBasicsUniDirectionalTestSetup.OneTimeSetup; +begin + inherited OneTimeSetup; + DBConnector.TestUniDirectional:=true; +end; + +procedure TDBBasicsUniDirectionalTestSetup.OneTimeTearDown; +begin + DBConnector.TestUniDirectional:=false; + inherited OneTimeTearDown; end; initialization RegisterTestDecorator(TDBBasicsTestSetup, TTestDBBasics); + + if uppercase(dbconnectorname)='SQL' then + RegisterTestDecorator(TDBBasicsUniDirectionalTestSetup, TTestUniDirectionalDBBasics); end.