fibdatabase.pas

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

{***************************************************************}
{ 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-2007 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}
  Windows
 {$IFDEF DIRECT_USE_DB_LOGIN_FORM}
   ,FIBDBLoginDlg      //IS GUI
 {$ENDIF}

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

 {$IFDEF LINUX}
  Types,
  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;



  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;
    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;
    FCanTimeout         : Boolean;                      // Can the timer actually timeout the connection?
    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;
    FDatabaseRunState :TDatabaseRunState;
    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 SetCanTimeout(Value:boolean);
    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
  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;                              // 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; virtual;
    function  TestConnected: Boolean;
    function  GetServerTime:TDateTime;
  public
    function  ClientVersion:string;
    function  ClientMajorVersion:integer;
    function  ClientMinorVersion:integer;