fibdatabase.pas

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

{***************************************************************}
{ FIBPlus-component library for direct access to Firebird and }
{ InterBase databases }
{ }
{ FIBPlus is based in part on the product }
{ Free IB Components, written by Gregory H. Deatz for }
{ Hoagland, Longo, Moran, Dunst & Doukas Company. }
{ mailto:[e-mail] }
{ }
{ Copyright (c) 1998-2009 Devrace Ltd. }
{ Written by Serge Buzadzhy ([e-mail]) }
{ }
{-------------------------------------------------------------}
{ FIBPlus home page:http://www.fibplus.com/ }
{ FIBPlus support:http://www.devrace.com/support/ }
{-------------------------------------------------------------}
{ }
{ Please see the file License.txt for full license information }
{***************************************************************}

unit FIBDatabase;

interface
{$I FIBPlus.inc}
uses
 SysUtils, Classes,ibase, IB_Intf, IB_Externals,
 pFIBProps,IBBlobFilter, fib, pFIBEventLists,StdFuncs,
 pFIBInterfaces,
 {$IFDEF WINDOWS}
   {$IFDEF FIBPLUS_TRIAL}
    Dialogs,
   {$ENDIF}
  Windows
 {$IFDEF DIRECT_USE_DB_LOGIN_FORM}
   ,FIBDBLoginDlg //IS GUI
 {$ENDIF}

  {$IFDEF D6+}, Variants{$ENDIF};
 {$ENDIF}

 {$IFDEF LINUX}
  Types,
   {$IFDEF FIBPLUS_TRIAL}
    QDialogs, //IS GUI
   {$ENDIF}
  Variants;
 {$ENDIF}

type

  TFIBDatabase = class;
  TFIBTransaction = class;
  TFIBBase = class;
  TDesignDBOption=(ddoIsDefaultDatabase,ddoStoreConnected,ddoNotSavePassword);
  TDesignDBOptions = set of TDesignDBOption;

  TpFIBDBEventType =(detOnConnect,detBeforeDisconnect,detBeforeDestroy);
  TFIBUseRepository=(urFieldsInfo,urDataSetInfo,urErrorMessagesInfo);
  TFIBUseRepositories=set of TFIBUseRepository;
  TFBContextSpace=(csSystem,csSession,csTransaction);
  TDatabaseRunStateValues=(drsInCloseLostConnect,drsInRestoreLostConnect);
  TDatabaseRunState= set of TDatabaseRunStateValues;
  TBeforeSaveBlobToSwap=procedure(const TableName,FieldName:string;
   { const } RecordKeyValues:array of variant;Stream:TStream;var FileName:string; var CanSave:boolean) of object;

  TAfterSaveLoadBlobSwap=procedure(const TableName,FieldName:string;
   {const }RecordKeyValues:array of variant;const FileName:string) of object;

  TBeforeLoadBlobFromSwap=procedure(const TableName,FieldName:string;
 { const } RecordKeyValues:array of variant;var FileName:string; var CanLoad:boolean) of object;

  TActionOnIdle=(aiCloseConnect,aiKeepLiveConnect);
  TOnIdleConnect=procedure (Sender:TFIBDatabase; IdleTicks:Cardinal; var Action:TActionOnIdle) of object;

  TIBCharSets=set of byte;
  (* TFIBDatabase *)

  TFIBDatabase = class(TComponent,IIbClientLibrary)
  private
    FSQLLogger:ISQLLogger;
    FSQLStatMaker:ISQLStatMaker;
    FUseRepositories:TFIBUseRepositories;
    FLibraryName:string;
    FUseBlrToTextFilter:boolean;
    FClientLibLoaded:boolean;
    FBlobSwapSupport:TBlobSwapSupport;
    FBeforeSaveBlobToSwap:TBeforeSaveBlobToSwap;
    FAfterSaveBlobToSwap:TAfterSaveLoadBlobSwap;
    FAfterLoadBlobFromSwap:TAfterSaveLoadBlobSwap;
    FBeforeLoadBlobFromSwap:TBeforeLoadBlobFromSwap;
    FOnIdleConnect:TOnIdleConnect;
    procedure SetLibraryName(const LibName:string);
    function StoredLibraryName:boolean;
    function GetClientLibrary:IIbClientLibrary;
    procedure LoadLibrary;
    procedure SetBlobSwapSupport(const Value:TBlobSwapSupport);
    procedure SetSQLLogger(const Value:ISQLLogger);
    procedure SetSQLStatMaker(const Value:ISQLStatMaker);
    function GetSQLLogger:ISQLLogger;
    function GetBusy:boolean;
  protected
    FClientLibrary:IIBClientLibrary;
    FFIBBases:TList; // TFIBBases attached.
    FTransactions:TList; // TFIBTransactions attached.
    FDBName:string; // DB's name
    FDBParams:TDBParams; // "Pretty" Parameters to database
    FDBParamsChanged:Boolean; // Flag to determine if DPB must be regenerated
    FDPB:PChar; // Parameters to DB as passed to IB.
    FDPBLength:Short; // Length of parameter buffer
    FHandle:TISC_DB_HANDLE; // DB's handle
    FHandleIsShared:Boolean; // Is the handle shared with another DB?
    FUseLoginPrompt:Boolean; // Show a default login prompt?
    FOnConnect:TNotifyEvent; // Upon successful connection...
    FOnTimeout:TNotifyEvent; // Upon timing out...
    FDefaultTransaction:TFIBTransaction; // Many transaction components can be specified, but this is the primary, or default one to use.
    FDefaultUpdateTransaction:TFIBTransaction; //
    FStreamedConnected:Boolean; // Used for delaying the opening of the database.
    FTimer:TFIBTimer; // The timer ID.
    FUserNames:TStringList; // For use only with GetUserNames
    FActiveTransactions:TStringList; // For use only with GetActiveTransactions
    FBackoutCount:TStringList; // isc_info_backout_count
    FDeleteCount:TStringList; // isc_info_delete_count
    FExpungeCount:TStringList; // isc_info_expunge_count
    FInsertCount:TStringList; // isc_info_insert_count
    FPurgeCount:TStringList; // isc_info_purge_count
    FReadIdxCount:TStringList; // isc_info_read_idx_count
    FReadSeqCount:TStringList; // isc_info_read_seq_count
    FUpdateCount:TStringList; // isc_info_update_count
//IB6
    FSQLDialect:integer;
    FUpperOldNames:boolean; // compatibility with IB4..5 field names conventions
    FConnectParams:TConnectParams;
    FDesignDBOptions:TDesignDBOptions;
    FBeforeDisconnect:TNotifyEvent;
    FAfterDisconnect:TNotifyEvent;
    FDifferenceTime:double;
    FSynchronizeTime:boolean;
    vInternalTransaction:TFIBTransaction;

    vOnConnected:TNotifyEventList;
    vBeforeDisconnect:TNotifyEventList;
    vOnDestroy:TNotifyEventList;

    vAttachmentID:Long;
    FBlobFilters:TIBBlobFilters;
    FDBFileName:string;
    FConnectType:ShortInt;
    FNeedUnicodeFieldsTranslation:boolean;
    FIsUnicodeConnect:boolean;
    FIsKOI8Connect:boolean;
    FIsNoneConnect:boolean;
    FDatabaseRunState:TDatabaseRunState;
    FLastActiveTime:Cardinal;
    FStreammedConnectFail:boolean;
    procedure DBParamsChange(Sender:TObject);
    procedure DBParamsChanging(Sender:TObject);
    function GetConnected:Boolean; // Is DB connected?
    function GetDatabaseName:string;
    function GetFIBBase(Index:Integer):TFIBBase; // Get the indexed FIBBase.
    function GetFIBBasesCount:Integer; // Get the number of FIBBase connected.
    function GetDBParamByDPB(const Idx:Integer):string;
    function GetTimeout:Cardinal; // Get the timeout
    function GetTransaction(Index:Integer):TFIBTransaction;
    function GetFirstActiveTransaction:TFIBTransaction;
    function GetTransactionCount:Integer;
    function GetActiveTransactionCount:Integer;
    function Login:Boolean; // Show login prompt
    procedure SetConnected(Value:Boolean);
    procedure SetDatabaseName(const Value:string);
    procedure SetDBParamByDPB(const Idx:Integer; Value:string);
    procedure SetDBParamByName(const ParName,Value:string);
    procedure SetDBParams(Value:TDBParams);
    procedure SetDefaultTransaction(Value:TFIBTransaction);
    procedure SetDefaultUpdateTransaction(Value:TFIBTransaction);
    procedure CreateTimeoutTimer;
    procedure SetHandle(Value:TISC_DB_HANDLE);
    procedure SetTimeout(Value:Cardinal);
    procedure SetDesignDBOptions(Value:TDesignDBOptions);
    procedure TimeoutConnection(Sender:TObject);
    (* Database Info procedures--Advanced stuff (translated from isc_database_info) *)
    function GetAllocation:Long; // isc_info_allocation
    function GetBaseLevel:Long; // isc_info_base_level
    function GetDBFileName:string; // isc_info_db_id
    function GetDBSiteName:string; // isc_info_db_id
    function GetIsRemoteConnect:boolean; // isc_info_db_id

    function GetDBImplementationNo:Long; // isc_info_implementation
    function GetDBImplementationClass:Long;
    function GetNoReserve:Long; // isc_info_no_reserve
    function GetODSMinorVersion:Long; // isc_info_ods_minor_version
    function GetODSMajorVersion:Long; // isc_info_ods_version
    function GetPageSize:Long; // isc_info_page_size
    function GetVersion:string; // isc_info_info_version
    function GetCurrentMemory:Long; // isc_info_current_memory
    function GetForcedWrites:Long; // isc_info_forced_writes
    function GetMaxMemory:Long; // isc_info_max_memory
    function GetNumBuffers:Long; // isc_info_num_buffers
    function GetSweepInterval:Long; // isc_info_sweep_interval
    function GetUserNames:TStringList;// isc_info_user_names
    function GetFetches:Long;// isc_info_fetches
    function GetMarks:Long; // isc_info_marks
    function GetReads:Long; // isc_info_reads
    function GetWrites:Long; // isc_info_writes
    function GetBackoutCount:TStringList;// isc_info_backout_count
    function GetDeleteCount:TStringList; // isc_info_delete_count
    function GetExpungeCount:TStringList;// isc_info_expunge_count
    function GetInsertCount:TStringList; // isc_info_insert_count
    function GetPurgeCount:TStringList; // isc_info_purge_count
    function GetReadIdxCount:TStringList;// isc_info_read_idx_count
    function GetReadSeqCount:TStringList;// isc_info_read_seq_count
    function GetUpdateCount:TStringList; // isc_info_update_count

    function GetTableOperationInfo(const TableName:string; FromStrs:TStrings):integer;

    function GetIndexedReadCount(const TableName:string):integer;
    function GetNonIndexedReadCount(const TableName:string):integer;
    function GetInsertsCount(const TableName:string):integer;
    function GetUpdatesCount(const TableName:string):integer;
    function GetDeletesCount(const TableName:string):integer;

    function GetOperationCounts(DBInfoCommand:Integer; var FOperation:TStringList):TStringList;
    function GetAllModifications:integer;

    function GetLogFile:Long; // isc_info_log_file
    function GetCurLogFileName:string; // isc_info_cur_logfile_name
    function GetCurLogPartitionOffset:Long; // isc_info_cur_log_part_offset
    function GetNumWALBuffers:Long; // isc_info_num_wal_buffers
    function GetWALBufferSize:Long; // isc_info_wal_buffer_size
    function GetWALCheckpointLength:Long; // isc_info_wal_ckpt_length
    function GetWALCurCheckpointInterval:Long; // isc_info_wal_cur_ckpt_interval
    function GetWALPrvCheckpointFilename:string;// isc_info_wal_prv_ckpt_fname
    function GetWALPrvCheckpointPartOffset:Long;// isc_info_wal_prv_ckpt_poffset
    function GetWALGroupCommitWaitUSecs:Long; // isc_info_wal_grpc_wait_usecs
    function GetWALNumIO:Long; // isc_info_wal_num_id
    function GetWALAverageIOSize:Long; // isc_info_wal_avg_io_size
    function GetWALNumCommits:Long; // isc_info_wal_num_commits
    function GetWALAverageGroupCommitSize:Long; // isc_info_wal_avg_grpc_size

    function GetProtectLongDBInfo(DBInfoCommand:Integer;var Success:boolean):Long;
    function GetStringDBInfo(DBInfoCommand:Integer):string;
    function GetLongDBInfo(DBInfoCommand:Integer):Long;
    function GetAttachmentID:Long;

//Firebird Info
    function GetActiveTransactions:TStringList; // frb_info_active_transactions
    function GetOldestTransaction:Long; // frb_info_oldest_transaction
    function GetOldestActive:Long; // frb_info_oldest_active
    function GetOldestSnapshot:Long; // frb_info_oldest_snapshot
    function GetFBVersion:string; // frb_info_firebird_version
    function GetAttachCharset:integer; // frb_info_att_charset
  private
// Versions
    FServerMajorVersion:integer;
    FServerMinorVersion:integer;
    FServerRelease:integer;
    FServerBuild:integer;
    FNeedUTFDecodeDDL:boolean;
    procedure FillServerVersions;
    function GetServerMajorVersion:integer;
    function GetServerMinorVersion:integer;
    function GetServerRelease:integer;
    function GetServerBuild:integer;
  protected
    function GetInternalTransaction:TFIBTransaction; // friend for pFIBDataInfo
    property StreammedConnectFail:boolean read FStreammedConnectFail;
  protected
//IB6
    function GetDBSQLDialect:Word;
    procedure SetSQLDialect(const Value:Integer);

    function GetReadOnly:Long;
    function GetStoreConnected:boolean;
{$IFDEF CSMonitor}
  private
    FCSMonitorSupport:TCSMonitorSupport;
    procedure SetCSMonitorSupport(Value:TCSMonitorSupport);
{$ENDIF}
  protected
    FIsFireBirdConnect:boolean;
    FIsIB2007Connect:boolean;
    function GetIsFirebirdConnect:boolean;
    procedure Loaded; override;
    procedure Notification(AComponent:TComponent; Operation:TOperation);override;
    procedure InternalClose(Force:Boolean;DBinShutDown:boolean=False); virtual;
    procedure DoOnConnect;
    procedure DoBeforeDisconnect;
    procedure DoAfterDisconnect;

{$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 RemoveTransaction(Idx:Integer);
    procedure RemoveTransactions;
    function AddTransaction(TR:TFIBTransaction):Integer;
    procedure IBFilterBuffer(var BlobBuffer:PChar;var BlobSize:longint;
                        BlobSubType:integer;ForEncode:boolean);
  public
    procedure AddEvent(Event:TNotifyEvent;EventType:TpFIBDBEventType);
    procedure RemoveEvent(Event:TNotifyEvent;EventType:TpFIBDBEventType);

    procedure RegisterBlobFilter(BlobSubType:integer;
                                 EncodeProc,DecodeProc:PIBBlobFilterProc);
    procedure RemoveBlobFilter(BlobSubType:integer);
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    function Call(ErrCode:ISC_STATUS; RaiseError:Boolean):ISC_STATUS;

    procedure CheckActive(TryReconnect:boolean=False); // Raise error if DB is inactive
    procedure CheckInactive; // Raise error if DB is active
    procedure CheckDatabaseName; // Raise error if DBName is empty
    procedure Close;

    procedure CreateDatabase;
    property DBParamByDPB[const Idx:Integer]:string read GetDBParamByDPB
                                                      write SetDBParamByDPB;
    procedure DropDatabase;
    function FindTransaction(TR:TFIBTransaction):Integer;
    procedure ForceClose;
    function IndexOfDBConst(const st:string):Integer; // Get the index of a given constant in DBParams
    procedure Open(RaiseExcept:boolean = True); virtual;