fibdatabase.pas

FIBPlus version 6-96. This is somewhat usefull interbase database components. TFIBDatabase, TFIBTab

    function TestConnected:Boolean;
    function GetServerTime:TDateTime;
  public
    function ClientVersion:string;
    function ClientMajorVersion:integer;
    function ClientMinorVersion:integer;
    function IsFirebirdConnect:boolean;

    function IsUnicodeConnect:boolean;
    function IsIB2007Connect:boolean;
    function NeedUTFEncodeDDL:boolean;
    function NeedUnicodeFieldsTranslation:boolean;
    function NeedUnicodeFieldTranslation(FieldCharacterSet:integer):boolean;
{$IFDEF SUPPORT_KOI8_CHARSET}
    function IsKOI8Connect:boolean;
{$ENDIF}
{FB2 features}
    function GetContextVariable(ContextSpace:TFBContextSpace;const VarName:string
    ;aTransaction:TFIBTransaction=nil
    ):Variant;
    procedure SetContextVariable( ContextSpace:TFBContextSpace;const VarName,VarValue:string
   ;aTransaction:TFIBTransaction=nil
    );

   function CanCancelOperationFB21:boolean;
   procedure CancelOperationFB21(ConnectForCancel:TFIBDatabase=nil);

   procedure RaiseCancelOperations;
   procedure EnableCancelOperations;
   procedure DisableCancelOperations;
//
    function UnicodeCharSets:TIBCharSets;
    function BytesInUnicodeChar(CharSetId:integer):Byte;
    function ReturnDeclaredFieldSize:boolean;
    (* Properties*)

{$IFDEF USE_DEPRECATE_METHODS1}
    property DataSetCount:Integer read GetFIBBasesCount; // deprecated;
    property DataSets[Index:Integer]:TFIBBase read GetFIBBase; // deprecated;
{$ENDIF}
    property FIBBaseCount:Integer read GetFIBBasesCount;
    property FIBBases[Index:Integer]:TFIBBase read GetFIBBase;

    property Handle:TISC_DB_HANDLE read FHandle write SetHandle;
    property HandleIsShared:Boolean read FHandleIsShared;
    property TransactionCount:Integer read GetTransactionCount;
    property FirstActiveTransaction:TFIBTransaction read GetFirstActiveTransaction;
    property ActiveTransactionCount:Integer read GetActiveTransactionCount;
    property Transactions[Index:Integer]:TFIBTransaction read GetTransaction;

    (* Database Info properties--Advanced stuff (translated from isc_database_info) *)
    property AttachmentID:Long read GetAttachmentID; // isc_info_attachment_id
    property Allocation:Long read GetAllocation; // isc_info_allocation
    property BaseLevel:Long read GetBaseLevel; // isc_info_base_level
    property DBFileName:string read GetDBFileName; // isc_info_db_id
    property DBSiteName:string read GetDBSiteName;
    property IsRemoteConnect:boolean read GetIsRemoteConnect;
    property DBImplementationNo:Long read GetDBImplementationNo; // isc_info_implementation
    property DBImplementationClass:Long read GetDBImplementationClass;
    property NoReserve:Long read GetNoReserve; // isc_info_no_reserve
    property ODSMinorVersion:Long read GetODSMinorVersion; // isc_info_ods_minor_version
    property ODSMajorVersion:Long read GetODSMajorVersion; // isc_info_ods_version
    property PageSize:Long read GetPageSize; // isc_info_page_size
    property Version:string read GetVersion; // isc_info_info_version

    property FBVersion:string read GetFBVersion;
    property FBAttachCharsetID:Integer read GetAttachCharset;

    property ServerMajorVersion:integer read GetServerMajorVersion;
    property ServerMinorVersion:integer read GetServerMinorVersion;
    property ServerBuild:integer read GetServerBuild;
    property ServerRelease:integer read GetServerRelease;

    property CurrentMemory:Long read GetCurrentMemory; // isc_info_current_memory
    property ForcedWrites:Long read GetForcedWrites; // isc_info_forced_writes
    property MaxMemory:Long read GetMaxMemory; // isc_info_max_memory
    property NumBuffers:Long read GetNumBuffers; // isc_info_num_buffers
    property SweepInterval:Long read GetSweepInterval; // isc_info_sweep_interval
    property UserNames:TStringList read GetUserNames; // isc_info_user_names
    property Fetches:Long read GetFetches; // isc_info_fetches
    property Marks:Long read GetMarks; // isc_info_marks
    property Reads:Long read GetReads; // isc_info_reads
    property Writes:Long read GetWrites; // isc_info_writes
    property BackoutCount:TStringList read GetBackoutCount; // isc_info_backout_count
    property DeleteCount:TStringList read GetDeleteCount; // isc_info_delete_count
    property ExpungeCount:TStringList read GetExpungeCount; // isc_info_expunge_count
    property InsertCount:TStringList read GetInsertCount; // isc_info_insert_count
    property PurgeCount:TStringList read GetPurgeCount; // isc_info_purge_count
    property ReadIdxCount:TStringList read GetReadIdxCount; // isc_info_read_idx_count
    property ReadSeqCount:TStringList read GetReadSeqCount; // isc_info_read_seq_count
    property UpdateCount:TStringList read GetUpdateCount; // isc_info_update_count

    property IndexedReadCount[const TableName:string]:integer read GetIndexedReadCount;
    property NonIndexedReadCount[const TableName:string]:integer read GetNonIndexedReadCount;
    property InsertsCount[const TableName:string]:integer read GetInsertsCount;
    property UpdatesCount[const TableName:string]:integer read GetUpdatesCount;
    property DeletesCount[const TableName:string]:integer read GetDeletesCount;
    property AllModifications:integer read GetAllModifications;

    property LogFile:Long read GetLogFile; // isc_info_log_file
    property CurLogFileName:string read GetCurLogFileName; // isc_info_cur_logfile_name
    property CurLogPartitionOffset:Long read GetCurLogPartitionOffset; // isc_info_cur_log_part_offset
    property NumWALBuffers:Long read GetNumWALBuffers; // isc_info_num_wal_buffers
    property WALBufferSize:Long read GetWALBufferSize; // isc_info_wal_buffer_size
    property WALCheckpointLength:Long read GetWALCheckpointLength; // isc_info_wal_ckpt_length
    property WALCurCheckpointInterval:Long read GetWALCurCheckpointInterval; // isc_info_wal_cur_ckpt_interval
    property WALPrvCheckpointFilename:string read GetWALPrvCheckpointFilename; // isc_info_wal_prv_ckpt_fname
    property WALPrvCheckpointPartOffset:Long read GetWALPrvCheckpointPartOffset; // isc_info_wal_prv_ckpt_poffset
    property WALGroupCommitWaitUSecs:Long read GetWALGroupCommitWaitUSecs; // isc_info_wal_grpc_wait_usecs
    property WALNumIO:Long read GetWALNumIO; // isc_info_wal_num_id
    property WALAverageIOSize:Long read GetWALAverageIOSize; // isc_info_wal_avg_io_size
    property WALNumCommits:Long read GetWALNumCommits; // isc_info_wal_num_commits
    property WALAverageGroupCommitSize:Long read GetWALAverageGroupCommitSize; // isc_info_wal_avg_grpc_size
