paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
1597ac8b91
lazarus-ccr/components/flashfiler/sourcelaz/fflleng.pas
wp_xxyyzz 27aea1d1ad flashfiler: Initial commit (ported by A.Soner). Not working yet (server error). 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5438 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2016-12-07 13:31:59 +00:00

1224 lines
52 KiB
ObjectPascal
Raw Blame History

{*********************************************************}
{* FlashFiler: Base engine 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 fflleng;
interface
uses
Windows,
Classes,
ffhash,
ffllbase,
ffllcomp,
fflldict,
ffsrbde,
ffsrlock;
type
{ This type defines the actions for which an extender may be notified.
ffeaAfterCreateClient - Called after a client is created.
If an extender returns an error code other than
DBIERR_NONE, the client will not be added and the
error code returned to the client application. The
client application is responsible for catching the
resulting exception and interpreting the error code
as there may be no client-side resource string
associated with the error code.
- All "after" actions will ignore extender error messages
}
TffEngineAction = ({record actions}
ffeaBeforeRecRead, ffeaAfterRecRead,
ffeaBeforeRecInsert, ffeaAfterRecInsert, ffeaInsertRecFail,
ffeaBeforeRecUpdate, ffeaAfterRecUpdate, ffeaUpdateRecFail,
ffeaBeforeRecDelete, ffeaAfterRecDelete, ffeaDeleteRecFail,
{table actions}
ffeaBeforeTabRead,
ffeaBeforeTabUpdate, ffeaTabUpdateFail,
ffeaBeforeTabDelete, ffeaTabDeleteFail,
ffeaBeforeTabInsert, ffeaTabInsertFail,
ffeaBeforeTabRestruct, ffeaTabRestructFail,
ffeaBeforeTabPack, ffeaTabPackFail,
ffeaBeforeAddInx, ffeaTabAddInxFail,
ffeaBeforeRebuildInx, ffeaTabRebuildInxFail,
ffeaBeforeTableLock, ffeaAfterTableLock, ffeaTableLockFail,
{databaseactions}
ffeaBeforeDBRead,
ffeaBeforeDBUpdate, ffeaDBUpdateFail,
ffeaBeforeDBDelete, ffeaDBDeleteFail,
ffeaBeforeDBInsert, ffeaDBInsertFail,
ffeaBeforeChgAliasPath, ffeaChgAliasPathFail,
{transactions actions}
ffeaAfterStartTrans,
ffeaBeforeCommit, ffeaAfterCommit, ffeaCommitFail, {!!.06}
ffeaBeforeRollback, ffeaAfterRollback,
{cursor actions}
ffeaBeforeCursorClose,
{BLOB actions}
ffeaBeforeBLOBCreate, ffeaAfterBLOBCreate, ffeaBLOBCreateFail,
ffeaBeforeBLOBRead, ffeaAfterBLOBRead, ffeaBLOBReadFail,
ffeaBeforeBLOBWrite, ffeaAfterBLOBWrite, ffeaBLOBWriteFail,
ffeaBeforeBLOBDelete, ffeaAfterBLOBDelete, ffeaBLOBDeleteFail,
ffeaBeforeBLOBTruncate, ffeaAfterBLOBTruncate, ffeaBLOBTruncateFail,
ffeaBeforeBLOBGetLength, ffeaAfterBLOBGetLength, ffeaBLOBGetLengthFail,
ffeaBeforeBLOBFree, ffeaAfterBLOBFree, ffeaBLOBFreeFail,
ffeaBeforeFileBLOBAdd, ffeaAfterFileBLOBAdd, ffeaFileBLOBAddFail,
ffeaBeforeBLOBLinkAdd, ffeaAfterBLOBLinkAdd, ffeaBLOBLinkAddFail,
{client actions}
ffeaBeforeRemoveClient,
ffeaAfterCreateClient,
{misc actions}
ffeaNoAction {used when no fallback action needs to be taken}
);
TffInterestedActions = set of TffEngineAction;
{ Used by a monitor to register interest in a specific type of server object.
For example, TffSrBaseCursor and TffSrDatabase. }
TffServerObjectClass = class of TffObject;
TffBaseEngineMonitor = class; { forward }
TffBaseEngineExtender = class; { forward }
TffInterestStructure = class; { forward }
{ TffBaseServerEngine is an abstract, virtual class that specifies the
minimum interface for a local or remote server engine. The base engine
provides support for adding and removing monitors. }
TffBaseServerEngine = class(TffStateComponent)
protected {private}
FInterests : TffInterestStructure;
{-This data structure tracks the interest of various monitors. }
FMonitors : TffThreadList;
{-The monitors registered with the engine. After a monitor registers
itself with the engine, it identifies the types of server objects
in which it is interested. }
protected
{property access methods}
function bseGetAutoSaveCfg : Boolean; virtual; abstract;
function bseGetReadOnly : Boolean; virtual; abstract;
procedure bseSetAutoSaveCfg(aValue : Boolean); virtual; abstract;{!!.01}
procedure bseSetReadOnly(aValue : Boolean); virtual; abstract; {!!.01}
procedure scSetState(const aState : TffState); override;
procedure AddInterest(aMonitor : TffBaseEngineMonitor;
serverObjectClass : TffServerObjectClass); virtual;
{-A monitor uses this method to register interest in a specific type of
server object. }
{Begin !!.06}
function ProcessRequest(aClientID : TffClientID;
aMsgID : Longint;
aTimeout : Longint;
aRequestData : Pointer;
aRequestDataLen : Longint;
aRequestDataType : TffNetMsgDataType;
var aReply : Pointer;
var aReplyLen : Longint;
aReplyType : TffNetMsgDataType) : TffResult; virtual;
{ Backdoor method for sending a request to a server engine.
Should only be implemented by remote server engines. }
function ProcessRequestNoReply(aClientID : TffClientID;
aMsgID : Longint;
aTimeout : Longint;
aRequestData : Pointer;
aRequestDataLen : Longint ) : TffResult; virtual;
{ Backdoor method for sending a request, no reply expected, to a
server engine. Should only be implemented by remote server engines. }
{End !!.06}
procedure RemoveAllInterest(aMonitor : TffBaseEngineMonitor); virtual;
{-A monitor uses this method to unregister its interest for all classes
in which it previously expressed interest. }
procedure RemoveInterest(aMonitor : TffBaseEngineMonitor;
serverObjectClass : TffServerObjectClass); virtual;
{-A monitor uses this method to remove interest in a specific type of
server object. }
public
{creation/destruction}
constructor Create(aOwner : TComponent); override;
destructor Destroy; override;
procedure FFAddDependent(ADependent : TffComponent); override; {!!.11}
procedure FFRemoveDependent(ADependent : TffComponent); override; {!!.11}
function GetInterestedMonitors(const anObjectClass : TffServerObjectClass) : TffList;
{-Use this method to retrieve a list of engine monitors interested in a
particular server object class. If no monitors have registered
interest then nil is returned. Otherwise this function returns a
TffList containing one or more TffIntListItems. You can convert
a TffIntListItem into a TffBaseEngineMonitor as follows:
aMonitor := TffBaseEngineMonitor(TffIntListItem(TffList[index]).KeyAsInt);
NOTE: The recipient of this functions' result is responsible for
freeing the TffList.
}
procedure GetServerNames(aList : TStrings;
aTimeout : Longint); virtual; abstract;
{ Returns a list of the servers available through the server's
transport. }
{Begin !!.10}
{ Event logging }
procedure Log(const aMsg : string); virtual; abstract;
{-Use this method to log a string to the event log. }
procedure LogAll(const Msgs : array of string); virtual; abstract;
{-Use this method to log multiple strings to the event log. }
procedure LogFmt(const aMsg : string; args : array of const); virtual; abstract;
{-Use this method to log a formatted string to the event log. }
{End !!.10}
{transaction tracking}
function TransactionCommit(const aDatabaseID : TffDatabaseID) : TffResult; virtual; abstract;
function TransactionRollback(const aDatabaseID : TffDatabaseID) : TffResult; virtual; abstract;
function TransactionStart(const aDatabaseID : TffDatabaseID;
const aFailSafe : boolean) : TffResult; virtual; abstract;
{Begin !!.10}
function TransactionStartWith(const aDatabaseID : TffDatabaseID;
const aFailSafe : Boolean;
const aCursorIDs : TffPointerList) : TffResult; virtual; abstract;
{End !!.10}
{client related stuff}
function ClientAdd(var aClientID : TffClientID;
const aClientName : TffNetName;
const aUserID : TffName;
const timeout : Longint;
var aHash : TffWord32) : TffResult; virtual; abstract;
{Begin !!.11}
function ClientAddEx(var aClientID : TffClientID;
const aClientName : TffNetName;
const aUserID : TffName;
const timeout : Longint;
const aClientVersion : Longint;
var aHash : TffWord32) : TffResult; virtual; abstract;
{ Same as ClientAdd but client version is supplied via the aClientVersion
parameter. }
{End !!.11}
function ClientRemove(aClientID : TffClientID) : TffResult; virtual; abstract;
function ClientSetTimeout(const aClientID : TffClientID;
const aTimeout : Longint) : TffResult; virtual; abstract;
{client session related stuff}
function SessionAdd(const aClientID : TffClientID; const timeout : Longint;
var aSessionID : TffSessionID) : TffResult; virtual; abstract;
function SessionCloseInactiveTables(aClientID : TffClientID) : TffResult; virtual; abstract; {!!.06}
function SessionCount(aClientID : TffClientID; var aCount : integer) : TffResult; virtual; abstract;
function SessionGetCurrent(aClientID : TffClientID; var aSessionID : TffSessionID) : TffResult; virtual; abstract;
function SessionRemove(aClientID : TffClientID; aSessionID : TffSessionID) : TffResult; virtual; abstract;
function SessionSetCurrent(aClientID : TffClientID; aSessionID : TffSessionID) : TffResult; virtual; abstract;
function SessionSetTimeout(const aClientID : TffClientID;
const aSessionID : TffSessionID;
const aTimeout : Longint) : TffResult; virtual; abstract;
{database related stuff}
function DatabaseAddAlias(const aAlias : TffName;
const aPath : TffPath;
aCheckSpace : Boolean; {!!.11}
const aClientID : TffClientID)
: TffResult; virtual; abstract;
function DatabaseAliasList(aList : TList;
aClientID : TffClientID) : TffResult; virtual; abstract;
{-Return a list of database aliases. aList will contain zero or more
instances of PffAliasDescriptor. }
function RecoveryAliasList(aList : TList;
aClientID : TffClientID) : TffResult; virtual; abstract;
{-Return a list of database aliases for use by a journal recovery
engine. The functionality of this method is identical to
DatabaseAliasList except that it does not require the server engine
to be started. }
function DatabaseChgAliasPath(aAlias : TffName;
aNewPath : TffPath;
aCheckSpace : Boolean; {!!.11}
aClientID : TffClientID)
: TffResult; virtual; abstract;
function DatabaseClose(aDatabaseID : TffDatabaseID) : TffResult; virtual; abstract;
function DatabaseDeleteAlias(aAlias : TffName;
aClientID : TffClientID) : TffResult; virtual; abstract;
function DatabaseGetAliasPath(aAlias : TffName;
var aPath : TffPath;
aClientID : TffClientID) : TffResult; virtual; abstract;
function DatabaseGetFreeSpace(const aDatabaseID : TffDatabaseID;
var aFreeSpace : Longint) : TffResult; virtual; abstract;
function DatabaseModifyAlias(const ClientID : TffClientID;
const aAlias : TffName;
const aNewName : TffName;
const aNewPath : TffPath;
aCheckSpace : Boolean) {!!.11}
: TffResult; virtual; abstract;
function DatabaseOpen(aClientID : TffClientID;
const aAlias : TffName;
const aOpenMode : TffOpenMode;
const aShareMode : TffShareMode;
const aTimeout : Longint;
var aDatabaseID : TffDatabaseID) : TffResult; virtual; abstract;
function DatabaseOpenNoAlias(aClientID : TffClientID;
const aPath : TffPath;
const aOpenMode : TffOpenMode;
const aShareMode : TffShareMode;
const aTimeout : Longint;
var aDatabaseID : TffDatabaseID) : TffResult; virtual; abstract;
function DatabaseSetTimeout(const aDatabaseID : TffDatabaseID;
const aTimeout : Longint) : TffResult; virtual; abstract;
function DatabaseTableExists(aDatabaseID : TffDatabaseID;
const aTableName : TffTableName;
var aExists : Boolean) : TffResult; virtual; abstract;
function DatabaseTableList(aDatabaseID : TffDatabaseID;
const aMask : TffFileNameExt;
aList : TList) : TffResult; virtual; abstract;
function DatabaseTableLockedExclusive(aDatabaseID : TffDatabaseID;
const aTableName : TffTableName;
var aLocked : Boolean) : TffResult; virtual; abstract;
{-Return a list of the tables for the specified database that fit the
specified filename mask. aList will contain zero or more instances
of PffTableDescriptor. }
{rebuild status related stuff}
function RebuildGetStatus(aRebuildID : Longint;
const aClientID : TffClientID;
var aIsPresent : boolean;
var aStatus : TffRebuildStatus) : TffResult; virtual; abstract;
{table related stuff}
function TableAddIndex(const aDatabaseID : TffDatabaseID;
const aCursorID : TffCursorID;
const aTableName : TffTableName;
const aIndexDesc : TffIndexDescriptor) : TffResult; virtual; abstract;
function TableBuild(aDatabaseID : TffDatabaseID;
aOverWrite : boolean;
const aTableName : TffTableName;
aForServer : boolean;
aDictionary : TffDataDictionary) : TffResult; virtual; abstract;
function TableDelete(aDatabaseID : TffDatabaseID; const aTableName : TffTableName) : TffResult; virtual; abstract;
function TableDropIndex(aDatabaseID : TffDatabaseID;
aCursorID : TffCursorID;
const aTableName : TffTableName;
const aIndexName : TffDictItemName;
aIndexID : Longint) : TffResult; virtual; abstract;
function TableEmpty(aDatabaseID : TffDatabaseID;
aCursorID : TffCursorID;
const aTableName : TffTableName) : TffResult; virtual; abstract;
function TableGetAutoInc(aCursorID : TffCursorID;
var aValue : TffWord32) : TffResult; virtual; abstract;
function TableGetDictionary(aDatabaseID : TffDatabaseID;
const aTableName : TffTableName;
aForServer : boolean;
aStream : TStream) : TffResult; virtual; abstract;
function TableGetRecCount(aCursorID : TffCursorID;
var aRecCount : Longint) : TffResult; virtual; abstract;
function TableGetRecCountAsync(aCursorID : TffCursorID; {!!.10}
var aRebuildID : Longint) : TffResult; virtual; abstract; {!!.10}
function TableOpen(const aDatabaseID : TffDatabaseID;
const aTableName : TffTableName;
const aForServer : boolean;
const aIndexName : TffName;
aIndexID : Longint;
const aOpenMode : TffOpenMode;
aShareMode : TffShareMode;
const aTimeout : Longint;
var aCursorID : TffCursorID;
aStream : TStream) : TffResult; virtual; abstract;
function TablePack(aDatabaseID : TffDatabaseID;
const aTableName : TffTableName;
var aRebuildID : Longint): TffResult; virtual; abstract;
function TableRebuildIndex(aDatabaseID : TffDatabaseID;
const aTableName : TffTableName;
const aIndexName : TffName;
aIndexID : Longint;
var aRebuildID : Longint): TffResult; virtual; abstract;
function TableRename(aDatabaseID : TffDatabaseID; const aOldName, aNewName : TffName) : TffResult; virtual; abstract;
function TableRestructure(aDatabaseID : TffDatabaseID;
const aTableName : TffTableName;
aDictionary : TffDataDictionary;
aFieldMap : TffStringList;
var aRebuildID : Longint): TffResult; virtual; abstract;
function TableSetAutoInc(aCursorID : TffCursorID;
aValue : TffWord32) : TffResult; virtual; abstract;
{Begin !!.11}
function TableVersion(aDatabaseID : TffDatabaseID;
const aTableName : TffTableName;
var aVersion : Longint) : TffResult; virtual; abstract;
{End !!.11}
{table locks via cursor}
function TableIsLocked(aCursorID : TffCursorID; aLockType : TffLockType;
var aIsLocked : boolean) : TffResult; virtual; abstract;
function TableLockAcquire(aCursorID : TffCursorID; aLockType : TffLockType) : TffResult; virtual; abstract;
function TableLockRelease(aCursorID : TffCursorID; aAllLocks : boolean) : TffResult; virtual; abstract;
{cursor stuff}
function CursorClone(aCursorID : TffCursorID; aOpenMode : TffOpenMode;
var aNewCursorID : TffCursorID) : TffResult; virtual; abstract;
function CursorClose(aCursorID : TffCursorID) : TffResult; virtual; abstract;
function CursorCompareBookmarks(aCursorID : TffCursorID;
aBookmark1,
aBookmark2 : PffByteArray;
var aCompResult : Longint) : TffResult; virtual; abstract;
{Begin !!.02}
function CursorCopyRecords(aSrcCursorID,
aDestCursorID : TffCursorID;
aCopyBLOBs : Boolean) : TffResult; virtual; abstract;
{End !!.02}
function CursorDeleteRecords(aCursorID : TffCursorID) : TffResult; virtual; abstract; {!!.06}
function CursorGetBookmark(aCursorID : TffCursorID; aBookmark : PffByteArray) : TffResult; virtual; abstract;
function CursorGetBookmarkSize(aCursorID : TffCursorID;
var aSize : integer) : TffResult; virtual; abstract;
{Begin !!.03}
function CursorListBLOBFreeSpace(aCursorID : TffCursorID;
const aInMemory : Boolean;
aStream : TStream) : TffResult; virtual; abstract;
{End !!.03}
function CursorOverrideFilter(aCursorID : Longint;
aExpression : pCANExpr;
aTimeout : TffWord32) : TffResult; virtual; abstract;
function CursorResetRange(aCursorID : TffCursorID) : TffResult; virtual; abstract;
function CursorRestoreFilter(aCursorID : Longint) : TffResult; virtual; abstract;
function CursorSetRange(aCursorID : TffCursorID;
aDirectKey : boolean;
aFieldCount1 : integer;
aPartialLen1 : integer;
aKeyData1 : PffByteArray;
aKeyIncl1 : boolean;
aFieldCount2 : integer;
aPartialLen2 : integer;
aKeyData2 : PffByteArray;
aKeyIncl2 : boolean) : TffResult; virtual; abstract;
function CursorSetTimeout(const aCursorID : TffCursorID;
const aTimeout : Longint) : TffResult; virtual; abstract;
function CursorSetToBegin(aCursorID : TffCursorID) : TffResult; virtual; abstract;
function CursorSetToBookmark(aCursorID : TffCursorID; aBookmark : PffByteArray) : TffResult; virtual; abstract;
function CursorSetToCursor(aDestCursorID : TffCursorID; aSrcCursorID : TffCursorID) : TffResult; virtual; abstract;
function CursorSetToEnd(aCursorID : TffCursorID) : TffResult; virtual; abstract;
function CursorSetToKey(aCursorID : TffCursorID;
aSearchAction : TffSearchKeyAction;
aDirectKey : boolean;
aFieldCount : integer;
aPartialLen : integer;
aKeyData : PffByteArray) : TffResult; virtual; abstract;
function CursorSwitchToIndex(aCursorID : TffCursorID;
aIndexName : TffDictItemName;
aIndexID : integer;
aPosnOnRec : boolean) : TffResult; virtual; abstract;
function CursorSetFilter(aCursorID : TffCursorID;
aExpression : pCANExpr;
aTimeout : TffWord32) : TffResult; virtual; abstract;
{record stuff}
function RecordDelete(aCursorID : TffCursorID; aData : PffByteArray) : TffResult; virtual; abstract;
function RecordDeleteBatch(aCursorID : TffCursorID;
aBMCount : Longint;
aBMLen : Longint;
aData : PffByteArray;
aErrors : PffLongintArray) : TffResult; virtual; abstract;
function RecordExtractKey(aCursorID : TffCursorID; aData : PffByteArray; aKey : PffByteArray) : TffResult; virtual; abstract;
function RecordGet(aCursorID : TffCursorID; aLockType : TffLockType; aData : PffByteArray) : TffResult; virtual; abstract;
function RecordGetBatch(aCursorID : TffCursorID;
aRecCount : Longint;
aRecLen : Longint;
var aRecRead : Longint;
aData : PffByteArray;
var aError : TffResult) : TffResult; virtual; abstract;
function RecordGetForKey(aCursorID : TffCursorID;
aDirectKey : boolean;
aFieldCount : integer;
aPartialLen : integer;
aKeyData : PffByteArray;
aData : PffByteArray;
aFirstCall : Boolean) : TffResult; virtual; abstract;
function RecordGetNext(aCursorID : TffCursorID; aLockType : TffLockType; aData : PffByteArray) : TffResult; virtual; abstract;
function RecordGetPrior(aCursorID : TffCursorID; aLockType : TffLockType; aData : PffByteArray) : TffResult; virtual; abstract;
function RecordInsert(aCursorID : TffCursorID; aLockType : TffLockType; aData : PffByteArray) : TffResult; virtual; abstract;
function RecordInsertBatch(aCursorID : TffCursorID;
aRecCount : Longint;
aRecLen : Longint;
aData : PffByteArray;
aErrors : PffLongintArray) : TffResult; virtual; abstract;
function RecordIsLocked(aCursorID : TffCursorID; aLockType : TffLockType;
var aIsLocked : boolean) : TffResult; virtual; abstract;
function RecordModify(aCursorID : TffCursorID; aData : PffByteArray; aRelLock : boolean) : TffResult; virtual; abstract;
function RecordRelLock(aCursorID : TffCursorID; aAllLocks : boolean) : TffResult; virtual; abstract;
{BLOB stuff}
function BLOBCreate(aCursorID : TffCursorID;
var aBlobNr : TffInt64) : TffResult; virtual; abstract;
function BLOBDelete(aCursorID : TffCursorID; aBLOBNr : TffInt64) : TffResult; virtual; abstract;
{Begin !!.03}
function BLOBListSegments(aCursorID : TffCursorID;
aBLOBNr : TffInt64;
aStream : TStream) : TffResult; virtual; abstract;
{End !!.03}
function BLOBRead(aCursorID : TffCursorID;
aBLOBNr : TffInt64;
aOffset : TffWord32; {!!.06}
aLen : TffWord32; {!!.06}
var aBLOB;
var aBytesRead : TffWord32) {!!.06}
: TffResult; virtual; abstract;
function BLOBFree(aCursorID : TffCursorID; aBLOBNr : TffInt64;
readOnly : boolean) : TffResult; virtual; abstract;
function BLOBGetLength(aCursorID : TffCursorID; aBLOBNr : TffInt64;
var aLength : Longint) : TffResult; virtual; abstract;
function BLOBTruncate(aCursorID : TffCursorID; aBLOBNr : TffInt64;
aBLOBLength : Longint) : TffResult; virtual; abstract;
function BLOBWrite(aCursorID : TffCursorID; aBLOBNr : TffInt64;
aOffset : Longint;
aLen : Longint;
var aBLOB ) : TffResult; virtual; abstract;
function FileBLOBAdd(aCursorID : TffCursorID;
const aFileName : TffFullFileName;
var aBLOBNr : TffInt64) : TffResult; virtual; abstract;
{SQL Stuff }
function SQLAlloc(aClientID : TffClientID;
aDatabaseID : TffDatabaseID;
aTimeout : Longint;
var aStmtID : TffSqlStmtID) : TffResult; virtual; abstract;
function SQLExec(aStmtID : TffSqlStmtID;
aOpenMode : TffOpenMode;
var aCursorID : TffCursorID;
aStream : TStream) : TffResult; virtual; abstract;
function SQLExecDirect(aClientID : TffClientID;
aDatabaseID : TffDatabaseID;
aQueryText : PChar;
aTimeout : Longint;
aOpenMode : TffOpenMode;
var aCursorID : TffCursorID;
aStream : TStream) : TffResult; virtual; abstract;
function SQLFree(aStmtID : TffSqlStmtID) : TffResult; virtual; abstract;
function SQLPrepare(aStmtID : TffSqlStmtID;
aQueryText : PChar;
aStream : TStream) : TffResult; virtual; abstract;
function SQLSetParams(aStmtID : TffSqlStmtID;
aNumParams : word;
aParamDescs : Pointer;
aDataBuffer : PffByteArray;
aDataLen : integer;
aStream : TStream) : TffResult; virtual; abstract;
{misc stuff}
function GetServerDateTime(var aDateTime : TDateTime) : TffResult; virtual; abstract;
{Begin !!.10}
function GetServerSystemTime(var aSystemTime : TSystemTime)
: TffResult; virtual; abstract;
function GetServerGUID(var aGUID : TGUID)
: TffResult; virtual; abstract;
function GetServerID(var aUniqueID : TGUID)
: TffResult; virtual; abstract;
function GetServerStatistics(var aStats : TffServerStatistics)
: TffResult; virtual; abstract;
function GetCommandHandlerStatistics(const aCmdHandlerIdx : Integer;
var aStats : TffCommandHandlerStatistics)
: TffResult; virtual; abstract;
function GetTransportStatistics(const aCmdHandlerIdx : Integer;
const aTransportIdx : Integer;
var aStats : TffTransportStatistics)
: TffResult; virtual; abstract;
{End !!.10}
published
property IsReadOnly : Boolean
read bseGetReadOnly
write bseSetReadOnly {!!.01}
default False; {!!.01}
property NoAutoSaveCfg : Boolean
read bseGetAutoSaveCfg
write bseSetAutoSaveCfg {!!.01}
default False; {!!.01}
end;
{ This is the base implementation for an engine monitor. An engine monitor
attaches directly to a server engine and registers interest in specific
types of server objects. When an object of that type is opened in the
server, the monitor has the opportunity to express interest in the object.
The monitor can then supply an extender that will be associated with the
object and will receive notification of events pertaining to the object. }
TffBaseEngineMonitor = class(TffStateComponent)
protected
FServerEngine : TffBaseServerEngine;
procedure bemSetServerEngine(anEngine : TffBaseServerEngine); virtual;
{-Called when a monitor is associated with a server engine. If the
monitor is already associated with a server engine then it calls
OldEngine.RemoveMonitor. If the monitor is to be associated with
a new engine then it calls NewEngine.AddMonitor.
Subclasses should override this method to register interest in specific
types of server objects. }
{ State methods }
procedure scInitialize; override;
procedure scPrepareForShutdown; override;
procedure scShutdown; override;
procedure scStartup; override;
public
destructor Destroy; override;
procedure AddInterest(anObjectClass : TffServerObjectClass);
{-Use this method to have the monitor notify its parent server engine
of interest in a server object class. }
procedure FFNotificationEx(const AOp : Byte; AFrom : TffComponent; {!!.11}
const AData : TffWord32); override; {!!.11}
procedure RemoveAllInterest;
{-Use this method to have the monitor tells its parent engine to remove
all interests of the monitor. }
procedure RemoveInterest(anObjectClass : TffServerObjectClass);
{-Use this method to have the monitor tells its parent engine to remove
its interest in the specified object class. }
function Interested(aServerObject : TffObject) : TffBaseEngineExtender; virtual; abstract;
{ This function is called from the server when an object (e.g., cursor)
is first opened. If the monitor is interested in receiving events
for the object, it must create and return an instance of a class that
can handle events for the object. Otherwise it should return nil.
This method is called only for the type of objects in which the monitor
previously expressed interested.
When deriving a class from TffBaseEngineMonitor, it is up to the
extender designer to verify the class of ServerObject is one that is
expected.
}
published
property ServerEngine : TffBaseServerEngine read FServerEngine
write bemSetServerEngine;
{ Associates an engine monitor with an engine. }
end;
{ This is the base class for engine extenders. An engine extender is attached
to a specific type of server object as governed by an engine monitor. The
types of notifications received by the extender depend upon the type of
object being extended.
An extender is freed when the server object with which it is associated
is freed. }
TffBaseEngineExtender = class(TffObject)
protected
FParent : TffBaseEngineMonitor;
FActions : TffInterestedActions;
{ Set of actions extender is interested in.}
public
constructor Create(aOwner : TffBaseEngineMonitor); virtual;
function Notify(aServerObject : TffObject;
aAction : TffEngineAction) : TffResult; virtual; abstract;
{ This method is called when the extender is to be notified of an
action affecting the server object with which the extender is
associated. If the extender performs its operations, whatever they
may be, then this function should return DBIERR_NONE. If a failure
occurs and the server should discontinue the current operation with this
server object, this function should return an error code other than
DBIERR_NONE.
Some actions may pay attention to the error codes while other actions
may ignore the error codes. If an action pays attention to the error
code then extenders "after" the extender returning the error will not
be notified of the action.
}
property InterestedActions : TffInterestedActions
read FActions;
{ The set of actions in which the extender is interested. }
end;
{ The following class is used to track a monitor's interest. It stores
data in the following manner:
1. To support retrieval of all monitors interested in a particular
class of object, it creates a hash table where the hash is based
on the class' name. The hash bucket points to a list of monitors.
2. To support removal of all interest for a monitor, it maintains a
separate hash table where the hash is based upon the monitor}
TffInterestStructure = class(TffObject)
private
FHashByInterest : TffHash;
{ Given a server object class, this hash table returns a list of the
monitors interested in that object class. }
FHashByMonitor : TffHash;
{ Given an engine monitor, this hash table returns a list of the
object classes in which the monitor has expressed interest. We use
this data structure in RemoveAllInterest to speed up our search
for the monitors in FHashByInterest. }
FPortal : TffReadWritePortal;
protected
procedure DisposeList(Sender : TffBaseHashTable; aData : pointer);
{-This method is called when a hash table entry is removed. }
procedure RemoveInterestPrim(const aMonitor : TffBaseEngineMonitor;
const anObjectClass : TffServerObjectClass);
{-This method removes an interest entry from the FHashByInterest
hash table. }
public
constructor Create;
destructor Destroy; override;
procedure AddInterest(const aMonitor : TffBaseEngineMonitor;
const anObjectClass : TffServerObjectClass);
{-Use this method to add a monitor's interest in a certain class. }
function BeginRead : TffInterestStructure;
{-Use this method to obtain read access to the data. }
function BeginWrite : TffInterestStructure;
{-Use this method to obtain write access to the data. }
procedure EndRead;
{-This method must be called after BeginRead once read access is no
longer needed. }
procedure EndWrite;
{-This method must be called after BeginWrite once write access is no
longer needed. }
function GetInterestedMonitors(const anObjectClass : TffServerObjectClass) : TffList;
{-Use this method to retrieve a list of engine monitors interested in a
particular server object class. If no monitors have registered
interest then nil is returned. Otherwise this function returns a
TffList containing one or more TffIntListItems. You can convert
a TffIntListItem into a TffBaseEngineMonitor as follows:
aMonitor := TffBaseEngineMonitor(TffIntListItem(TffList[index]).KeyAsInt);
NOTE: The recipient of this functions' result is responsible for
freeing the TffList.
}
procedure RemoveAllInterest(const aMonitor : TffBaseEngineMonitor);
{-Use this method to remove interest in all things for which a monitor
previously registered interest. }
procedure RemoveInterest(const aMonitor : TffBaseEngineMonitor;
const anObjectClass : TffServerObjectClass);
{-Use this method to remove a monitor's interest in a certain class. }
end;
var
FFServerEngines : TffThreadList;
implementation
{===TffBaseServerEngine==============================================}
constructor TffBaseServerEngine.Create(aOwner : TComponent);
var
aListItem : TffIntListItem;
begin
inherited Create(aOwner);
{ Add our instance to the global server list }
aListItem := TffIntListItem.Create(Longint(Self));
with FFServerEngines.BeginWrite do
try
Insert(aListItem);
finally
EndWrite;
end;
FInterests := TffInterestStructure.Create;
FMonitors := TffThreadList.Create;
end;
{--------}
destructor TffBaseServerEngine.Destroy;
begin
FFNotifyDependents(ffn_Destroy); {!!.11}
FMonitors.Free; {!!.11}
if assigned(FInterests) then begin
FInterests.Free;
FInterests := nil;
end;
{ Remove our instance from the global server list }
with FFServerEngines.BeginWrite do
try
Delete(Longint(Self));
finally
EndWrite;
end;
inherited Destroy;
end;
{--------}
procedure TffBaseServerEngine.scSetState(const aState : TffState);
var
Idx : Longint;
NextState : TffState;
OldState : TffState;
Monitor : TFFBaseEngineMonitor;
begin
if aState = scState then exit;
OldState := scState;
try
if Assigned(FMonitors) then
with FMonitors.BeginRead do
try
while scState <> aState do begin
{ Based upon our current state & the target state, get the next state. }
NextState := ffStateDiagram[scState, aState];
{ Move all monitors to the specified state. }
for Idx := Pred(Count) downto 0 do begin
Monitor := TffBaseEngineMonitor(TffIntListItem(Items[Idx]).KeyAsInt);
Monitor.State := NextState;
end;
{ Change our state. }
scState := NextState;
{ Call the appropriate internal method for this state. }
case NextState of
ffesInactive, ffesStopped :
scShutdown;
ffesInitializing :
scInitialize;
ffesStarting :
scStartup;
ffesShuttingDown, ffesStopping :
scPrepareForShutdown;
end; { case }
if assigned(scOnStateChange) then
scOnStateChange(Self);
end; { while }
finally
EndRead;
end
else
inherited;
except
scState := OldState;
raise;
end;
end;
{--------}
procedure TffBaseServerEngine.AddInterest(aMonitor : TffBaseEngineMonitor;
serverObjectClass : TffServerObjectClass);
begin
with FInterests.BeginWrite do
try
AddInterest(aMonitor, serverObjectClass);
finally
EndWrite;
end;
end;
{Begin !!.11}
{--------}
procedure TffBaseServerEngine.FFAddDependent(ADependent : TffComponent);
var
aListItem : TffIntListItem;
begin
inherited;
if ADependent is TffBaseEngineMonitor then begin
aListItem := TffIntListItem.Create(Longint(ADependent));
with FMonitors.BeginWrite do
try
FMonitors.Insert(aListItem);
finally
EndWrite;
end;
end;
end;
{--------}
procedure TffBaseServerEngine.FFRemoveDependent(ADependent : TffComponent);
begin
inherited;
if ADependent is TffBaseEngineMonitor then
with FMonitors.BeginWrite do
try
Delete(Longint(ADependent));
RemoveAllInterest(TffBaseEngineMonitor(ADependent));
finally
EndWrite;
end;
end;
{End !!.11}
{--------}
function TffBaseServerEngine.GetInterestedMonitors
(const anObjectClass : TffServerObjectClass) : TffList;
begin
with FInterests.BeginRead do
try
Result := FInterests.GetInterestedMonitors(anObjectClass);
finally
EndRead;
end;
end;
{Begin !!.06}
{--------}
function TffBaseServerEngine.ProcessRequest(aClientID : TffClientID;
aMsgID : Longint;
aTimeout : Longint;
aRequestData : Pointer;
aRequestDataLen : Longint;
aRequestDataType : TffNetMsgDataType;
var aReply : Pointer;
var aReplyLen : Longint;
aReplyType : TffNetMsgDataType) : TffResult;
begin
{ Do nothing. }
Result := DBIERR_NONE;
end;
{--------}
function TffBaseServerEngine.ProcessRequestNoReply(aClientID : TffClientID;
aMsgID : Longint;
aTimeout : Longint;
aRequestData : Pointer;
aRequestDataLen : Longint ) : TffResult;
begin
{ Do nothing. }
Result := DBIERR_NONE;
end;
{End !!.06}
{--------}
procedure TffBaseServerEngine.RemoveAllInterest(aMonitor : TffBaseEngineMonitor);
begin
with FInterests.BeginWrite do
try
RemoveAllInterest(aMonitor);
finally
EndWrite;
end;
end;
{--------}
procedure TffBaseServerEngine.RemoveInterest(aMonitor : TffBaseEngineMonitor;
serverObjectClass : TffServerObjectClass);
begin
with FInterests.BeginWrite do
try
RemoveInterest(aMonitor, serverObjectClass);
finally
EndWrite;
end;
end;
{====================================================================}
{===TffBaseEngineMonitor=============================================}
destructor TffBaseEngineMonitor.Destroy;
begin
if assigned(FServerEngine) then
FServerEngine.FFRemoveDependent(Self); {!!.11}
inherited Destroy;
end;
{--------}
procedure TffBaseEngineMonitor.AddInterest(anObjectClass : TffServerObjectClass);
begin
if assigned(FServerEngine) then
FServerEngine.AddInterest(Self, anObjectClass);
end;
{--------}
procedure TffBaseEngineMonitor.bemSetServerEngine(anEngine : TffBaseServerEngine);
{Rewritten !!.11}
begin
if anEngine <> FServerEngine then begin
if assigned(FServerEngine) then
FServerEngine.FFRemoveDependent(Self);
if assigned(anEngine) then
anEngine.FFAddDependent(Self);
FServerEngine := anEngine;
end;
end;
{Begin !!.11}
{--------}
procedure TffBaseEngineMonitor.FFNotificationEx(const AOp : Byte; AFrom : TffComponent;
const AData : TffWord32);
begin
inherited;
if (AFrom = FServerEngine) and
(AOp in [ffn_Destroy, ffn_Remove]) then begin
FServerEngine.FFRemoveDependent(Self);
FServerEngine := nil;
end;
end;
{End !!.11}
{--------}
procedure TffBaseEngineMonitor.RemoveAllInterest;
begin
if assigned(FServerEngine) then
FServerEngine.RemoveAllInterest(Self);
end;
{--------}
procedure TffBaseEngineMonitor.RemoveInterest(anObjectClass : TffServerObjectClass);
begin
if assigned(FServerEngine) then
FServerEngine.RemoveInterest(Self, anObjectClass);
end;
{--------}
procedure TffBaseEngineMonitor.scInitialize;
begin
{ Do nothing - avoid abstract error }
end;
{--------}
procedure TffBaseEngineMonitor.scPrepareForShutdown;
begin
{ Do nothing - avoid abstract error }
end;
{--------}
procedure TffBaseEngineMonitor.scShutdown;
begin
{ Do nothing - avoid abstract error }
end;
{--------}
procedure TffBaseEngineMonitor.scStartup;
begin
{ Do nothing - avoid abstract error }
end;
{====================================================================}
{===TffInterestStructure=============================================}
constructor TffInterestStructure.Create;
begin
inherited Create;
FHashByInterest := TffHash.Create(0);
FHashByInterest.OnDisposeData := DisposeList;
FHashByMonitor := TffHash.Create(0);
FHashByMonitor.OnDisposeData := DisposeList;
FPortal := TffReadWritePortal.Create;
end;
{--------}
destructor TffInterestStructure.Destroy;
begin
if assigned(FHashByInterest) then
FHashByInterest.Free;
if assigned(FHashByMonitor) then
FHashByMonitor.Free;
if assigned(FPortal) then
FPortal.Free;
inherited Destroy;
end;
{--------}
procedure TffInterestStructure.AddInterest(const aMonitor : TffBaseEngineMonitor;
const anObjectClass : TffServerObjectClass);
var
MonitorList : TffList;
Item : TffIntListItem;
begin
{ Has interest already been registered in the class? }
Item := TffIntListItem.Create(Longint(aMonitor));
MonitorList := FHashByInterest.Get(Longint(anObjectClass));
if assigned(MonitorList) then begin
{ If so then append the new interest. }
MonitorList.Insert(Item);
end else begin
{ Otherwise, create a new entry and add the interest. }
MonitorList := TffList.Create;
MonitorList.Insert(Item);
FHashByInterest.Add(Longint(anObjectClass), pointer(MonitorList));
end;
{ Has this monitor registered for any other classes? }
Item := TffIntListItem.Create(Longint(anObjectClass));
MonitorList := FHashByMonitor.Get(Longint(aMonitor));
if assigned(MonitorList) then begin
{ If so then add this entry to the hash for monitors. }
MonitorList.Insert(Item);
end else begin
{ Otherwise, create a new entry for the monitor. }
MonitorList := TffList.Create;
MonitorList.Insert(Item);
FHashByMonitor.Add(Longint(aMonitor), pointer(MonitorList));
end;
end;
{--------}
function TffInterestStructure.BeginRead : TffInterestStructure;
begin
FPortal.BeginRead;
Result := Self;
end;
{--------}
function TffInterestStructure.BeginWrite : TffInterestStructure;
begin
FPortal.BeginWrite;
Result := Self;
end;
{--------}
procedure TffInterestStructure.DisposeList(Sender : TffBaseHashTable; aData : pointer);
var
Index : Longint;
ItemList : TffList;
begin
if assigned(aData) then begin
ItemList := TffList(aData);
{ Free the items in the list. }
for Index := pred(ItemList.Count) downto 0 do
ItemList[Index].Free;
ItemList.Free;
end;
end;
{--------}
procedure TffInterestStructure.EndRead;
begin
FPortal.EndRead;
end;
{--------}
procedure TffInterestStructure.EndWrite;
begin
FPortal.EndWrite;
end;
{--------}
function TffInterestStructure.GetInterestedMonitors
(const anObjectClass : TffServerObjectClass) : TffList;
var
anItem : TffIntListItem;
Index : Longint;
MonitorList : TffList;
begin
Result := nil;
{ Get the list of monitors interested in this object class. }
MonitorList := FHashByInterest.Get(Longint(anObjectClass));
{ If there are monitors, copy the info over to the result list. }
if assigned(MonitorList) then begin
Result := TffList.Create;
for Index := 0 to pred(MonitorList.Count) do begin
anItem := TffIntListItem.Create(TffIntListItem(MonitorList[Index]).KeyAsInt);
Result.Insert(anItem);
end;
end;
end;
{--------}
procedure TffInterestStructure.RemoveAllInterest(const aMonitor : TffBaseEngineMonitor);
var
Index : integer;
ClassList : TffList;
begin
{ Do we have any interests registered for this monitor? }
ClassList := FHashByMonitor.Get(Longint(aMonitor));
if assigned(ClassList) then begin
{ For each class in which the monitor registered interest, remove the
monitor from that class' list in FHashByInterest. }
for Index := pred(ClassList.Count) downto 0 do
RemoveInterestPrim(aMonitor,
TffServerObjectClass(TffIntListItem(ClassList[Index]).KeyAsInt));
{ Now get rid of the entry for this monitor. }
FHashByMonitor.Remove(Longint(aMonitor));
end;
end;
{--------}
procedure TffInterestStructure.RemoveInterest(const aMonitor : TffBaseEngineMonitor;
const anObjectClass : TffServerObjectClass);
var
ItemList : TffList;
begin
{ Remove the monitor's interest for this specific class. }
RemoveInterestPrim(aMonitor, anObjectClass);
{ Now remove the class from the monitor's list of interests. }
ItemList := FHashByMonitor.Get(Longint(aMonitor));
if assigned(ItemList) then
ItemList.Delete(Longint(anObjectClass));
{ If our list is empty then get rid of it. }
if ItemList.Count = 0 then
FHashByInterest.Remove(Longint(aMonitor));
end;
{--------}
procedure TffInterestStructure.RemoveInterestPrim(const aMonitor : TffBaseEngineMonitor;
const anObjectClass : TffServerObjectClass);
var
MonitorList : TffList;
begin
MonitorList := FHashByInterest.Get(Longint(anObjectClass));
{ If we did find a set of interests for the specified object class,
scan through it and eliminate registrations for the specified monitor. }
if assigned(MonitorList) then
MonitorList.Delete(aMonitor);
{ If our list is empty then get rid of it. }
if MonitorList.Count = 0 then
FHashByInterest.Remove(Longint(anObjectClass));
end;
{====================================================================}
constructor TffBaseEngineExtender.Create(aOwner : TffBaseEngineMonitor);
begin
inherited Create; {!!.02}
FParent := aOwner;
FActions := [];
end;
{====================================================================}
procedure FinalizeUnit;
begin
FFServerEngines.Free;
end;
procedure InitializeUnit;
begin
FFServerEngines := TffThreadList.Create;
end;
initialization
InitializeUnit;
finalization
FinalizeUnit;
end.
Reference in New Issue View Git Blame Copy Permalink