{*********************************************************} {* FlashFiler: Server cursor classes *} {*********************************************************} (* ***** BEGIN LICENSE BLOCK ***** * Version: MPL 1.1 * * The contents of this file are subject to the Mozilla Public License Version * 1.1 (the "License"); you may not use this file except in compliance with * the License. You may obtain a copy of the License at * http://www.mozilla.org/MPL/ * * Software distributed under the License is distributed on an "AS IS" basis, * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License * for the specific language governing rights and limitations under the * License. * * The Original Code is TurboPower FlashFiler * * The Initial Developer of the Original Code is * TurboPower Software * * Portions created by the Initial Developer are Copyright (C) 1996-2002 * the Initial Developer. All Rights Reserved. * * Contributor(s): * * ***** END LICENSE BLOCK ***** *) {$I ffdefine.inc} unit ffsrcur; interface uses ffllbase, fflldict, fflltemp, ffsrbase, ffsrbde, ffsreng, ffsrfltr, ffsrfold, ffsrlock, fftbdict, fftbindx; type { This class manages a set of data stored in a logical table. It is very similar to TffSrTable. However, the data is not indexed. To create a new simple table, you must do the following: 1. Call TffSrSimpleTable.Create. 2. Have the table build its files by calling its BuildFiles method. 3. Have the table open its fils by calling its OpenFiles method. } TffSrSimpleTable = class(TffSrBaseTable) public procedure AddIndex(const aIndexDesc : TffIndexDescriptor; aTI : PffTransInfo); override; procedure BuildFiles(aTI : PffTransInfo; aForServer : boolean; aDictionary : TffDataDictionary; aAttribs : TffFileAttributes; aStore : TffBaseTempStorage); override; function BuildKeyForRecord(aIndexID : integer; aData : PffByteArray; aKey : PffByteArray; aFieldCount : integer; aPartialLen : integer) : TffResult; override; function CompareKeysForCursor(var aKID : TffKeyIndexData; aKey1 : PffByteArray; aKey2 : PffByteArray) : integer; override; function DeleteRecord(aTI : PffTransInfo; const aCursorID : TffCursorID; const aRefNr : TffInt64; const aLockObtained : Boolean; var aBTreeChanged : Boolean) {!!.05} : TffResult; override; procedure DropIndex(aTI : PffTransInfo; aIndexID : Longint); override; function FindKey(var aKID : TffKeyIndexData; var aRefNr : TffInt64; aTI : PffTransInfo; aKey : PffByteArray; var aKeyPath : TffKeyPath; aAction : TffSearchKeyAction) : boolean; override; function GetNextKey(var aKID : TffKeyIndexData; var aRefNr : TffInt64; aTI : PffTransInfo; aKey : PffByteArray; var aKeyPath : TffKeyPath) : TffResult; override; function GetNextRecord(aTI : PffTransInfo; const aDatabaseID : TffDatabaseID; {!!.10} const aCursorID : TffCursorID; {!!.10} var aKID : TffKeyIndexData; var aRefNr : TffInt64; aKey : PffByteArray; var aKeyPath : TffKeyPath; aData : PffByteArray; const aLockType : TffSrLockType) : TffResult; override; {!!.10} function GetPriorRecord(aTI : PffTransInfo; const aDatabaseID : TffDatabaseID; {!!.10} const aCursorID : TffCursorID; {!!.10} var aKID : TffKeyIndexData; var aRefNr : TffInt64; aKey : PffByteArray; var aKeyPath : TffKeyPath; aData : PffByteArray; const aLockType : TffSrLockType) : TffResult; override; {!!.10} function InsertRecord(aTI : PffTransInfo; aCursorID : TffCursorID; aData : PffByteArray; aLockType : TffSrLockType; var aNewRefNr : TffInt64) : TffResult; override; function InsertRecordNoDefault(aTI : PffTransInfo; {!!.10} aCursorID : TffCursorID; aData : PffByteArray; aLockType : TffSrLockType; var aNewRefNr : TffInt64) : TffResult; override; procedure MakeKIDForCursor(aIndexID : integer; var aKID : TffKeyIndexData); override; procedure OpenFiles(aTI : PffTransInfo; aForServer : boolean; aAttribs : TffFileAttributes); override; function PutRecord(aTI : PffTransInfo; aCursorID : TffCursorID; aRefNr : TffInt64; aData : PffByteArray; aRelLock : boolean; {!!.05} var aKeyChanged : Boolean) : TffResult; override; {!!.05} end; { Use this cursor class to manage sets of data that do not require indices. } TffSrSimpleCursor = class(TffSrBaseCursor) protected procedure bcTableOpenPreconditions(aTable : TffSrBaseTable; const aIndexName : string; var aIndexID : Longint; const aOpenMode : TffOpenMode); override; { Used by Create method to verify a thread may open a table. } public constructor Create(anEngine : TffServerEngine; aDatabase : TffSrDatabase; const aTimeout : Longint); override; destructor Destroy; override; function AddIndexToTable(const aIndexDesc : TffIndexDescriptor) : TffResult; override; function CheckBookmark(aBookmark : PffByteArray) : TffResult; override; procedure ClearIndex; override; function CloneCursor(aOpenMode : TffOpenMode) : TffSrBaseCursor; override; function CompareBookmarks(aBookmark1, aBookmark2 : PffByteArray; var CmpResult : Longint) : TffResult; override; function DropIndexFromTable(const aIndexName : TffDictItemName; aIndexID : Longint) : TffResult; override; function ExtractKey(aData : PffByteArray; aKey : PffByteArray) : TffResult; override; function GetBookmark(aBookmark : PffByteArray) : TffResult; override; function GetBookmarkSize : integer; override; function GetNextRecord(aData : PffByteArray; aLockType : TffSrLockType) : TffResult; override; function GetPriorRecord(aData : PffByteArray; aLockType : TffSrLockType) : TffResult; override; function GetRecordCount(var aRecCount : Longint) : TffResult; override; function GetRecordForKey(aDirectKey : boolean; aFieldCount : integer; aPartialLen : integer; aKeyData : PffByteArray; aData : PffByteArray; aFirstCall : Boolean) : TffResult; override; function InsertRecord(aData : PffByteArray; aLockType : TffSrLockType) : TffResult; override; function InsertRecordNoDefault(aData : PffByteArray; aLockType : TffSrLockType) : TffResult; override;{!!.10} function IsInRange(aKey : PffByteArray) : integer; override; function ModifyRecord(aData : PffByteArray; aRelLock : boolean) : TffResult; override; procedure Open(const aTableName : TffTableName; const aIndexName : TffName; const aIndexID : Longint; const aOpenMode : TffOpenMode; aShareMode : TffShareMode; aForServer : boolean; const aExclContLock : Boolean; {!!.10} aAttribs : TffFileAttributes); override; procedure ResetRange; override; function SetRange(aDirectKey : boolean; aFieldCount1 : integer; aPartialLen1 : integer; aKeyData1 : PffByteArray; aKeyIncl1 : boolean; aFieldCount2 : integer; aPartialLen2 : integer; aKeyData2 : PffByteArray; aKeyIncl2 : boolean) : TffResult; override; procedure SetToBegin; override; function SetToBookmark(aBookmark : PffByteArray) : TffResult; override; function SetToCursor(aCursor : TffSrBaseCursor) : TffResult; override; procedure SetToEnd; override; function SetToKey(aSearchAction : TffSearchKeyAction; aDirectKey : boolean; aFieldCount : integer; aPartialLen : integer; aKeyData : PffByteArray) : TffResult; override; function SwitchToIndex(aIndexID : integer; aPosnOnRec : boolean) : TffResult; override; end; { Use this class to create a cursor representing a query's result set. Do not directly create TffSrSimpleCursor. } TffSrSQLResultSet = class(TffSrSimpleCursor); implementation uses ffconst, ffhash, fflleng, ffllexcp, fftbbase, fftbBLOB, {!!.11} fftbdata; {===TffSrSQLTable====================================================} procedure TffSrSimpleTable.AddIndex(const aIndexDesc : TffIndexDescriptor; aTI : PffTransInfo); begin FFRaiseException(EffException, ffStrResServer, fferrIndexNotSupported, [btBaseName^, Self.ClassName]); end; {--------} procedure TffSrSimpleTable.BuildFiles(aTI : PffTransInfo; aForServer : boolean; aDictionary : TffDataDictionary; aAttribs : TffFileAttributes; aStore : TffBaseTempStorage); var FileInx : integer; DataFile : PffFileInfo; FileCnt : integer; {dup for speed} begin { Create the data file. } btFiles.Count := 1; btFiles[0] := FFAllocFileInfo(FFMakeFullFileName(Folder.Path, BaseName), ffc_ExtForData, btBufMgr); { Validate the dictionary. } aDictionary.CheckValid; { Assimilate the dictionary. } btDictionary.ForceOffReadOnly; btDictionary.Assign(aDictionary); btDictionary.BindIndexHelpers; with PffFileInfo(btFiles[0])^ do begin fiAttributes := aAttribs; fiForServer := aForServer; fiEncrypted := btEngine.Configuration.GeneralInfo^.giAllowEncrypt and aDictionary.IsEncrypted; fiRecLenPlusTrailer := btDictionary.RecordLength + SizeOf(Byte); fiRecordLength := btDictionary.RecordLength; fiTempStore := aStore; end; { Get the file count for this table (for speed reasons, etc). } FileCnt := Dictionary.FileCount; FileCount := FileCnt; { Get the data file for speed reasons. } DataFile := Files[0]; { Scan through the secondary files. This table supports separate BLOB files but not separate index files. } for FileInx := 0 to pred(FileCnt) do begin if Dictionary.FileType[FileInx] = ftIndexFile then FFRaiseException(EffException, ffStrResServer, fferrIndexNotSupported, [btBaseName^, Self.ClassName]); btCreateFile(FileInx, aTI, btDictionary.FileExt[FileInx], aForServer, aAttribs, aStore); end; { Write the dictionary to the data file. } Dictionary.WriteToFile(DataFile, aTI); {Begin !!.11} Files[Dictionary.BLOBFileNumber].fiBLOBrscMgr := TffBaseBLOBResourceMgr.GetMgr(Files[Dictionary.BLOBFileNumber]); btBLOBEngine := TffBaseBLOBEngine.GetEngine(Files[Dictionary.BLOBFileNumber]); {End !!.11} Files[Dictionary.BLOBFileNumber].fiMaxSegSize := FFCalcMaxBLOBSegSize(Files[Dictionary.BLOBFileNumber]); end; {--------} function TffSrSimpleTable.BuildKeyForRecord(aIndexID : integer; aData : PffByteArray; aKey : PffByteArray; aFieldCount : integer; aPartialLen : integer) : TffResult; begin Result := DBIERR_INVALIDINDEXCREATE; end; {--------} function TffSrSimpleTable.CompareKeysForCursor(var aKID : TffKeyIndexData; aKey1 : PffByteArray; aKey2 : PffByteArray) : integer; begin Result := DBIERR_INVALIDINDEXCREATE; end; {--------} function TffSrSimpleTable.DeleteRecord(aTI : PffTransInfo; const aCursorID : TffCursorID; const aRefNr : TffInt64; const aLockObtained : Boolean; var aBTreeChanged : Boolean) {!!.05} : TffResult; var OldData : PffByteArray; RecLen : integer; begin RecLen := btDictionary.RecordLength; FFGetMem(OldData, RecLen); Result := DBIERR_NONE; { If we have yet to lock the record then do so. } if (not aLockObtained) then FFAcqRecordLock(Files[0], aTI, aRefNr, ffsltExclusive, {!!.10} aTI^.tirTrans.DatabaseID, {!!.10} aCursorID, false); {!!.02}{!!.10} { Note: We leave all such locks active until the transaction is committed. } try FFTblReadRecord(Files[0], aTI, aRefNr, OldData); btDeleteBLOBsForRecord(aTI, OldData); FFTblDeleteRecord(Files[0], aTI, aRefNr); finally btInformCursors(aCursorID, roDelete, aRefNr, 0); FFFreeMem(OldData, RecLen); end;{try..finally} end; {--------} procedure TffSrSimpleTable.DropIndex(aTI : PffTransInfo; aIndexID : Longint); begin FFRaiseException(EffException, ffStrResServer, fferrIndexNotSupported, [btBaseName^, Self.ClassName]); end; {--------} function TffSrSimpleTable.FindKey(var aKID : TffKeyIndexData; var aRefNr : TffInt64; aTI : PffTransInfo; aKey : PffByteArray; var aKeyPath : TffKeyPath; aAction : TffSearchKeyAction) : boolean; begin ffInitI64(aRefNr); Result := False; end; {--------} function TffSrSimpleTable.GetNextKey(var aKID : TffKeyIndexData; var aRefNr : TffInt64; aTI : PffTransInfo; aKey : PffByteArray; var aKeyPath : TffKeyPath) : TffResult; begin Result := DBIERR_INVALIDINDEXCREATE; end; {--------} function TffSrSimpleTable.GetNextRecord(aTI : PffTransInfo; const aDatabaseID : TffDatabaseID; {!!.10} const aCursorID : TffCursorID; {!!.10} var aKID : TffKeyIndexData; var aRefNr : TffInt64; aKey : PffByteArray; var aKeyPath : TffKeyPath; aData : PffByteArray; const aLockType : TffSrLockType) : TffResult; begin Result := DBIERR_NONE; GetNextRecordSeq(aTI, aRefNr, aData); end; {--------} function TffSrSimpleTable.GetPriorRecord(aTI : PffTransInfo; const aDatabaseID : TffDatabaseID; {!!.10} const aCursorID : TffCursorID; {!!.10} var aKID : TffKeyIndexData; var aRefNr : TffInt64; aKey : PffByteArray; var aKeyPath : TffKeyPath; aData : PffByteArray; const aLockType : TffSrLockType) : TffResult; {!!.10} begin Result := DBIERR_NONE; GetPrevRecordSeq(aTI, aRefNr, aData); end; {--------} function TffSrSimpleTable.InsertRecord(aTI : PffTransInfo; aCursorID : TffCursorID; aData : PffByteArray; aLockType : TffSrLockType; var aNewRefNr : TffInt64) : TffResult; var RefNr : TffInt64; begin RefNr.iLow := 0; RefNr.iHigh := 0; Result := DBIERR_NONE; if not Dictionary.CheckRequiredRecordFields(aData) then Result := DBIERR_REQDERR else begin {we need to add the default field values} if Dictionary.DefaultFieldCount > 0 then Dictionary.SetDefaultFieldValues(aData); { Updating the autoinc value obtains an exclusive lock on block 0 which prevents other cursors from inserting the same or additional records until we are done. } btUpdateAutoInc(aTI, aData); FFTblAddRecord(Files[0], aTI, RefNr, aData); aNewRefNr := RefNr; FFAcqRecordLock(Files[0], aTI, aNewRefNr, aLockType, {!!.10} aTI^.tirTrans.DatabaseID, {!!.10} aCursorID, false); {!!.02}{!!.10} end; end; {--------} function TffSrSimpleTable.InsertRecordNoDefault(aTI : PffTransInfo;{!!.10} aCursorID : TffCursorID; aData : PffByteArray; aLockType : TffSrLockType; var aNewRefNr : TffInt64) : TffResult; var RefNr : TffInt64; begin RefNr.iLow := 0; RefNr.iHigh := 0; Result := DBIERR_NONE; if not Dictionary.CheckRequiredRecordFields(aData) then Result := DBIERR_REQDERR else begin { Updating the autoinc value obtains an exclusive lock on block 0 which prevents other cursors from inserting the same or additional records until we are done. } btUpdateAutoInc(aTI, aData); FFTblAddRecord(Files[0], aTI, RefNr, aData); aNewRefNr := RefNr; FFAcqRecordLock(Files[0], aTI, aNewRefNr, aLockType, {!!.10} aTI^.tirTrans.DatabaseID, {!!.10} aCursorID, false); {!!.02}{!!.10} end; end; {--------} procedure TffSrSimpleTable.MakeKIDForCursor(aIndexID : integer; var aKID : TffKeyIndexData); begin FFRaiseException(EffException, ffStrResServer, fferrIndexNotSupported, [btBaseName^, Self.ClassName]); end; {--------} procedure TffSrSimpleTable.OpenFiles(aTI : PffTransInfo; aForServer : boolean; aAttribs : TffFileAttributes); var FileInx : integer; begin { Are any of the files marked as index files? If so then raise an exception because this class does not support indexes. Assume that file 0 is the data file. } for FileInx := 1 to pred(Dictionary.FileCount) do if Dictionary.FileType[FileInx] = ftIndexFile then FFRaiseException(EffException, ffStrResServer, fferrIndexNotSupported, [btBaseName^, Self.ClassName]); { If we've made it this far then open the files. } inherited OpenFiles(aTI, aForServer, aAttribs); end; {--------} function TffSrSimpleTable.PutRecord(aTI : PffTransInfo; aCursorID : TffCursorID; aRefNr : TffInt64; aData : PffByteArray; aRelLock : boolean; {!!.05} var aKeyChanged : Boolean) : TffResult; {!!.05} var RecLen : integer; OldData: PffByteArray; begin { Assumption: By the time we have reached this point, the transaction has acquired a content lock on the table and we are the only ones who are going to be modifying the record. } aKeyChanged := False; {!!.05} RecLen := 0; if not Dictionary.CheckRequiredRecordFields(aData) then begin Result := DBIERR_REQDERR; Exit; end; Result := DBIERR_NONE; try try RecLen := Dictionary.RecordLength; FFGetMem(OldData, RecLen); FFTblReadRecord(Files[0], aTI, aRefNr, OldData); { Acquire an exclusive lock. } FFAcqRecordLock(Files[0], aTI, aRefNr, ffsltExclusive, {!!.10} aTI^.tirTrans.DatabaseID, {!!.10} aCursorID, false); {!!.02}{!!.10} FFTblUpdateRecord(Files[0], aTI, aRefNr, aData); except FFRelRecordLock(Files[0], aTI, aRefNr, aTI^.tirTrans.DatabaseID, {!!.10} aCursorID); {!!.10} end; finally FFFreeMem(OldData, RecLen); end;{try..finally} end; {====================================================================} {===TffSrSimpleCursor================================================} constructor TffSrSimpleCursor.Create(anEngine : TffServerEngine; aDatabase : TffSrDatabase; const aTimeout : Longint); begin bcTableClass := TffSrSimpleTable; inherited Create(anEngine, aDatabase, aTimeout); end; {--------} destructor TffSrSimpleCursor.Destroy; begin { Free the table locks held by the cursor. } if Assigned(bcTable) then bcTable.RelLock(CursorID, True); inherited Destroy; end; {--------} function TffSrSimpleCursor.AddIndexToTable(const aIndexDesc : TffIndexDescriptor) : TffResult; begin Result := DBIERR_INVALIDINDEXCREATE; FFRaiseException(EffException, ffStrResServer, fferrIndexNotSupported, [bcTable.BaseName, Self.ClassName]); end; {--------} procedure TffSrSimpleCursor.bcTableOpenPreconditions(aTable : TffSrBaseTable; const aIndexName : string; var aIndexID : Longint; const aOpenMode : TffOpenMode); begin { Ignore the index information. } { If the table's data file is open in read-only mode it means the physical file is read-only: hence this call's openmode must be read-only as well. } if (aTable.Files[0]^.fiOpenMode = omReadOnly) and (aOpenMode <> omReadOnly) then FFRaiseException(EffException, ffStrResServer, fferrCursorReadOnly, [aTable.BaseName]); end; {--------} function TffSrSimpleCursor.CheckBookmark(aBookmark : PffByteArray) : TffResult; var CheckHash : Longint; begin Result := DBIERR_INVALIDBOOKMARK; if (aBookmark = nil) then Exit; with PffSrBookmark(aBookmark)^ do begin CheckHash := FFCalcElfHash(sbIndexID, ffcl_FixedBookmarkSize - SizeOf(sbHash)); if (sbHash <> CheckHash) then Exit; end; Result := DBIERR_NONE; end; {--------} procedure TffSrSimpleCursor.ClearIndex; begin FFRaiseException(EffException, ffStrResServer, fferrIndexNotSupported, [bcTable.BaseName, Self.ClassName]); end; {--------} function TffSrSimpleCursor.CloneCursor(aOpenMode : TffOpenMode) : TffSrBaseCursor; begin {NOTE: we are not checking rights for this action because the client had the rights to open the cursor} { Resolve the open mode. } if (bcOpenMode = omReadOnly) then aOpenMode := omReadOnly; AcqContentLock(ffclmRead); try { Create the cursor. } Result := TffSrSimpleCursor.Create(bcEngine, bcDatabase, soTimeout); Result.Open(bcTable.BaseName, '', bcIndexID, aOpenMode, smShared, bcTable.IsServerTable, False, bcTable.Files[0]^.fiAttributes); { Set up all of the misc fields. } Result.CursorInfo := bcInfo; if Assigned(bcFilter) then Result.SetFilter(bcFilter.Expression,bcFilter.Timeout); finally RelContentLock(ffclmRead); end; end; {--------} function TffSrSimpleCursor.CompareBookmarks(aBookmark1, aBookmark2 : PffByteArray; var CmpResult : Longint) : TffResult; var BM1 : PffSrBookmark absolute aBookmark1; BM2 : PffSrBookmark absolute aBookmark2; begin Result := CheckBookmark(aBookmark1); if (Result = DBIERR_NONE) then Result := CheckBookmark(aBookmark2); if (Result <> DBIERR_NONE) then Exit; case BM1^.sbPos of cpUnknown : CmpResult := -1; cpBOF : if (BM2^.sbPos = cpBOF) then CmpResult := 0 else CmpResult := -1; cpEOF : if (BM2^.sbPos = cpEOF) then CmpResult := 0 else CmpResult := 1; else { Bookmark 1 is on a crack or on a record. } case BM2^.sbPos of cpUnknown : CmpResult := 1; cpBOF : CmpResult := 1; cpEOF : CmpResult := -1; else { Bookmark 2 is also on a crack or on a record. Check the reference numbers.} CmpResult := ffCmpI64(BM1^.sbRefNr, BM2^.sbRefNr); end; {case} end; {case} end; {--------} function TffSrSimpleCursor.DropIndexFromTable(const aIndexName : TffDictItemName; aIndexID : Longint) : TffResult; begin Result := DBIERR_INVALIDINDEXCREATE; FFRaiseException(EffException, ffStrResServer, fferrIndexNotSupported, [bcTable.BaseName, Self.ClassName]); end; {--------} function TffSrSimpleCursor.ExtractKey(aData : PffByteArray; aKey : PffByteArray) : TffResult; begin Result := DBIERR_INVALIDINDEXCREATE; FFRaiseException(EffException, ffStrResServer, fferrIndexNotSupported, [bcTable.BaseName, Self.ClassName]); end; {--------} function TffSrSimpleCursor.GetBookmark(aBookmark : PffByteArray) : TffResult; begin Result := DBIERR_NONE; AcqContentLock(ffclmRead); try FillChar(PffSrBookmark(aBookmark)^, ffcl_FixedBookmarkSize, 0); with PffSrBookmark(aBookmark)^ do begin sbRefNr := bcInfo.RefNr; sbPos := bcInfo.Pos; sbKeyValid := bcInfo.KeyValid; sbHash := FFCalcElfHash(sbIndexID, ffcl_FixedBookmarkSize - sizeof(sbHash)); end; finally RelContentLock(ffclmRead); end; end; {--------} function TffSrSimpleCursor.GetBookmarkSize : integer; begin Result := ffcl_FixedBookmarkSize; end; {--------} function TffSrSimpleCursor.GetNextRecord(aData : PffByteArray; aLockType : TffSrLockType) : TffResult; begin { If we are at EOF, then obviously there's no next record. } if (bcInfo.pos = cpEOF) then begin Result := DBIERR_EOF; Exit; end; AcqContentLock(ffclmRead); try { Make sure that we have somewhere to read the record into. } if (aData = nil) then aData := bcRecordData; if Assigned(bcFilter) then bcFilter.BeginTimeout; Result := DBIERR_NONE; repeat bcTable.GetNextRecordSeq(bcDatabase.TransactionInfo, bcInfo.RefNr, aData); if ffI64IsZero(bcInfo.RefNr) then begin Result := DBIERR_EOF; SetToEnd; Exit; end; { In theory we're on a record. } bcInfo.Deleted := false; bcInfo.KeyValid := true; bcInfo.Pos := cpOnRecord; until (Result <> DBIERR_NONE) or not Assigned(bcFilter) or bcFilter.MatchesRecord(aData) or bcFilter.CheckTimeout(Result); { Place the lock if needed... record will not be read again. } if (Result = DBIERR_NONE) and (aLockType <> ffsltNone) then Result := Table.GetRecord(bcDatabase.TransactionInfo, bcDatabase.DatabaseID, CursorID, {!!.10} bcInfo.RefNr, nil, aLockType, false, false); {!!.02} finally RelContentLock(ffclmRead); end; end; {--------} function TffSrSimpleCursor.GetPriorRecord(aData : PffByteArray; aLockType : TffSrLockType) : TffResult; begin { If we are at BOF, then obviously there's no prior record. } if (bcInfo.pos = cpBOF) then begin Result := DBIERR_BOF; Exit; end; AcqContentLock(ffclmRead); try { Make sure that we have somewhere to read the record into. } if (aData = nil) then aData := bcRecordData; { Get the previous record. } if Assigned(bcFilter) then bcFilter.BeginTimeout; Result := DBIERR_NONE; repeat bcTable.GetPrevRecordSeq(bcDatabase.TransactionInfo, bcInfo.RefNr, aData); if FFI64IsZero(bcInfo.RefNr) then begin Result := DBIERR_BOF; SetToBegin; Exit; end; { In theory we're on a record. } bcInfo.Deleted := false; bcInfo.KeyValid := true; bcInfo.Pos := cpOnRecord; until (Result <> DBIERR_NONE) or not Assigned(bcFilter) or bcFilter.MatchesRecord(aData) or bcFilter.CheckTimeout(Result); { Place the lock if needed... record will not be read again. } if (Result = DBIERR_NONE) and (aLockType <> ffsltNone) then Result := bcTable.GetRecord(bcDatabase.TransactionInfo, {!!.10} bcDatabase.DatabaseID, {!!.10} CursorID, {!!.10} bcInfo.refNr, nil, aLockType, false, false); {!!.02} finally RelContentLock(ffclmRead); end; end; {--------} function TffSrSimpleCursor.GetRecordCount(var aRecCount : Longint) : TffResult; var aData : PffByteArray; Info : TffRecordInfo; begin Result := DBIERR_NONE; AcqContentLock(ffclmRead); try { Is a filter active? } if Assigned(bcFilter) then begin { Yes. Set count to zero. We are going to scan through the records. } aRecCount := 0; { Save the current position. } bcSaveCurInfo; FFGetZeroMem(aData, bcRecordLen); try {BOF} SetToBegin; { While not EOF or other error do. } while (Result = DBIERR_NONE) do begin Result := GetNextRecord(aData, ffsltNone); if (Result = DBIERR_NONE) then inc(aRecCount); end; Result := DBIERR_NONE; finally FFFreeMem(aData, bcRecordLen); { Reset current position. } bcRestoreCurInfo; end; end else begin FFTblGetRecordInfo(bcTable.Files[0], bcDatabase.TransactionInfo, Info); aRecCount := Info.riRecCount; end; finally RelContentLock(ffclmRead); end; end; {--------} function TffSrSimpleCursor.GetRecordForKey(aDirectKey : boolean; aFieldCount : integer; aPartialLen : integer; aKeyData : PffByteArray; aData : PffByteArray; aFirstCall : Boolean) : TffResult; begin Result := DBIERR_INVALIDINDEXCREATE; FFRaiseException(EffException, ffStrResServer, fferrIndexNotSupported, [bcTable.BaseName, Self.ClassName]); end; {--------} function TffSrSimpleCursor.InsertRecord(aData : PffByteArray; aLockType : TffSrLockType) : TffResult; var NewRefNr : TffInt64; begin { Notify extenders. } Result := NotifyExtenders(ffeaBeforeRecInsert, ffeaInsertRecFail); if Result = DBIERR_NONE then begin AcqContentLock(ffclmWrite); Result := bcTable.InsertRecord(bcDatabase.TransactionInfo, CursorID, aData, aLockType, NewRefNr); if (Result = DBIERR_NONE) then begin bcInfo.pos := cpOnRecord; bcInfo.refNr := NewRefNr; bcInfo.Deleted := false; bcInfo.KeyValid := True; { Notify extenders of successful insert. } NotifyExtenders(ffeaAfterRecInsert, ffeaNoAction); end else { Notify extenders of failed insert. } NotifyExtenders(ffeaInsertRecFail, ffeaNoAction); end; end; {--------} function TffSrSimpleCursor.InsertRecordNoDefault(aData : PffByteArray;{!!.10} aLockType : TffSrLockType) : TffResult; var NewRefNr : TffInt64; begin { Notify extenders. } Result := NotifyExtenders(ffeaBeforeRecInsert, ffeaInsertRecFail); if Result = DBIERR_NONE then begin AcqContentLock(ffclmWrite); Result := bcTable.InsertRecordNoDefault(bcDatabase.TransactionInfo,{!!.10} CursorID, aData, aLockType, NewRefNr); if (Result = DBIERR_NONE) then begin bcInfo.pos := cpOnRecord; bcInfo.refNr := NewRefNr; bcInfo.Deleted := false; bcInfo.KeyValid := True; { Notify extenders of successful insert. } NotifyExtenders(ffeaAfterRecInsert, ffeaNoAction); end else { Notify extenders of failed insert. } NotifyExtenders(ffeaInsertRecFail, ffeaNoAction); end; end; {--------} function TffSrSimpleCursor.IsInRange(aKey : PffByteArray) : integer; begin { This class does not support ranges. } Result := 0; FFRaiseException(EffException, ffStrResServer, fferrRangeNotSupported, [bcTable.BaseName, Self.ClassName]); end; {--------} function TffSrSimpleCursor.ModifyRecord(aData : PffByteArray; aRelLock : boolean) : TffResult; var {!!.05} aKeyChanged: Boolean; {!!.05} begin { Note: By this time, any other cursor deleting or modifying the record ahead of us has completed and has set bcInfo.Deleted. We can be assured of this because TffServerEngine.RecordDelete calls Cursor.EnsureWritable(true) which obtains a lock on the record to be deleted. We won't get that lock until the other cursor has finished. } { Has this record already been deleted? } if bcInfo.Deleted then begin { Yes. } Result := DBIERR_KEYORRECDELETED; Exit; end; { Are we on a record? } if (bcInfo.Pos <> cpOnRecord) then begin { No. } case bcInfo.Pos of cpBOF : Result := DBIERR_BOF; cpEOF : Result := DBIERR_EOF; else Result := DBIERR_NOCURRREC; end; Exit; end; { Notify extenders. } Result := NotifyExtenders(ffeaBeforeRecUpdate, ffeaUpdateRecFail); if Result = DBIERR_NONE then begin AcqContentLock(ffclmWrite); Result := bcTable.PutRecord(bcDatabase.TransactionInfo, CursorID, bcInfo.refNr, aData, aRelLock, aKeyChanged); {!!.05} if (Result = DBIERR_NONE) then begin bcInfo.KeyValid := True; bcInfo.pos := cpOnRecord; { Notify extenders of successful update. } NotifyExtenders(ffeaAfterRecUpdate, ffeaNoAction); end else { Notify extenders of failed update. } NotifyExtenders(ffeaUpdateRecFail, ffeaNoAction); end; end; {--------} procedure TffSrSimpleCursor.Open(const aTableName : TffTableName; const aIndexName : TffName; const aIndexID : Longint; const aOpenMode : TffOpenMode; aShareMode : TffShareMode; aForServer : boolean; const aExclContLock : Boolean; {!!.10} aAttribs : TffFileAttributes); begin inherited Open(aTableName, aIndexName, aIndexID, aOpenMode, aShareMode, aForServer, aExclContLock, aAttribs); {!!.10} SetToBegin; end; {--------} procedure TffSrSimpleCursor.ResetRange; begin FFRaiseException(EffException, ffStrResServer, fferrRangeNotSupported, [bcTable.BaseName, Self.ClassName]); end; {--------} function TffSrSimpleCursor.SetRange(aDirectKey : boolean; aFieldCount1 : integer; aPartialLen1 : integer; aKeyData1 : PffByteArray; aKeyIncl1 : boolean; aFieldCount2 : integer; aPartialLen2 : integer; aKeyData2 : PffByteArray; aKeyIncl2 : boolean) : TffResult; begin Result := DBIERR_FF_RangeNotSupported; FFRaiseException(EffException, ffStrResServer, fferrRangeNotSupported, [bcTable.BaseName, Self.ClassName]); end; {--------} procedure TffSrSimpleCursor.SetToBegin; begin AcqContentLock(ffclmRead); try bcInfo.Deleted := False; bcInfo.KeyValid := False; bcInfo.Pos := cpBOF; FFInitI64(bcInfo.RefNr); finally RelContentLock(ffclmRead); end; end; {--------} function TffSrSimpleCursor.SetToBookmark(aBookmark : PffByteArray) : TffResult; begin Result := CheckBookmark(aBookmark); if (Result = DBIERR_NONE) then begin AcqContentLock(ffclmRead); try { Initialize the key path. } FFInitKeyPath(bcInfo.KeyPath); with PffSrBookmark(aBookmark)^ do begin bcInfo.Pos := sbPos; bcInfo.RefNr := sbRefNr; bcInfo.KeyValid := sbKeyValid; bcInfo.Deleted := false; { Does the record still exist? } try bcTable.GetRecord(bcDatabase.TransactionInfo, {!!.10} bcDatabase.DatabaseID, {!!.10} CursorID, sbRefNr, {!!.10} bcRecordData, ffsltNone, false, false); {!!.02} except on E:EffException do begin if E.ErrorCode = fferrRecDeleted then begin bcInfo.Pos := cpOnCrack; bcInfo.Deleted := True; end else begin SetToBegin; Result := DBIERR_INVALIDBOOKMARK; end; end else begin SetToBegin; Result := DBIERR_INVALIDBOOKMARK; end; end; end; { with } finally RelContentLock(ffclmRead); end; end; end; {--------} function TffSrSimpleCursor.SetToCursor(aCursor : TffSrBaseCursor) : TffResult; begin Result := DBIERR_NONE; if (aCursor.Table <> Table) then begin Result := DBIERR_DIFFERENTTABLES; Exit; end; AcqContentLock(ffclmRead); try bcInfo := aCursor.CursorInfo; finally RelContentLock(ffclmRead); end; end; {--------} procedure TffSrSimpleCursor.SetToEnd; begin AcqContentLock(ffclmRead); try bcInfo.Pos := cpEOF; bcInfo.KeyValid := False; FFInitI64(bcInfo.refNr); bcInfo.Deleted := false; finally RelContentLock(ffclmRead); end; end; {--------} function TffSrSimpleCursor.SetToKey(aSearchAction : TffSearchKeyAction; aDirectKey : boolean; aFieldCount : integer; aPartialLen : integer; aKeyData : PffByteArray) : TffResult; begin { To set to a specific record, specify a value for the RefNr property. } Result := DBIERR_INVALIDINDEXCREATE; FFRaiseException(EffException, ffStrResServer, fferrIndexNotSupported, [bcTable.BaseName, Self.ClassName]); end; {--------} function TffSrSimpleCursor.SwitchToIndex(aIndexID : integer; aPosnOnRec : boolean) : TffResult; begin Result := DBIERR_INVALIDINDEXCREATE; FFRaiseException(EffException, ffStrResServer, fferrIndexNotSupported, [bcTable.BaseName, Self.ClassName]); end; {====================================================================} end.