//IB6
    property DBSQLDialect:Word read GetDBSQLDialect;
    property ReadOnly:Long read GetReadOnly;
    property DatabaseName:string read GetDatabaseName write SetDatabaseName;

    property DifferenceTime:double read FDifferenceTime;
//Firebird
    property ServerActiveTransactions:TStringList read GetActiveTransactions;
    property OldestTransactionID:Long read GetOldestTransaction;
    property OldestActiveTransactionID:Long read GetOldestActive;
    property Busy:boolean read GetBusy;
  public
    procedure StartTransaction;
    procedure Commit;
    procedure Rollback;
    procedure CommitRetaining;
    procedure RollbackRetaining;

    function Gen_Id(const GeneratorName:string; Step:Int64;aTransaction:TFIBTransaction =nil):Int64;
    function Execute(const SQL:string):boolean;

    procedure CreateGUIDDomain;
    function InternalQueryValue(const aSQL:string;FieldNo:integer;
     ParamValues:array of variant; aTransaction:TFIBTransaction; aCacheQuery:boolean
    ):Variant;
    function QueryValue(const aSQL:string;FieldNo:integer;aTransaction:TFIBTransaction=nil;
     aCacheQuery:boolean=True
    ):Variant; overload;
    function QueryValue(const aSQL:string;FieldNo:integer;
     ParamValues:array of variant;aTransaction:TFIBTransaction=nil;aCacheQuery:boolean=True
    ):Variant; overload;

    function QueryValues(const aSQL:string;aTransaction:TFIBTransaction=nil
    ;aCacheQuery:boolean=True
    ):Variant; overload;
    function QueryValues(const aSQL:string; ParamValues:array of variant;aTransaction:TFIBTransaction=nil;
     aCacheQuery:boolean=True):Variant; overload;

    function QueryValueAsStr(const aSQL:string;FieldNo:integer):string;overload;
    function QueryValueAsStr(const aSQL:string;FieldNo:integer;
        ParamValues:array of variant):string; overload;

    procedure ClearQueryCacheList;

    function EasyFormatsStr:boolean;
    property StoreConnected:boolean read GetStoreConnected;
    property ClientLibrary:IIbClientLibrary read GetClientLibrary implements IIbClientLibrary;
    property SQLStatisticsMaker:ISQLStatMaker read FSQLStatMaker write SetSQLStatMaker;

  published
    property Connected:Boolean read GetConnected write SetConnected stored GetStoreConnected;
    property BlobSwapSupport:TBlobSwapSupport read FBlobSwapSupport write SetBlobSwapSupport;
    property DBName:string read GetDatabaseName write SetDatabaseName;
    property DBParams:TDBParams read FDBParams write SetDBParams;
    property DefaultTransaction:TFIBTransaction read FDefaultTransaction
                                                 write SetDefaultTransaction;
    property DefaultUpdateTransaction:TFIBTransaction read FDefaultUpdateTransaction
                                                 write SetDefaultUpdateTransaction;

    //IB6
    property SQLDialect:Integer read FSQLDialect write SetSQLDialect;

    property Timeout:Cardinal read GetTimeout write SetTimeout;
    property UseLoginPrompt:Boolean read FUseLoginPrompt write FUseLoginPrompt default False;
    // Events

    property OnTimeout:TNotifyEvent read FOnTimeout write FOnTimeout;
    property UpperOldNames:boolean read FUpperOldNames write FUpperOldNames
     default False; // compatibility with IB4..5 field names conventions

    property BeforeDisconnect:TNotifyEvent read FBeforeDisconnect write FBeforeDisconnect;
    property AfterDisconnect:TNotifyEvent read FAfterDisconnect write FAfterDisconnect;
    property ConnectParams:TConnectParams read FConnectParams write FConnectParams stored False;
    property SynchronizeTime:boolean read FSynchronizeTime write FSynchronizeTime default True;

    property DesignDBOptions:TDesignDBOptions read FDesignDBOptions write SetDesignDBOptions default
     [ddoStoreConnected]
   ;
    property OnConnect:TNotifyEvent read FOnConnect write FOnConnect stored False; // obsolete
    property BeforeSaveBlobToSwap:TBeforeSaveBlobToSwap read FBeforeSaveBlobToSwap write FBeforeSaveBlobToSwap;
    property AfterSaveBlobToSwap:TAfterSaveLoadBlobSwap read FAfterSaveBlobToSwap write FAfterSaveBlobToSwap;
    property AfterLoadBlobFromSwap:TAfterSaveLoadBlobSwap read FAfterLoadBlobFromSwap write FAfterLoadBlobFromSwap;
    property BeforeLoadBlobFromSwap:TBeforeLoadBlobFromSwap read FBeforeLoadBlobFromSwap write FBeforeLoadBlobFromSwap;
    property OnIdleConnect:TOnIdleConnect read FOnIdleConnect write FOnIdleConnect;
    property UseRepositories:TFIBUseRepositories read FUseRepositories write FUseRepositories
     default [urFieldsInfo,urDataSetInfo,urErrorMessagesInfo];
    property LibraryName:string read FLibraryName write SetLibraryName stored StoredLibraryName;
    property SQLLogger:ISQLLogger read GetSQLLogger write SetSQLLogger;
    property UseBlrToTextFilter:boolean read FUseBlrToTextFilter write FUseBlrToTextFilter default False;
{$IFDEF CSMonitor}
    property CSMonitorSupport:TCSMonitorSupport read FCSMonitorSupport write SetCSMonitorSupport;
{$ENDIF}

  end;

  (* TFIBTransaction *)

  TTransactionAction =
   (TARollback, TARollbackRetaining,TACommit, TACommitRetaining);
  TTransactionState =
  (tsActive,tsClosed,tsDoRollback,tsDoRollbackRetaining,tsDoCommit, tsDoCommitRetaining);

  TTransactionRunState=(trsInLoaded);
  TTransactionRunStates=set of TTransactionRunState;

  TpFIBTrEventType =(tetBeforeStartTransaction,tetAfterStartTransaction,
   tetBeforeEndTransaction,tetAfterEndTransaction,tetBeforeDestroy);

  TEndTrEvent=procedure(EndingTR:TFIBTransaction;
   Action:TTransactionAction; Force:Boolean)of object;

  TFIBTransaction = class(TComponent)
  protected
    FCanTimeout:Boolean; // Can the transaction timeout now?
    FDatabases:TList; // TDatabases in transaction.
    FFIBBases:TList; // TFIBBases attached.
    FDefaultDatabase:TFIBDatabase; // just like DefaultTransaction in FIBDatabase
    FHandle:TISC_TR_HANDLE; // TR's handle
    FHandleIsShared:Boolean;
    FOnTimeout:TNotifyEvent; // When the transaction times out...
    FStreamedActive:Boolean;
    FTPB:PChar; // Parameters to TR as passed to IB.
    FTPBLength:Short; // Length of parameter buffer
    FTimer:TFIBTimer; // Timer for timing out transactions.
    FTimeoutAction:TTransactionAction; // Rollback or commit at end of timeout?
    FTRParams:TStrings; // Parameters to Transactions.
    FTRParamsChanged:Boolean;
    FState:TTransactionState;
    FTransactionID:integer;
    vOnDestroy:TNotifyEventList;
    vBeforeStartTransaction:TNotifyEventList;
    vAfterStartTransaction:TNotifyEventList;

    vBeforeEndTransaction:TCallBackList;
    vAfterEndTransaction:TCallBackList;
    vTRParams:array of string;
    vTPBArray:array of string;
    FTransactionRunStates:TTransactionRunStates;
{$IFDEF CSMonitor}
    FCSMonitorSupport:TCSMonitorSupport;
    procedure SetCSMonitorSupport(Value:TCSMonitorSupport);
{$ENDIF}
    function GetTransactionID:integer;
    function DoStoreActive:boolean;
    procedure EndTransaction(Action:TTransactionAction; Force:Boolean); virtual;
    // End the transaction using specified method...
    function GetDatabase(Index:Integer):TFIBDatabase; // Get the indexed database
    function GetDatabaseCount:Integer; // Get the number of databases in transaction
    function GetFIBBase(Index:Integer):TFIBBase; // Get the indexed Dataset.
    function GetFIBBasesCount:Integer; // Get the number of Datasets connected.
    function GetInTransaction:Boolean; // Is there an active trans?
    function GetTimeout:Cardinal;

    procedure Loaded; override;
    procedure SetActive(Value:Boolean);
    procedure SetDefaultDatabase(Value:TFIBDatabase);
    procedure SetHandle(Value:TISC_TR_HANDLE);
    procedure SetTimeout(Value:Cardinal); // Set the timeout
    procedure SetTRParams(Value:TStrings);
    procedure TimeoutTransaction(Sender:TObject);
    procedure TRParamsChange(Sender:TObject);
    procedure TRParamsChanging(Sender:TObject);
    procedure RemoveDatabases;
{$IFDEF USE_DEPRECATE_METHODS1}
    procedure RemoveDataSet(Idx:Integer); deprecated;
    procedure RemoveDataSets; deprecated;
    function AddDataSet(ds:TFIBBase):Integer; deprecated;
{$ENDIF}
    procedure RemoveFIBBase(Idx:Integer);
    procedure RemoveFIBBases;
    function AddFIBBase(ds:TFIBBase):Integer;

    procedure CreateTimeoutTimer;
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;

    function MainDatabase:TFIBDatabase;
    function FindDatabase(db:TFIBDatabase):Integer;
    procedure AddEvent(Event:TNotifyEvent;EventType:TpFIBTrEventType);
    procedure RemoveEvent(Event:TNotifyEvent;EventType:TpFIBTrEventType);

    procedure AddEndEvent(Event:TEndTrEvent;EventType:TpFIBTrEventType);
    procedure RemoveEndEvent(Event:TEndTrEvent;EventType:TpFIBTrEventType);

    procedure DoOnSQLExec(Query:TComponent;Kind:TKindOnOperation); virtual;

    function AddDatabase(db:TFIBDatabase):Integer; overload;
    function AddDatabase(db:TFIBDatabase; const aTRParams:string):Integer; overload;
    procedure RemoveDatabase(Idx:Integer);
    procedure ReplaceDatabase(dbOld,dbNew:TFIBDatabase);

    procedure OnDatabaseDisconnecting(DB:TFIBDatabase);

    function Call(ErrCode:ISC_STATUS; RaiseError:Boolean):ISC_STATUS;
    procedure CheckDatabasesInList; // Raise error if no databases in list.
    procedure CheckInTransaction; // Raise error if not in transaction
    procedure CheckNotInTransaction; // Raise error if in transaction
    procedure StartTransaction; virtual;
    procedure Commit; virtual;
    procedure CommitRetaining; virtual;
    procedure Rollback; virtual;
    procedure RollbackRetaining;virtual;
    procedure ExecSQLImmediate(const SQLText:string);
    procedure SetSavePoint(const SavePointName:string);
    procedure RollBackToSavePoint(const SavePointName:string);
    procedure ReleaseSavePoint(const SavePointName:string);
    procedure CloseAllQueryHandles;
// function IsReadCommitedTransaction:boolean;
    property DatabaseCount:Integer read GetDatabaseCount;
    property Databases[Index:Integer]:TFIBDatabase read GetDatabase;
{$IFDEF USE_DEPRECATE_METHODS1}
    property DataSetCount:Integer read GetFIBBasesCount; //deprecated;
    property DataSets[Index:Integer]:TFIBBase read GetFIBBase; //deprecated;