fibdatabase.pas

FIBPlus is a component suite intended for work with InterBase. It is direct, fast and flexible Inter

    function  IsFirebirdConnect :boolean;
    function  NeedUnicodeFieldsTranslation  :boolean;
    function  IsUnicodeConnect  :boolean;
    function  IsIB2007Connect   :boolean;
    function  NeedUTFEncodeDDL  :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;
    (* Properties*)

    property CanTimeout    : Boolean read FCanTimeout write SetCanTimeout;
{$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 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);

  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;
{$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;
{$ENDIF}
    property FIBBaseCount: Integer read GetFIBBasesCount;
    property FIBBases[Index: Integer]: TFIBBase  read GetFIBBase;

    property Handle: TISC_TR_HANDLE read FHandle write SetHandle;
    property HandleIsShared: Boolean read FHandleIsShared;
    property InTransaction: Boolean read GetInTransaction;
//    property TPB: PChar read FTPB;