{***************************************************************}
{ 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:gdeatz@hlmdd.com                                    }
{                                                               }
{    Copyright (c) 1998-2004 Serge Buzadzhy                     }
{    Contact: buzz@devrace.com                                  }
{                                                               }
{ ------------------------------------------------------------- }
{    FIBPlus home page      : http://www.fibplus.net/           }
{    FIBPlus support e-mail : fibplus@devrace.com               }
{ ------------------------------------------------------------- }
{                                                               }
{  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;

 
 
  (* 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;
  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;
    procedure FillServerVersions;
    function GetServerMajorVersion: integer;
    function GetServerMinorVersion: integer;
    function GetServerRelease: integer;
    function GetServerBuild: integer;
  protected
//IB6
    function  GetDBSQLDialect:Word;
    procedure SetSQLDialect(const Value: Integer);


    function  GetReadOnly: Long;
    function  GetStoreConnected:boolean;

  protected
    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;
    function  IsFirebirdConnect :boolean;
    function  NeedUnicodeFieldsTranslation  :boolean;
    function  IsUnicodeConnect  :boolean;
    function  IsIB2007Connect   :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
    );

    (* 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;
 
  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
    ):Variant;
    function QueryValue(const aSQL: string;FieldNo:integer;aTransaction:TFIBTransaction=nil):Variant; overload;
    function QueryValue(const aSQL: string;FieldNo:integer;
     ParamValues:array of variant;aTransaction:TFIBTransaction=nil
    ):Variant; overload;
 
    function QueryValues(const aSQL: string;aTransaction:TFIBTransaction=nil):Variant; overload;
    function QueryValues(const aSQL: string; ParamValues:array of variant;aTransaction:TFIBTransaction=nil ):Variant; overload;
 

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

    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;
  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;
 

    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;
    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;
    property TPBLength: Short read FTPBLength;
    property State: TTransactionState read FState;
    property TransactionID: integer read GetTransactionID;
  published
    property Active: Boolean read GetInTransaction write SetActive stored DoStoreActive;
    property DefaultDatabase: TFIBDatabase read FDefaultDatabase
                                           write SetDefaultDatabase;
    property Timeout: Cardinal read GetTimeout write SetTimeout default 0;
    property TimeoutAction: TTransactionAction read FTimeoutAction write FTimeoutAction;
    property TRParams: TStrings read FTRParams write SetTRParams;
    // Events
    property OnTimeout: TNotifyEvent read FOnTimeout write FOnTimeout;
  end;
 
  (* TFIBBase *)
  (* Virtually all components in FIB are "descendents" of TFIBBase. *)
  (* It is to more easily manage the database and transaction *)
  (* connections. *)
  TFIBBase = class(TObject)
  protected
    FDatabase: TFIBDatabase;
    FIndexInDatabase: Integer;
    FTransaction: TFIBTransaction;
    FIndexInTransaction: Integer;
    FOwner: TObject;
    procedure FOnDatabaseConnecting; 
    procedure FOnDatabaseConnected; 

    procedure FOnDatabaseDisconnecting; 
    procedure FOnDatabaseDisconnected; 

    procedure FOnTransactionStarting;
    procedure FOnTransactionStarted;

    procedure FOnDatabaseFree; 
    procedure FOnTransactionEnding;
    procedure FOnTransactionEnded;
    procedure FOnTransactionFree;
    function GetDBHandle: PISC_DB_HANDLE; 
    function GetTRHandle: PISC_TR_HANDLE; 
    procedure SetDatabase(Value: TFIBDatabase);
    procedure SetTransaction(Value: TFIBTransaction); 
  public
    constructor Create(AOwner: TObject);
    destructor Destroy; override;
    procedure CheckDatabase; virtual;
    procedure CheckTransaction; virtual;
  public // properties
    OnDatabaseConnecting: TNotifyEvent;
    OnDatabaseConnected: TNotifyEvent;

    OnDatabaseDisconnecting: TNotifyEvent;
    OnDatabaseDisconnected: TNotifyEvent;
    OnDatabaseFree: TNotifyEvent;
    OnTransactionEnding: TNotifyEvent;
    OnTransactionEnded: TNotifyEvent;
    OnTransactionStarting: TNotifyEvent;
    OnTransactionStarted: TNotifyEvent;
 
    OnTransactionFree: TNotifyEvent;
    property Database: TFIBDatabase read FDatabase
                                    write SetDatabase;
    property DBHandle: PISC_DB_HANDLE read GetDBHandle;
    property Owner: TObject read FOwner;
    property TRHandle: PISC_TR_HANDLE read GetTRHandle;
    property Transaction: TFIBTransaction read FTransaction
                                          write SetTransaction;
  end;
 

procedure SaveSchemaToFile(const FileName:string);
function  LoadSchemaFromFile(const FileName:string; const NeedValidate:boolean=True;
 DB:TFIBDatabase=nil
):boolean;
 
 
procedure IBFilterBuffer(DataBase:TFIBDataBase;
   var BlobBuffer:PChar;var BlobSize:longint; BlobSubType:integer;ForEncode: boolean
);

function ExistBlobFilter(DataBase:TFIBDataBase;BlobSubType:integer):boolean;
 
function  GetConnectedDataBase(const DBName:string ):TFIBDatabase;
procedure CloseAllDatabases;
 

procedure AssignSQLObjectParams(Dest: ISQLObject; ParamSources : array of ISQLObject);
 
var DefDataBase        :TFIBDatabase;
    AppHandleException :TNotifyEvent;
    DatabaseList       :TThreadList;
    FIBHideGrantError  :boolean = False;

 
implementation

uses
{$IFNDEF NO_MONITOR}
  FIBSQLMonitor,
{$ENDIF}
  FIBMiscellaneous,pFIBDataInfo,FIBQuery, StrUtil,pFIBCacheQueries, FIBConsts;
 

procedure AssignSQLObjectParams(Dest: ISQLObject; ParamSources : array of ISQLObject);
var 
  i: Integer;
  j: Integer;
  k: Integer;
  c: Integer;
  pName:string;
  OldValue:boolean;
begin
  if Dest=nil then
   Exit;    
  c:=Pred(Dest.ParamCount);
  for i := 0 to c do
  begin
   pName:=Dest.ParamName(i);
    OldValue:=False;
   if IsNewParamName(pName) then
    pName:=FastCopy(pName,5,MaxInt)
   else
   if IsOldParamName(pName) then
   begin
    pName:=FastCopy(pName,5,MaxInt);
    OldValue:=True;
   end;
   for j := Low(ParamSources) to High(ParamSources) do
    if Assigned(ParamSources[j]) then
     if ParamSources[j].FieldExist(pName,k) then
     begin
      Dest.SetParamValue(i,ParamSources[j].FieldValue(k,OldValue))
     end
     else
     if ParamSources[j].ParamExist(Dest.ParamName(i),k) then
     begin
      Dest.SetParamValue(i,ParamSources[j].ParamValue(k))
     end;
  end;
end;

 

function  GetConnectedDataBase(const DBName:string ):TFIBDatabase;
var i:integer;
begin
 Result:=nil;
 with DatabaseList.LockList do
 try
  for I := 0 to Count - 1 do
   if (TFIBDatabase(Items[i]).DBName=DBName)and (TFIBDatabase(Items[i]).Connected)
   then
   begin
     Result:=TFIBDatabase(Items[i]);
     Break;
   end;
  finally
   DatabaseList.UnLockList
  end;
end;

procedure CloseAllDatabases;
var i:integer;
begin
 with DatabaseList.LockList do
 try
   for i:=0 to Count-1 do
   begin
    if TFIBDatabase(Items[i]).Connected then
     TFIBDatabase(Items[i]).ForceClose
   end;
  finally
   DatabaseList.UnLockList
  end;
end;
 

procedure IBFilterBuffer(DataBase:TFIBDataBase;
                        var BlobBuffer:PChar;var BlobSize:longint;
                        BlobSubType:integer;ForEncode: boolean);
begin
  if DataBase.FBlobFilters=nil then
   Exit;
  DataBase.FBlobFilters.IBFilterBuffer(BlobBuffer,BlobSize,BlobSubType,ForEncode);
end;
 
function ExistBlobFilter(DataBase:TFIBDataBase;BlobSubType:integer):boolean;
var
 anIndex: integer;
begin
  if Assigned(DataBase.FBlobFilters) then
   Result:=DataBase.FBlobFilters.Find(BlobSubType,anIndex)
  else
   Result:=False
end;

procedure SaveSchemaToFile(const FileName:string);
begin
  ListTableInfo.SaveToFile(FileName);
  ListDataSetInfo.SaveToFile(ChangeFileExt(FileName,'.dt'));
  ListErrorMessages.SaveToFile(ChangeFileExt(FileName,'.err'));
end;

function LoadSchemaFromFile(const FileName:string; const NeedValidate:boolean=True;
 DB:TFIBDatabase=nil
):boolean;
begin
  Result:=ListTableInfo.LoadFromFile(FileName,DB);
  ListTableInfo.NeedValidate:=NeedValidate;
  ListDataSetInfo.LoadFromFile(ChangeFileExt(FileName,'.dt'));
  ListDataSetInfo.NeedValidate:=NeedValidate;
  ListErrorMessages.LoadFromFile(ChangeFileExt(FileName,'.err'));
end;
 
(* TFIBDatabase *)
 
constructor TFIBDatabase.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FLibraryName  := IBASE_DLL;
  FClientLibrary:= nil;
  FFIBBases                            := TList.Create;
  FTransactions                        := TList.Create;
  FDBName                              := '';
  FDBParams                            := TDBParams.Create(Self);
  FDBParamsChanged                     := True;
  TStringList(FDBParams).OnChange      := DBParamsChange;
  TStringList(FDBParams).OnChanging    := DBParamsChanging;
  FDPB                                 := nil;
  FHandle                              := nil;
  FUserNames                           := nil;
  FBackoutCount                        := nil;
  FDeleteCount                         := nil;
  FExpungeCount                        := nil;
  FInsertCount                         := nil;
  FPurgeCount                          := nil;
  FReadIdxCount                        := nil;
  FReadSeqCount                        := nil;
  FUpdateCount                         := nil;
  FTimer                               := nil;

 
 
  FConnectParams  := TConnectParams.Create(Self);
  FDifferenceTime := 0;

  if (csDesigning in ComponentState)   and   not CmpInLoadedState(Self)
  then
  begin
   FSynchronizeTime      :=DefSynchronizeTime;
   FUpperOldNames        :=DefUpperOldNames  ;
   FUseLoginPrompt       :=DefUseLoginPrompt ;
   FConnectParams.CharSet:=DefCharSet;
   FSQLDialect           :=DefSQLDialect;
   if DefStoreConnected then
    FDesignDBOptions     := [ddoStoreConnected]
   else
    FDesignDBOptions     := []
  end
  else
  begin
   FSynchronizeTime      :=True ;
   FUpperOldNames        :=False;
   FUseLoginPrompt       :=False;
   FSQLDialect           :=1;
   FDesignDBOptions      := [ddoStoreConnected]
  end;


  vInternalTransaction:=TFIBTransaction.Create(Self);
  vInternalTransaction.DefaultDataBase:=Self;
 
  with vInternalTransaction.TRParams do
  begin
   Text:='write'+#13#10+
         'isc_tpb_nowait'+#13#10+
         'rec_version'+#13#10+
         'read_committed'+#13#10;
  end;
  DatabaseList.Add(Self);
  vOnConnected     :=TNotifyEventList.Create(Self);
  vBeforeDisconnect:=TNotifyEventList.Create(Self);
  vOnDestroy       :=TNotifyEventList.Create(Self);
 
  vAttachmentID    :=-1;
  FActiveTransactions:=nil;
  FBlobFilters     :=TIBBlobFilters.Create;
  FUseRepositories :=[urFieldsInfo,urDataSetInfo,urErrorMessagesInfo] ;
  FDBFileName      :='';
  FConnectType     :=0;
  FBlobSwapSupport:=TBlobSwapSupport.Create;
end;
 
destructor TFIBDatabase.Destroy;
var
  i: Integer;
begin
  if Assigned(DatabaseList) then
   DatabaseList.Remove(Self);
  if Assigned(vInternalTransaction) then
  with vInternalTransaction do
  begin
    if Active then Commit;
    Free; vInternalTransaction:=nil;
  end;
  if DefDataBase=Self then
    DefDataBase:=nil;
 

   Timeout := 0;
   if FHandle <> nil then ForceClose;
   for i := Pred(vOnDestroy.Count) downto 0 do
    vOnDestroy.Event[i](Self);
 
   // Tell Dataset's we're being freed.
   for i := FFIBBases.Count - 1 downto 0 do if FFIBBases[i] <> nil then
    FIBBases[i].FOnDatabaseFree;
   // Make sure that all DataSets are removed from the list.
   RemoveFIBBases;
   // Make sure all transactions are removed from the list.
   // As they are removed, they will remove the db's entry in each
   // respective transaction.
   RemoveTransactions;
   FIBAlloc(FDPB, 0, 0);
   FDBParams.Free;
   FFIBBases.Free;
   FUserNames.Free;
   FTransactions.Free;
   FBackoutCount.Free;
   FDeleteCount.Free;
   FExpungeCount.Free;
   FInsertCount.Free;
   FPurgeCount.Free;
   FReadIdxCount.Free;
   FReadSeqCount.Free;
   FUpdateCount.Free;
   FConnectParams.Free;

   FBlobFilters     .Free;
   FClientLibrary:=nil;
   FBlobSwapSupport.Free;
   inherited Destroy;
end;

procedure TFIBDatabase.SetLibraryName(const LibName:string);
begin
  {$IFNDEF FIBPLUS_TRIAL}
  CheckInactive;
  if FLibraryName<>LibName then
  begin
    FLibraryName  :=LibName;
    FClientLibrary:=nil;
    FClientLibLoaded := False;    
  end;
  {$ELSE}
   ShowMessage('Trial version can''t change library name');
  {$ENDIF}
end;
 
function  TFIBDatabase.StoredLibraryName:boolean;
begin
  Result:=FLibraryName<>IBASE_DLL
end;
 
function TFIBDatabase.GetClientLibrary:IIbClientLibrary;
begin
  LoadLibrary;
  Result:=FClientLibrary
end;

procedure TFIBDatabase.SetDesignDBOptions(Value:TDesignDBOptions);
begin
 FDesignDBOptions:=Value;
 if ddoIsDefaultDatabase in FDesignDBOptions then
 begin
   if (DefDataBase<>nil) and (DefDataBase<>Self) then
   with DefDataBase do
    FDesignDBOptions:=FDesignDBOptions-[ddoIsDefaultDatabase];
   if not (csLoading in ComponentState) then
    DefDataBase:=Self
 end
 else
 if DefDataBase=Self then DefDataBase:=nil
end;

function  TFIBDatabase.GetStoreConnected:boolean;
begin
  Result:=Connected and
   (ddoStoreConnected in FDesignDBOptions)
end;

function TFIBDatabase.Call(ErrCode: ISC_STATUS;
  RaiseError: Boolean): ISC_STATUS;
begin
  Set8087CW(Default8087CW);
  Result := ErrCode;
  FCanTimeout := False;
  if RaiseError and (ErrCode > 0) then
    IBError(Self,Self);
end;
 
procedure TFIBDatabase.CheckActive;
var OldUseLoginPrompt:boolean;
begin
  if FStreamedConnected and (not Connected) then
    Loaded;
  if FHandle = nil then
   if not (csDesigning in ComponentState) then
   begin
     FIBError(feDatabaseClosed, [CmpFullName(Self)])
   end
   else
     if not Connected then
     begin
      OldUseLoginPrompt:=FUseLoginPrompt;
      FUseLoginPrompt  :=(ConnectParams.Password='');
      try
       Connected:=true;
      except
       if not FUseLoginPrompt then
       try
        FUseLoginPrompt  :=true;
        Connected:=True;
       except
       end;
      end;
      FUseLoginPrompt:=OldUseLoginPrompt;
    end;
end;
 
procedure TFIBDatabase.CheckInactive;
begin
  if FHandle <> nil then
    FIBError(feDatabaseOpen, [nil]);
end;
 
procedure TFIBDatabase.CheckDatabaseName;
begin
  if (FDBName = '') then
    FIBError(feDatabaseNameMissing, [nil]);
end;

{$IFDEF USE_DEPRECATE_METHODS1}
{$WARNINGS OFF}
function TFIBDatabase.AddDataSet(ds: TFIBBase): Integer;
begin
  Result:=AddFIBBase(ds);
end;
{$WARNINGS ON}
{$ENDIF}
 
function  TFIBDatabase.AddFIBBase(ds: TFIBBase): Integer;
begin
 Result := FFIBBases.Count;
 FFIBBases.Add(ds)
end;
 
 

procedure TFIBDatabase.RegisterBlobFilter(BlobSubType:integer;
                                 EncodeProc,DecodeProc:PIBBlobFilterProc);
begin
 FBlobFilters.
  RegisterBlobFilter(BlobSubType,EncodeProc,DecodeProc);
end;

procedure TFIBDatabase.RemoveBlobFilter(BlobSubType:integer);
begin
 FBlobFilters.RemoveBlobFilter(BlobSubType)
end;

 
procedure TFIBDatabase.IBFilterBuffer(var BlobBuffer:PChar;var BlobSize:longint;
                        BlobSubType:integer;ForEncode: boolean);
begin
 FBlobFilters.
  IBFilterBuffer(BlobBuffer,BlobSize,BlobSubType,ForEncode);
end;

procedure TFIBDatabase.RemoveEvent(Event:TNotifyEvent;EventType:TpFIBDBEventType);
begin
 case EventType of
  detOnConnect       :  vOnConnected.Remove(Event);
  detBeforeDisconnect:  vBeforeDisconnect.Remove(Event);
  detBeforeDestroy   :  vOnDestroy.Remove(Event);
 end;
end;

procedure  TFIBDatabase.AddEvent(Event:TNotifyEvent;EventType:TpFIBDBEventType);
begin
 case EventType of
  detOnConnect       :  vOnConnected.Add(Event);
  detBeforeDisconnect:  vBeforeDisconnect.Add(Event);
  detBeforeDestroy   :  vOnDestroy.Add(Event);
 end
end;

procedure TFIBDatabase.DoBeforeDisconnect;
var i:integer;
begin
  try
   if Assigned(FBeforeDisconnect) then FBeforeDisconnect(Self);
  except
   on E:Exception do
   if csDestroying in ComponentState then
    raise Exception.Create(
      Format(SFIBErrorBeforeDisconnectDetail, [CmpFullName(Self), E.Message])
    )
   else
    raise Exception.Create(
      Format(SFIBErrorBeforeDisconnect, [CmpFullName(Self), E.Message])
    )
  end;

  with vBeforeDisconnect do
  for i:=0 to Pred(Count) do
  begin
    vBeforeDisconnect.Event[i](Self)
  end;
end;
 
procedure TFIBDatabase.DoAfterDisconnect;
begin
  try
   if Assigned(FAfterDisconnect) then FAfterDisconnect(Self);
  except
   on E:Exception do
   if csDestroying in ComponentState then
    raise Exception.Create(
      Format(SFIBErrorAfterDisconnectDetail, [CmpFullName(Self), E.Message])
    )
   else
    raise Exception.Create(
      Format(SFIBErrorAfterDisconnect, [CmpFullName(Self), E.Message])
    )
  end;
end;
 
procedure TFIBDatabase.DoOnConnect;
var
 i: integer;
begin
  LoadLibrary;
  if not IsFirebirdConnect or (ServerMajorVersion<2) then
  begin
    FIsUnicodeConnect:=(FConnectParams.CharSet='UNICODE_FSS')
    or  (FConnectParams.CharSet='UTF8');
    FNeedUnicodeFieldsTranslation:=FIsUnicodeConnect or
     (FConnectParams.CharSet='NONE') or
     (FConnectParams.CharSet='');
{$IFDEF SUPPORT_KOI8_CHARSET}
    FIsKOI8Connect:=False;
{$ENDIF}
  end
  else
  begin
    FIsUnicodeConnect:=FBAttachCharsetID in [chUnicodeFSS,chUTF8];
    FNeedUnicodeFieldsTranslation:=FIsUnicodeConnect
     or     (FBAttachCharsetID=0);
     ;
{$IFDEF SUPPORT_KOI8_CHARSET}
    FIsKOI8Connect:=FBAttachCharsetID in [chFBKOI8R,chFBKOI8U]
{$ENDIF}
 
  end;

  if not (csDesigning in ComponentState) then
   if FBlobSwapSupport.Active and (Length(FBlobSwapSupport.SwapDirectory)>0) then
    ValidateBlobCacheDirectory(Self);
  if Assigned(FOnConnect) then FOnConnect(Self);
  with vOnConnected do
  for i:=0 to Pred(Count) do
  begin
    vOnConnected.Event[i](Self)
  end;
end;
 
function TFIBDatabase.AddTransaction(TR: TFIBTransaction): Integer;
begin
  Result := 0;
  while (Result < FTransactions.Count) and (FTransactions[Result] <> nil)
     and (FTransactions[Result] <> TR) //    AddedSource
  do
    Inc(Result);
  if (Result = FTransactions.Count) then
    FTransactions.Add(TR)
  else
    FTransactions[Result] := TR;
end;

procedure TFIBDatabase.Close;
begin
 if Connected then
  InternalClose(False);
  vAttachmentID:=-1;
end;

procedure TFIBDatabase.CreateDatabase;
var 
  tr_handle: TISC_TR_HANDLE;
begin
  // Create database interprets the DBParams string list
  // as mere text. It makes it extremely simple to do this way.
  CheckInactive; // Make sure the database ain't connected.
  LoadLibrary;
  tr_handle := nil;
  Call(
    FClientLibrary.isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0,
     PChar('CREATE DATABASE ''' + FDBName + ''' ' +DBParams.Text
    ), SQLDialect, nil),
    True
  );
end;

procedure TFIBDatabase.DropDatabase;
begin
  CheckActive;
  LoadLibrary;
  Call(FClientLibrary.isc_drop_database(StatusVector, @FHandle), True);
  FHandle:=nil
end;

// Set up the FDPBBuffer correctly.
procedure TFIBDatabase.DBParamsChange(Sender: TObject);
begin
  FDBParamsChanged := True;
end;

procedure TFIBDatabase.DBParamsChanging(Sender: TObject);
begin
  if not (csDesigning in ComponentState) then
   CheckInactive;
end;
 
function TFIBDatabase.FindTransaction(TR: TFIBTransaction): Integer;
begin
  Result := FTransactions.IndexOf(TR);
end;

procedure TFIBDatabase.ForceClose;
begin
  InternalClose(True);
end;
 
function TFIBDatabase.GetConnected: Boolean;
begin
  Result := FHandle <> nil;
end;
 
function TFIBDatabase.GetDatabaseName: string;
begin
  Result := FDBName;
end;
 
function TFIBDatabase.GetFIBBase(Index: Integer): TFIBBase;
begin
  Result := FFIBBases[Index];
end;

function TFIBDatabase.GetFIBBasesCount: Integer;
begin
  Result := FFIBBases.Count;
end;
 
function TFIBDatabase.GetDBParamByDPB(const Idx: Integer): string;
var
  ConstIdx, EqualsIdx: Integer;
begin
  if (Idx > 0) and (Idx <= isc_dpb_last_dpb_constant) then
  begin
    ConstIdx := IndexOfDBConst(DPBConstantNames[Idx]);
    if ConstIdx = -1 then
      Result := ''
    else
    begin
      Result := DBParams[ConstIdx];
      EqualsIdx := PosCh('=', Result);
      if EqualsIdx = 0 then
        Result := ''
      else
        Result := FastCopy(Result, EqualsIdx + 1, Length(Result));
    end;
  end
  else
    Result := '';
end;

function TFIBDatabase.GetTimeout: Cardinal;
begin
   if Assigned(FTimer) then
    Result := FTimer.Interval
   else
    Result := 0;  
end;
 
function TFIBDatabase.GetTransaction(Index: Integer): TFIBTransaction;
begin
  Result := FTransactions[Index];
end;
 

function TFIBDatabase.GetTransactionCount: Integer;
begin
  Result := FTransactions.Count;
end;
 
function TFIBDatabase.GetActiveTransactionCount: Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 0 to Pred(FTransactions.Count) do
   if (FTransactions[i] <> nil) and
    TFIBTransaction(FTransactions[i]).InTransaction then
    Inc(Result);
end;
 
function TFIBDatabase.GetFirstActiveTransaction: TFIBTransaction;
var
  i: Integer;
begin
  Result := nil;
  for i := 0 to Pred(FTransactions.Count) do
   if (FTransactions[i] <> nil) and TFIBTransaction(FTransactions[i]).InTransaction
   then
   begin
     Result:=TFIBTransaction(FTransactions[i]);
     Exit;
   end;
end;


function TFIBDatabase.IndexOfDBConst(const st: string): Integer;
var
  i, pos_of_str: Integer;
begin
  Result := -1;
  for i := 0 to DBParams.Count - 1 do
  begin
    pos_of_str := PosCI(st, DBParams[i]);
    if (pos_of_str = 1) or (pos_of_str = Length(DPBPrefix) + 1) then
    begin
      Result := i;
      break;
    end;
  end;
end;

(*
 * InternalClose -
 *  Close the database connection and all other
 *  attached components that the database
 *  connection is terminating.
 *)
procedure TFIBDatabase.InternalClose(Force: Boolean;DBinShutDown:boolean);
var 
  i: Integer;
begin
  (*
   * Check that the database connection is active.
   *)
  CheckActive;
  DoBeforeDisconnect;
  (*
   * Tell all connected transactions that we're disconnecting.
   * This is so transactions can commit/rollback, accordingly
   *)
  for i := 0 to FTransactions.Count - 1 do
  try
    if FTransactions[i] <> nil then
      Transactions[i].OnDatabaseDisconnecting(Self);
  except
    if not Force then
     raise;
  end;
 
  (*
   * Tell all attached components (TFIBBase's) that we're
   * disconnecting
   *)
  for i := 0 to FFIBBases.Count - 1 do
  try
    if FFIBBases[i] <> nil then
     FIBBases[i].FOnDatabaseDisconnecting;
  except
    if not Force then
     raise;
  end;
 
  (*
   * Disconnect..., and if the force parameter is true, guarantee that
   * the handle is reset to nil.
   *)
 
    try
      if (not HandleIsShared) and
         (Call(FClientLibrary.isc_detach_database(StatusVector, @FHandle), True) > 0) and
         (not Force)
      then
        IbError(Self,Self)
      else
      begin
        FHandle := nil;
        FHandleIsShared := False;
      end;
    except
        FHandle := nil;
        FHandleIsShared := False;
    end;
{$IFNDEF NO_MONITOR}
  if MonitoringEnabled  then
   if MonitorHook<>nil then
    MonitorHook.DBDisconnect(Self);
{$ENDIF}
  (*
   * Tell all attached components (TFIBBase's) that we have
   * disconnected.
   *)
  for i := 0 to FFIBBases.Count - 1 do
  if FFIBBases[i] <> nil then
    FIBBases[i].FOnDatabaseDisconnected;
  DoAfterDisconnect;
 if Assigned(FSQLLogger) then
  FSQLLogger.WriteData(CmpFullName(Self),'Disconnect','',lfConnect);
 
end;

 
procedure TFIBDatabase.Loaded;
begin
  inherited Loaded;
  if ddoIsDefaultDatabase in FDesignDBOptions then
    DefDataBase:=Self;
  try
    if FStreamedConnected and (not Connected) then
    begin
      Open;
      if Connected then
       if (FDefaultTransaction <> nil) and
         (FDefaultTransaction.FStreamedActive) and
         (not FDefaultTransaction.InTransaction) then
        FDefaultTransaction.StartTransaction;
      FStreamedConnected := False;
    end;
  except
    if (csDesigning in ComponentState) and Assigned(AppHandleException) then
      AppHandleException(Self)
    else
      raise;
  end;
end;

function TFIBDatabase.Login: Boolean;
var 
  IndexOfUser, IndexOfPassword,IndexOfRole: Integer;
  Username, Password,RoleName: string;
begin
  if not Assigned(pFIBLoginDialog) then
  begin
   if not Assigned(pFIBLoginDialog) then
    if csDesigning in ComponentState then
     raise Exception.Create(SFIBErrorNoDBLoginDialog + SFIBErrorInstallPropertyEditorPackage)
    else
     raise Exception.Create(SFIBErrorNoDBLoginDialog + SFIBErrorIncludeDBLoginDialog);
  end;
  IndexOfUser := IndexOfDBConst(DPBConstantNames[isc_dpb_user_name]);
  if IndexOfUser <> -1 then
    Username := FastCopy(DBParams[IndexOfUser],
                                       PosCh('=', DBParams[IndexOfUser]) + 1,
                                       Length(DBParams[IndexOfUser]));
  IndexOfPassword := IndexOfDBConst(DPBConstantNames[isc_dpb_password]);
  if IndexOfPassword <> -1 then
    Password := FastCopy(DBParams[IndexOfPassword],
                                       PosCh('=', DBParams[IndexOfPassword]) + 1,
                                       Length(DBParams[IndexOfPassword]));
  IndexOfRole:= IndexOfDBConst(DPBConstantNames[isc_dpb_sql_role_name]);
  if IndexOfRole<>-1 then
    RoleName := FastCopy(DBParams[IndexOfRole],
                                       PosCh('=', DBParams[IndexOfRole]) + 1,
                                       Length(DBParams[IndexOfRole]));

 
  Result := pFIBLoginDialog(DBName, Username, Password,RoleName);
  if Result then
  begin
    if IndexOfUser = -1 then
      DBParams.Add(DPBConstantNames[isc_dpb_user_name] + '=' + Username)
    else
      DBParams[IndexOfUser] := DPBConstantNames[isc_dpb_user_name] +
                               '=' + Username;
    if IndexOfPassword = -1 then
      DBParams.Add(DPBConstantNames[isc_dpb_password] + '=' + Password)
    else
      DBParams[IndexOfPassword] := DPBConstantNames[isc_dpb_password] +
                                   '=' + Password;
    if IndexOfRole=-1 then
      DBParams.Add(DPBConstantNames[isc_dpb_sql_role_name] + '=' + RoleName)
    else
      DBParams[IndexOfRole] := DPBConstantNames[isc_dpb_sql_role_name] +
                                   '=' + RoleName;
  end;
end;
 
(*
 * Open -
 *  Open a database connection.
 *)
procedure TFIBDatabase.Open;
var
  DPB:  string;
  isc_res:ISC_STATUS;
  i: Integer;
  SV: PISC_STATUS;
begin
  (*
   * Check that the database is *not* active, and that it
   * has a database name
   *)
  FServerMajorVersion:=-1;
  FServerMinorVersion:=-1;
  FServerBuild       :=-1;

  CheckInactive;
  CheckDatabaseName;
  LoadLibrary;
  {$IFDEF LINUX}
   {$IFDEF FIBPLUS_TRIAL}
    if not (csDesigning in ComponentState) then
     ShowMessage( 'Thank you very much for evaluating FIBPlus.'#10#13#10#13 +
                  'Please go to http://www.devrace.com and register today.'
                );
   {$ENDIF}
  {$ENDIF}
  (*
   * Use the canned login prompt if requested.
   *)
  for i := 0 to FFIBBases.Count - 1 do
  begin
     if FFIBBases[i] <> nil then
       FIBBases[i].FOnDatabaseConnecting;
  end;

  if FUseLoginPrompt and not Login then
    FIBError(feOperationCancelled, [nil]);
  (*
   * Generate a new DPB if necessary
   *)
  if FDBParamsChanged then
  begin
    FDBParamsChanged := False;
    GenerateDPB(FDBParams, DPB, FDPBLength);
    FIBAlloc(FDPB, 0, FDPBLength);
    Move(DPB[1], FDPB[0], FDPBLength);
  end;
  (*
   * Attach to the database, and raise an IB error if
   * the statement doesn't execute correctly.
   *)
  SV:=StatusVector;
  isc_res:=Call(FClientLibrary.isc_attach_database(SV, Length(FDBName),
                         PChar(FDBName), @FHandle,
                         FDPBLength, FDPB), False);

  if isc_res > 0 then
  begin
    FHandle := nil;
    IbError(Self,Self);
  end;


  DPB:=FDPB;
  for i := 0 to FFIBBases.Count - 1 do
      FIBBases[i].FOnDatabaseConnected;



{$IFNDEF NO_MONITOR}
  if MonitoringEnabled  then
   if MonitorHook<>nil then
    MonitorHook.DBConnect(Self);
{$ENDIF}
  FDifferenceTime:=0;
  if DBSQLDialect<SQLDialect then FSQLDialect:=DBSQLDialect;
  if FSynchronizeTime and not (csDesigning in ComponentState) then
   FDifferenceTime:=Now-GetServerTime;
  FConnectType:=0;
  DoOnConnect;
 if Assigned(FSQLLogger) then
  FSQLLogger.WriteData(CmpFullName(Self),'Connect','',lfConnect);
end;

function  TFIBDatabase.GetServerTime:TDateTime;
begin
  if FSQLDialect<2 then
    Result:=QueryValue('SELECT CAST(''NOW'' AS DATE) from RDB$DATABASE',0)
  else
    Result:=QueryValue('SELECT CAST(''NOW'' AS TIMESTAMP) from RDB$DATABASE',0)
end;

{$IFDEF USE_DEPRECATE_METHODS1}
{$WARNINGS OFF}
procedure TFIBDatabase.RemoveDataSet(Idx: Integer);
begin
  RemoveFIBBase(Idx);
end;
{$WARNINGS ON}
{$ENDIF}

procedure TFIBDatabase.RemoveFIBBase(Idx: Integer);
var 
  ds:  TFIBBase;
begin
  if (Idx >= 0) and (FFIBBases[Idx] <> nil) then
  begin
    ds := FIBBases[Idx];
    ds.FDatabase := nil;
    if Idx<FFIBBases.Count-1 then
    begin
     ds := FFIBBases[FFIBBases.Count-1];
     FFIBBases[Idx]:=ds;
     ds.FIndexInDatabase:=Idx;
     FFIBBases.Delete(FFIBBases.Count-1);
    end
    else
     FFIBBases.Delete(Idx);
  end;
end;
{$IFDEF USE_DEPRECATE_METHODS1}
{$WARNINGS OFF}
procedure TFIBDatabase.RemoveDataSets;
begin
 RemoveFIBBases
end;
{$WARNINGS ON}
{$ENDIF}

procedure TFIBDatabase.RemoveFIBBases;
var 
  i:  Integer;
begin
  for i := FFIBBases.Count - 1 downto 0 do
   RemoveFIBBase(i);
end;

procedure TFIBDatabase.RemoveTransaction(Idx: Integer);
var
  TR: TFIBTransaction;
begin
  if ((Idx >= 0) and (FTransactions[Idx] <> nil)) then
  begin
    TR := Transactions[Idx];
    FTransactions.Delete(Idx);
    TR.FDatabases.Remove(Self);
    if TR.FDefaultDatabase=Self then TR.FDefaultDatabase:=nil;
    if TR = FDefaultTransaction then
      FDefaultTransaction := nil;
    if TR = FDefaultUpdateTransaction then
      FDefaultUpdateTransaction := nil;
  end;
end;

procedure TFIBDatabase.RemoveTransactions;
var 
  i: Integer;
begin
  for i := Pred(FTransactions.Count) downto  0 do
   if FTransactions[i] <> nil then
    RemoveTransaction(i);
end;
 
procedure TFIBDatabase.LoadLibrary;
begin
   if not FClientLibLoaded then
   begin
    FClientLibrary:=IB_Intf.GetClientLibrary(FLibraryName);
    FClientLibLoaded:=Assigned(FClientLibrary);
   end;
end;
 
procedure TFIBDatabase.SetConnected(Value: Boolean);
begin
  if csReading in ComponentState then
    FStreamedConnected := Value
  else
  if Value then
  begin
   Open
  end
  else
    Close;
end;
 
procedure TFIBDatabase.SetDatabaseName(const Value: string);
begin
  if FDBName <> Value then
  begin
    if csDesigning in ComponentState then
     Close
    else
     CheckInactive;
    FDBName := Value;
  end;
  FDBFileName:=''
end;

procedure TFIBDatabase.SetDBParamByName(const ParName,Value: string);
var 
  ConstIdx:  Integer;
begin
  ConstIdx := IndexOfDBConst(ParName);
  if (Value = '') then
  begin
    if ConstIdx <> -1 then
      DBParams.Delete(ConstIdx);
  end
  else
  begin
    if (ConstIdx = -1) then
      DBParams.Add(ParName + '=' + Value)
    else
      DBParams[ConstIdx] := ParName + '=' + Value;
  end;
end;

procedure TFIBDatabase.SetDBParamByDPB(const Idx: Integer; Value: string);
begin
  SetDBParamByName(DPBConstantNames[Idx],Value);
end;
 
procedure TFIBDatabase.SetDBParams(Value: TDBParams);
begin
  FDBParams.Assign(Value);
end;
 
procedure TFIBDatabase.SetDefaultTransaction(Value: TFIBTransaction);
begin
  if  (FDefaultTransaction <> Value) then
  if Assigned(Value) then
  begin
    Value.AddDatabase(Self);
    AddTransaction(Value);
    if not Assigned(Value.FDefaultDatabase) then
      Value.FDefaultDatabase:=Self;
  end;
  FDefaultTransaction := Value;
end;

procedure TFIBDatabase.SetDefaultUpdateTransaction(Value: TFIBTransaction);
begin
  if  (FDefaultUpdateTransaction <> Value) then
  if Assigned(Value) then
  begin
    Value.AddDatabase(Self);
    AddTransaction(Value);
    if not Assigned(Value.FDefaultDatabase) then
      Value.FDefaultDatabase:=Self;
  end;
  FDefaultUpdateTransaction  := Value;
end;
 
 
procedure TFIBDatabase.CreateTimeoutTimer;
begin
  if not Assigned(FTimer) then
  begin
    FTimer:= TFIBTimer.Create(Self);
    with FTimer do
    begin
      Enabled   := False;
      Interval  := 0;
      OnTimer   := TimeoutConnection;
    end;
  end;
end;

procedure TFIBDatabase.SetCanTimeout(Value:boolean);
begin
  FCanTimeout:=Value;
  if Assigned(FTimer) then
     FTimer.Enabled := Value;
end;
 

procedure TFIBDatabase.SetTimeout(Value: Cardinal);
begin
  if (Value = 0) then
  begin
    if Assigned(FTimer) then
    begin
      FTimer.Free;
      FTimer:=nil
    end;
  end
  else
  if (Value > 0) then
  begin
    CreateTimeoutTimer;
    FTimer.Interval := Value;
    if not (csDesigning in ComponentState) then
      FTimer.Enabled := True;
  end;
end;

procedure TFIBDatabase.SetHandle(Value: TISC_DB_HANDLE);
begin
  if HandleIsShared then
    Close
  else
    CheckInactive;
  FHandle := Value;
  FHandleIsShared := (Value <> nil);
  if FHandleIsShared then
   DoOnConnect
end;

function TFIBDatabase.TestConnected: Boolean;
begin
  Result := Connected;
  if Result then
  try
    if BaseLevel = 0 then ; // who cares
  except
    ForceClose;
    Result := False;
  end;
end;

procedure TFIBDatabase.TimeoutConnection(Sender: TObject);
begin
  if Connected then
    if FCanTimeout then
    begin
      ForceClose;
      if Assigned(FOnTimeout) then  FOnTimeout(Self);
    end
    else
      FCanTimeout := True;
end;

function  TFIBDatabase.ClientVersion:string;
var p:PChar;
begin
 LoadLibrary;
 GetMem(p,100);
 try
  FClientLibrary.isc_get_client_version(p);
  Result:=p;
 finally
  FreeMem(p,100)
 end
end;
 
function  TFIBDatabase.ClientMajorVersion:integer;
begin
  LoadLibrary;
  Result:=FClientLibrary.ClientVersion
end;
 
function  TFIBDatabase.ClientMinorVersion:integer;
begin
  LoadLibrary;
  Result:=FClientLibrary.ClientMinorVersion
end;

function  TFIBDatabase.IsFirebirdConnect :boolean;
begin
  Result:= GetFBVersion<>''
end;

function  TFIBDatabase.IsIB2007Connect   :boolean;
begin
 Result:= not IsFirebirdConnect;
 if Result then
 begin
  Result:= ServerMajorVersion>=8
 end;
end;

function  TFIBDatabase.NeedUnicodeFieldsTranslation  :boolean;
begin
 if not Connected then
  Result:=(FConnectParams.CharSet='UNICODE_FSS') or
   (FConnectParams.CharSet='NONE') or
   (FConnectParams.CharSet='UTF8') or
   (FConnectParams.CharSet='')
 else
  Result:=FNeedUnicodeFieldsTranslation;
end;
 
function  TFIBDatabase.IsUnicodeConnect  :boolean;
begin
 if not Connected then
  Result:=(FConnectParams.CharSet='UNICODE_FSS') or  (FConnectParams.CharSet='UTF8')
 else
  Result:=FIsUnicodeConnect;
end;

{$IFDEF SUPPORT_KOI8_CHARSET}
function  TFIBDatabase.IsKOI8Connect  :boolean;
begin
 if not Connected then
  Result:=(FConnectParams.CharSet='KOI8R') or  (FConnectParams.CharSet='KOI8U')
 else
  Result:=FIsKOI8Connect;
end;
{$ENDIF}
 
function  TFIBDatabase.GetContextVariable(ContextSpace:TFBContextSpace;const VarName:string
;aTransaction:TFIBTransaction=nil
):Variant;
var
   NameSpace:  string ;
begin
  case ContextSpace of
      csSystem      :NameSpace:='SYSTEM';
      csSession     :NameSpace:='USER_SESSION';
      csTransaction :NameSpace:='USER_TRANSACTION';
  end;
 
  if IsFirebirdConnect  and (GetServerMajorVersion>=2) then
  begin
    Result:=
     QueryValue('Select rdb$get_context(:NameSpace,:VarName) from rdb$database',
      0,[NameSpace,VarName],aTransaction
     );
    if VarType(Result)=varBoolean then
     Result := null;
  end
  else
   FIBError(feFB2feature,['"rdb$get_context"']);
end;


procedure TFIBDatabase.SetContextVariable(ContextSpace:TFBContextSpace;const VarName,VarValue:string
;aTransaction:TFIBTransaction=nil
);
var
   NameSpace: string ;
begin
  if IsFirebirdConnect  and (GetServerMajorVersion>=2) then
  begin
     case ContextSpace of
      csSystem      :NameSpace:='SYSTEM';
      csSession     :NameSpace:='USER_SESSION';
      csTransaction :NameSpace:='USER_TRANSACTION';
     end;
     QueryValue(
     'Execute block (NameSpace varchar(80) =:N,'#13#10+
      'VarName varchar(80) =:V,  VarValue  varchar(80) =:VV) as '#13#10+
     'begin'#13#10+
      ' rdb$set_context(:NameSpace,:VarName,:VarValue);'#13#10+
     'end',
      -1,[NameSpace,VarName,VarValue],aTransaction
     );
  end
  else
    FIBError(feFB2feature,['"rdb$set_context"']);
end;

(* Database Info procedures -- Advanced stuff (translated from isc_database_info) *)
function TFIBDatabase.GetAllocation: Long;
begin
  Result := GetLongDBInfo(isc_info_allocation);
end;
 
function TFIBDatabase.GetBaseLevel: Long;
var 
  local_buffer:  array[0..FIBLocalBufferLength - 1] of Char;
  DBInfoCommand: Char;
begin
  CheckActive;
  DBInfoCommand := Char(isc_info_base_level);
  Call(ClientLibrary.isc_database_info(StatusVector, @FHandle, 1, @DBInfoCommand,
                         FIBLocalBufferLength, local_buffer), True);
  Result := FClientLibrary.isc_vax_integer(@local_buffer[4], 1);
end;

function TFIBDatabase.GetDBFileName: string;
var 
  local_buffer: array[0..FIBLocalBufferLength - 1] of Char;
  DBInfoCommand: Char;
begin
  if FDBFileName='' then
  begin
    CheckActive;
    DBInfoCommand := Char(isc_info_db_id);
    Call(FClientLibrary.isc_database_info(StatusVector, @FHandle, 1, @DBInfoCommand,
                           FIBLocalBufferLength, local_buffer), True);
    local_buffer[5 + Int(local_buffer[4])] := #0;
    Result := PChar(@local_buffer[5]);
    FDBFileName := Result
  end
  else
    Result:=FDBFileName
end;

function TFIBDatabase.GetDBSiteName: string;
var
  local_buffer: array[0..FIBBigLocalBufferLength - 1] of Char;
  p: PChar;
  DBInfoCommand: Char;
begin
  CheckActive;
  DBInfoCommand := Char(isc_info_db_id);
  Call(FClientLibrary.isc_database_info(StatusVector, @FHandle, 1, @DBInfoCommand,
                        FIBLocalBufferLength, local_buffer), True);
  p := @local_buffer[5 + Int(local_buffer[4])]; // DBSiteName Length
  p := p + Int(p^) + 1;                         // End of DBSiteName
  p^ := #0;                                     // Null it.
  Result := PChar(@local_buffer[6 + Int(local_buffer[4])]);
end;

function TFIBDatabase.GetIsRemoteConnect: boolean;
var 
  local_buffer: array[0..FIBBigLocalBufferLength - 1] of Char;
  DBInfoCommand: Char;
begin
  CheckActive;
  if FConnectType=0 then
  begin
    DBInfoCommand := Char(isc_info_db_id);
    Call(FClientLibrary.isc_database_info(StatusVector, @FHandle, 1, @DBInfoCommand,
                          FIBLocalBufferLength, local_buffer), True);
    FConnectType:=Int(local_buffer[3]);
  end;
  Result:=FConnectType=4
end;

function TFIBDatabase.GetActiveTransactions: TStringList; // isc_info_active_transactions
var
  local_buffer: array[0..FIBBigLocalBufferLength - 1] of Char;
  DBInfoCommand: Char;
  i:integer;
  L:integer;
begin
  CheckActive;
  if FActiveTransactions=nil then FActiveTransactions:=TStringList.Create;
  Result:=FActiveTransactions;
  FActiveTransactions.Clear;
 
  DBInfoCommand := Char(frb_info_active_transactions);
  Call(FClientLibrary.isc_database_info(StatusVector, @FHandle, 1, @DBInfoCommand,
                        FIBLocalBufferLength, local_buffer), True);
  i:=0;
 
  while local_buffer[i] = Char(frb_info_active_transactions) do
  begin
    Inc(i,3);
    L      :=FClientLibrary.isc_vax_integer(@local_buffer[i], 4);
    Result .Add(IntToStr(L));
    Inc(i,4);
  end;
end;

function TFIBDatabase.GetFBVersion: string; //frb_info_firebird_version
var
  local_buffer: array[0..FIBBigLocalBufferLength - 1] of Char;
  DBInfoCommand: Char;
begin
  CheckActive;
  DBInfoCommand := Char(frb_info_firebird_version);
  Call(FClientLibrary.isc_database_info(StatusVector, @FHandle, 1, @DBInfoCommand,
                        FIBLocalBufferLength, local_buffer), True);
  if DBInfoCommand=local_buffer[0] then
  begin
   local_buffer[5 + Int(local_buffer[4])] := #0;
   Result:= PChar(@local_buffer[5]);
  end
  else
   Result:= '';
end;
 
function TFIBDatabase.GetAttachCharset:Integer;               // frb_info_att_charset
var
  Success:  boolean ;
begin
 Result:=GetProtectLongDBInfo(frb_info_att_charset,Success);
 if not Success then
  Result := -1   
end;
 
procedure TFIBDatabase.FillServerVersions;
var
   VersionStr: string;
   tmpstr:string;
   i:integer;
   PVersion:PInteger;
begin
 CheckActive;
 if FServerMajorVersion=-1 then
 begin
   if IsFirebirdConnect then
     VersionStr:=FBVersion
   else
     VersionStr:=Version;
   tmpStr:='';
   i:=5;
   PVersion:=@FServerMajorVersion;
   while i< Length(VersionStr)  do
   begin
     if VersionStr[i] in ['0'..'9'] then
      tmpStr:=tmpStr+VersionStr[i]
     else
     begin
      if Length(tmpStr)>0 then
       PVersion^:=StrToInt(tmpStr)
      else
       PVersion^:=0;
      tmpStr:=''; 
      if PVersion=@FServerMajorVersion then
       PVersion:=@FServerMinorVersion
      else
      if PVersion=@FServerMinorVersion then
       PVersion:=@FServerRelease
      else
      if PVersion=@FServerRelease then
       PVersion:=@FServerBuild
      else
       Break;
     end;
     Inc(i);
   end;
 end;
end;

function TFIBDatabase.GetServerMajorVersion: integer;
begin
 FillServerVersions;
 Result:=FServerMajorVersion;
end;
 
 
function TFIBDatabase.GetServerMinorVersion: integer;
begin
 FillServerVersions;
 Result:=FServerMinorVersion;
end;

function TFIBDatabase.GetServerBuild: integer;
begin
 FillServerVersions;
 Result:=FServerBuild;
end;
 
function TFIBDatabase.GetServerRelease: integer;
begin
 FillServerVersions;
 Result:=FServerRelease;
end;

function TFIBDatabase.GetDBImplementationNo: Long;
var
  local_buffer:  array[0..FIBLocalBufferLength - 1] of Char;
  DBInfoCommand: Char;
begin
  CheckActive;
  DBInfoCommand := Char(isc_info_implementation);
  Call(FClientLibrary.isc_database_info(StatusVector, @FHandle, 1, @DBInfoCommand,
                        FIBLocalBufferLength, local_buffer), True);
  Result := FClientLibrary.isc_vax_integer(@local_buffer[3], 1);
end;
 
function TFIBDatabase.GetOldestTransaction: Long;
var 
  Success:  boolean;
begin
 Result:=GetProtectLongDBInfo(frb_info_oldest_transaction,Success);
end;

function TFIBDatabase.GetOldestActive: Long;
var 
  Success:  boolean;
begin
 Result:=GetProtectLongDBInfo(frb_info_oldest_active,Success);
end;
 
function TFIBDatabase.GetOldestSnapshot: Long;
var
  Success: boolean;
begin
 Result:=GetProtectLongDBInfo(frb_info_oldest_snapshot,Success);
end;


function TFIBDatabase.GetDBImplementationClass: Long;
var
  local_buffer:  array[0..FIBLocalBufferLength - 1] of Char;
  DBInfoCommand: Char;
begin
  DBInfoCommand := Char(isc_info_implementation);
  Call(FClientLibrary.isc_database_info(StatusVector, @FHandle, 1, @DBInfoCommand,
                         FIBLocalBufferLength, local_buffer), True);
  Result := FClientLibrary.isc_vax_integer(@local_buffer[4], 1);
end;
 
function TFIBDatabase.GetNoReserve: Long;
begin
  Result := GetLongDBInfo(isc_info_no_reserve);
end;

function TFIBDatabase.GetODSMinorVersion: Long;
begin
  Result := GetLongDBInfo(isc_info_ods_minor_version);
end;

function TFIBDatabase.GetODSMajorVersion: Long;
begin
  Result := GetLongDBInfo(isc_info_ods_version);
end;
 
function TFIBDatabase.GetPageSize: Long;
begin
  Result := GetLongDBInfo(isc_info_page_size);
end;

function TFIBDatabase.GetVersion: string;
var
  local_buffer: array[0..FIBBigLocalBufferLength - 1] of Char;
  DBInfoCommand: Char;
begin
  DBInfoCommand := Char(isc_info_version);
 
  Call(FClientLibrary.isc_database_info(StatusVector, @FHandle, 1, @DBInfoCommand,
                        FIBBigLocalBufferLength, local_buffer), True);
  local_buffer[5 + Int(local_buffer[4])] := #0;
  Result := PChar(@local_buffer[5]);
end;

function TFIBDatabase.GetCurrentMemory: Long;
begin
  Result := GetLongDBInfo(isc_info_current_memory);
end;

function TFIBDatabase.GetForcedWrites: Long;
begin
  Result := GetLongDBInfo(isc_info_forced_writes);
end;
 
function TFIBDatabase.GetMaxMemory: Long;
begin
  Result := GetLongDBInfo(isc_info_max_memory);
end;
 
function TFIBDatabase.GetNumBuffers: Long;
begin
  Result := GetLongDBInfo(isc_info_num_buffers);
end;

function TFIBDatabase.GetSweepInterval: Long; // isc_info_sweep_interval
begin
  Result := GetLongDBInfo(isc_info_sweep_interval);
end;

function TFIBDatabase.GetUserNames: TStringList;
var 
  local_buffer:  array[0..FIBHugeLocalBufferLength - 1] of Char;
  temp_buffer: array[0..FIBLocalBufferLength - 2] of Char;
  DBInfoCommand: Char;
  i, user_length: Integer;
begin
  if FUserNames = nil then FUserNames := TStringList.Create;
  Result := FUserNames;
  DBInfoCommand := Char(isc_info_user_names);
  Call(FClientLibrary.isc_database_info(StatusVector, @FHandle, 1, @DBInfoCommand,
                        FIBHugeLocalBufferLength, local_buffer), True);
  FUserNames.Clear;
  i := 0;
  while local_buffer[i] = Char(isc_info_user_names) do
  begin
    Inc(i, 3);
    // skip "isc_info_user_names byte" & two unknown bytes of structure (see below)
    user_length := Long(local_buffer[i]);
    Inc(i,1);
    Move(local_buffer[i], temp_buffer[0], user_length);
    Inc(i, user_length);
    temp_buffer[user_length] := #0;
    FUserNames.Add(string(temp_buffer));
  end;
end;

function TFIBDatabase.GetFetches: Long;
begin
  Result := GetLongDBInfo(isc_info_fetches);
end;
 
function TFIBDatabase.GetReadOnly: Long;
begin
  Result := GetLongDBInfo(isc_info_db_read_only);
end;

function TFIBDatabase.GetMarks: Long;
begin
  Result := GetLongDBInfo(isc_info_marks);
end;

function TFIBDatabase.GetReads: Long;
begin
  Result := GetLongDBInfo(isc_info_reads);
end;

function TFIBDatabase.GetWrites: Long;
begin
  Result := GetLongDBInfo(isc_info_writes);
end;

function TFIBDatabase.GetOperationCounts(DBInfoCommand: Integer; var FOperation: TStringList): TStringList;
var
  local_buffer:  array[0..FIBHugeLocalBufferLength - 1] of Char;
  _DBInfoCommand: Char;
  i, qtd_tables, id_table, qtd_operations: Integer;
begin
  if FOperation = nil then FOperation := TStringList.Create;
  Result := FOperation;
  _DBInfoCommand := Char(DBInfoCommand);
  Call(FClientLibrary.isc_database_info(StatusVector, @FHandle, 1, @_DBInfoCommand,
                         FIBHugeLocalBufferLength, local_buffer), True);
  FOperation.Clear;
  // 1. 1 byte specifying the item type requested (e.g., isc_info_insert_count).
  // 2. 2 bytes telling how many bytes compose the subsequent value pairs.
  // 3. A pair of values for each table in the database on wich the requested
  //    type of operation has occurred since the database was last attached.
  // Each pair consists of:
  // 1. 2 bytes specifying the table ID.
  // 2. 4 bytes listing the number of operations (e.g., inserts) done on that table.
  qtd_tables := trunc(FClientLibrary.isc_vax_integer(@local_buffer[1],2)/6);
  for i := 0 to qtd_tables - 1 do
  begin
    id_table := FClientLibrary.isc_vax_integer(@local_buffer[3+(i*6)],2);
    qtd_operations := FClientLibrary.isc_vax_integer(@local_buffer[5+(i*6)],4);
    FOperation.Add(IntToStr(id_table)+'='+IntToStr(qtd_operations));
  end;
end;

function TFIBDatabase.GetAllModifications:integer;
var 
  local_buffer: array[0..FIBHugeLocalBufferLength - 1] of Char;
  _DBInfoCommand: Char;
  i, qtd_tables: Integer;
  j:byte;
begin
  Result := 0;
  for j:=isc_info_insert_count to isc_info_delete_count do
  begin
    _DBInfoCommand:=Char(j);
    Call(FClientLibrary.isc_database_info(StatusVector, @FHandle, 1, @_DBInfoCommand,
                           FIBHugeLocalBufferLength, local_buffer), True);
    // 1. 1 byte specifying the item type requested (e.g., isc_info_insert_count).
    // 2. 2 bytes telling how many bytes compose the subsequent value pairs.
    // 3. A pair of values for each table in the database on wich the requested
    //    type of operation has occurred since the database was last attached.
    // Each pair consists of:
    // 1. 2 bytes specifying the table ID.
    // 2. 4 bytes listing the number of operations (e.g., inserts) done on that table.
    qtd_tables := trunc(FClientLibrary.isc_vax_integer(@local_buffer[1],2)/6);
    for i := 0 to qtd_tables - 1 do
    begin
      Inc(Result,FClientLibrary.isc_vax_integer(@local_buffer[5+(i*6)],4));
    end;
  end;
end;

function TFIBDatabase.GetBackoutCount: TStringList;
begin
 if FBackoutCount=nil then FBackoutCount:=TStringList.Create;
  Result := GetOperationCounts(isc_info_backout_count,FBackoutCount);
end;

function TFIBDatabase.GetDeleteCount: TStringList;
begin
 if FDeleteCount=nil then FDeleteCount:=TStringList.Create;
  Result := GetOperationCounts(isc_info_delete_count,FDeleteCount);
end;

function TFIBDatabase.GetExpungeCount: TStringList;
begin
 if FExpungeCount=nil then FExpungeCount:=TStringList.Create;
  Result := GetOperationCounts(isc_info_expunge_count,FExpungeCount);
end;
 
function TFIBDatabase.GetInsertCount: TStringList;
begin
 if FInsertCount=nil then FInsertCount:=TStringList.Create;
  Result := GetOperationCounts(isc_info_insert_count,FInsertCount);
end;
 

function TFIBDatabase.GetPurgeCount: TStringList;
begin
 if FPurgeCount=nil then FPurgeCount:=TStringList.Create;
  Result := GetOperationCounts(isc_info_purge_count,FPurgeCount);
end;

function TFIBDatabase.GetReadIdxCount: TStringList;
begin
 if FReadIdxCount=nil then
  FReadIdxCount:=TStringList.Create;
 Result := GetOperationCounts(isc_info_read_idx_count,FReadIdxCount);
end;

function TFIBDatabase.GetTableOperationInfo(const TableName:string; FromStrs:TStrings):integer;
var 
   vTableID:  integer;
   tmpStr:string;
begin
   vTableID:=ListTableInfo.GetTableInfo(Self, TableName, False).TableID;
   tmpStr:=FromStrs.Values[IntToStr(vTableID)];
   if Length(tmpStr) > 0 then
    Result:=StrToInt(tmpStr)
   else
    Result := 0;
end;
 
function TFIBDatabase.GetIndexedReadCount(const TableName:string):integer;
begin
   GetReadIdxCount;
   Result:=GetTableOperationInfo(TableName,FReadIdxCount)
end;
 
function TFIBDatabase.GetNonIndexedReadCount(const TableName:string):integer;
begin
  GetReadSeqCount;
  Result:=GetTableOperationInfo(TableName,FReadSeqCount)
end;
 
function TFIBDatabase.GetInsertsCount(const TableName:string):integer;
begin
  GetInsertCount;
  Result:=GetTableOperationInfo(TableName,FInsertCount)
end;
 
function TFIBDatabase.GetUpdatesCount(const TableName:string):integer;
begin
  GetUpdateCount;
  Result:=GetTableOperationInfo(TableName,FUpdateCount)
end;
 
function TFIBDatabase.GetDeletesCount(const TableName:string):integer;
begin
  GetDeleteCount;
  Result:=GetTableOperationInfo(TableName,FDeleteCount)
end;

function TFIBDatabase.GetReadSeqCount: TStringList;
begin
 if FReadSeqCount=nil then FReadSeqCount:=TStringList.Create;
  Result := GetOperationCounts(isc_info_read_seq_count,FReadSeqCount);
end;
 
function TFIBDatabase.GetUpdateCount: TStringList;
begin
 if FUpdateCount=nil then FUpdateCount:=TStringList.Create;
  Result := GetOperationCounts(isc_info_update_count,FUpdateCount);
end;
 
function TFIBDatabase.GetLogFile: Long;
begin
  Result := GetLongDBInfo(isc_info_logfile);
end;
 
function TFIBDatabase.GetCurLogFileName: string;
begin
  Result := GetStringDBInfo(isc_info_cur_logfile_name);
end;

function TFIBDatabase.GetCurLogPartitionOffset: Long;
begin
  Result := GetLongDBInfo(isc_info_cur_log_part_offset);
end;

function TFIBDatabase.GetNumWALBuffers: Long;
begin
  Result := GetLongDBInfo(isc_info_num_wal_buffers);
end;

function TFIBDatabase.GetWALBufferSize: Long;
begin
  Result := GetLongDBInfo(isc_info_wal_buffer_size);
end;
 
function TFIBDatabase.GetWALCheckpointLength: Long;
begin
  Result := GetLongDBInfo(isc_info_wal_ckpt_length);
end;

function TFIBDatabase.GetWALCurCheckpointInterval: Long;
begin
  Result := GetLongDBInfo(isc_info_wal_cur_ckpt_interval);
end;

function TFIBDatabase.GetWALPrvCheckpointFilename: string;
begin
  Result := GetStringDBInfo(isc_info_wal_prv_ckpt_fname);
end;

function TFIBDatabase.GetWALPrvCheckpointPartOffset: Long;
begin
  Result := GetLongDBInfo(isc_info_wal_prv_ckpt_poffset);
end;

function TFIBDatabase.GetWALGroupCommitWaitUSecs: Long;
begin
  Result := GetLongDBInfo(isc_info_wal_grpc_wait_usecs);
end;
 
function TFIBDatabase.GetWALNumIO: Long;
begin
  Result := GetLongDBInfo(isc_info_wal_num_io);
end;
 
function TFIBDatabase.GetWALAverageIOSize: Long;
begin
  Result := GetLongDBInfo(isc_info_wal_avg_io_size);
end;
 
function TFIBDatabase.GetWALNumCommits: Long;
begin
  Result := GetLongDBInfo(isc_info_wal_num_commits);
end;
 
function TFIBDatabase.GetWALAverageGroupCommitSize: Long;
begin
  Result := GetLongDBInfo(isc_info_wal_avg_grpc_size);
end;

function TFIBDatabase.GetProtectLongDBInfo
 (DBInfoCommand: Integer;var Success:boolean): Long;
var
  local_buffer: array[0..FIBLocalBufferLength - 1] of Char;
  length: Integer;
  _DBInfoCommand: Char;
begin
  _DBInfoCommand := Char(DBInfoCommand);
  Call(FClientLibrary.isc_database_info(StatusVector, @FHandle, 1, @_DBInfoCommand,
                         FIBLocalBufferLength, local_buffer), True);
  Success:=local_buffer[0] = _DBInfoCommand;
  length := FClientLibrary.isc_vax_integer(@local_buffer[1], 2);
  Result := FClientLibrary.isc_vax_integer(@local_buffer[3], length);
 
end;

function TFIBDatabase.GetLongDBInfo(DBInfoCommand: Integer): Long;
var Success:boolean;
begin
  Result := GetProtectLongDBInfo(DBInfoCommand,Success)
end;
 
function TFIBDatabase.GetStringDBInfo(DBInfoCommand: Integer): string;
var 
  local_buffer: array[0..FIBBigLocalBufferLength - 1] of Char;
  _DBInfoCommand: Char;
begin
  _DBInfoCommand := Char(DBInfoCommand);
  Call(FClientLibrary.isc_database_info(StatusVector, @FHandle, 1, @_DBInfoCommand,
                         FIBBigLocalBufferLength, local_buffer), True);
  local_buffer[4 + Int(local_buffer[3])] := #0;
  Result := PChar(@local_buffer[4]);
end;

function TFIBDatabase.GetAttachmentID  :Long;
begin
 if vAttachmentID=-1 then
 begin
  if FHandle=nil then
   Result    :=-1
  else
  begin
    Result:= GetLongDBInfo(isc_info_attachment_id);
    vAttachmentID:=Result;
  end;
 end
 else
  Result:= vAttachmentID;
end;

//Wrappers DBParams
 
//IB6
function TFIBDatabase.GetDBSQLDialect:Word;
var Success:boolean;
begin
 Result:=GetProtectLongDBInfo(isc_info_db_SQL_dialect,Success);
 if not Success then Result:=1
end;


procedure TFIBDatabase.SetSQLDialect(const Value: Integer);
begin
  if (Value < 1) then FIBError(feSQLDialectInvalid, [nil]);
  if (FHandle = nil) then
    FSQLDialect := Value
  else
  if Value<=DBSQLDialect then
   FSQLDialect := Value
  else
   FIBError(feSQLDialectInvalid, [nil])
end;
 

 
procedure TFIBDatabase.StartTransaction;
begin
  if DefaultTransaction = nil then
    FIBError(feTransactionNotAssigned, [nil]);
  DefaultTransaction.StartTransaction;
end;


procedure TFIBDatabase.Commit;
begin
  if DefaultTransaction = nil then
    FIBError(feTransactionNotAssigned, [CmpFullName(Self)]);
  DefaultTransaction.Commit;
end;
 
procedure TFIBDatabase.Rollback;
begin
  if DefaultTransaction = nil then
    FIBError(feTransactionNotAssigned, [CmpFullName(Self)]);
  DefaultTransaction.Rollback;
end;
 
procedure TFIBDatabase.CommitRetaining;
begin
  if DefaultTransaction = nil then
    FIBError(feTransactionNotAssigned, [CmpFullName(Self)]);
  DefaultTransaction.CommitRetaining;
end;

procedure TFIBDatabase.RollbackRetaining;
begin
  if DefaultTransaction = nil then
    FIBError(feTransactionNotAssigned, [CmpFullName(Self)]);
  DefaultTransaction.RollbackRetaining;
end;
 
function TFIBDatabase.EasyFormatsStr :boolean;
begin
 Result := (SQLDialect<3) or UpperOldNames;
end;
 
function TFIBDatabase.QueryValueAsStr(const aSQL: string;FieldNo:integer):string;
var
   v: Variant;
begin
 v:=QueryValue(aSQL,FieldNo);
 if VarIsNull(v) then
  Result:=''
 else
  Result:=VarAsType(v,varString)
end;

function TFIBDatabase.QueryValueAsStr(const aSQL: string;FieldNo:integer;
        ParamValues:array of variant ):string;
var 
    v:  Variant;
begin
 v:=QueryValue(aSQL,FieldNo,ParamValues,nil);
 if VarIsNull(v) then
  Result:=''
 else
  Result:=VarAsType(v,varString)
end;

function TFIBDatabase.InternalQueryValue(const aSQL: string;FieldNo:integer;
  ParamValues:array of variant; aTransaction:TFIBTransaction
):Variant;
var Query: TFIBQuery;
    i    :integer;
    c    :integer;

begin
  Result := False;
  if Assigned(aTransaction) then
   Query :=GetQueryForUse(aTransaction,aSQL)
  else
   Query :=GetQueryForUse(vInternalTransaction,aSQL);
  with Query.Params do
   if High(ParamValues)<Count-1 then
    c:=High(ParamValues)
   else
    c:=Count-1;
 
  with Query do
  try
    if not Transaction.Active then
      Transaction.StartTransaction;
    try
     for i:=0 to c do
      if not VarIsEmpty(ParamValues[i])   then
       Params[i].Value:=ParamValues[i];
 
     ExecQuery;
     if (Current.Count>0) then
      if (FieldNo>=0) then
      begin
       if Fields[FieldNo].SQLType = SQL_BLOB then
        Result := Fields[FieldNo].AsString
       else
        Result := Fields[FieldNo].Value
      end
      else
      begin
        c:= Pred(Current.Count);
        Result:=VarArrayCreate([0,c],varVariant);
        for i:=0 to c do
         if Fields[i].SQLType = SQL_BLOB then
          Result[i] := Fields[i].AsString
         else
          Result[i] := Fields[i].Value
      end;
    except
     if Transaction.Active then
      Transaction.RollBack;
     raise;
    end
  finally
     if Transaction.InTransaction and (aTransaction=nil) then
      Transaction.Commit;
     if c<0 then
      Free
     else
      FreeQueryForUse(Query);
  end;
end;
 
function TFIBDatabase.QueryValue(const aSQL: string;FieldNo:integer;aTransaction:TFIBTransaction=nil):Variant;
begin
 Result := InternalQueryValue(aSQL,FieldNo, [varEmpty],aTransaction);
end;
 

function TFIBDatabase.QueryValue(const aSQL: string;FieldNo:integer;
          ParamValues:array of variant;aTransaction:TFIBTransaction=nil
):Variant;
begin
  Result := InternalQueryValue(aSQL,FieldNo, ParamValues,aTransaction);
end;
 
function TFIBDatabase.QueryValues(const aSQL: string;aTransaction:TFIBTransaction=nil):Variant;
begin
  Result:= InternalQueryValue(aSQL,-1,[varEmpty],aTransaction);
end;

function TFIBDatabase.QueryValues(const aSQL: string;  ParamValues:array of variant;aTransaction:TFIBTransaction=nil):Variant;
begin
  Result:= InternalQueryValue(aSQL,-1, ParamValues,aTransaction);
end;

function TFIBDatabase.Execute(const SQL: string): boolean;
begin
 try
  QueryValue(SQL,-1);
  Result:= True
 except
  Result := False;
 end;
end;
 
procedure TFIBDatabase.CreateGUIDDomain;
begin
  Execute('CREATE DOMAIN TGUID AS CHAR(16) CHARACTER SET OCTETS');
end;
 
function TFIBDatabase.Gen_Id(const GeneratorName: string; Step: Int64;aTransaction:TFIBTransaction =nil): Int64;
var Query: TFIBQuery;
    GenName :string;
    vTransaction:TFIBTransaction;
    ForceOpenTr:boolean;
begin
  GenName := EasyFormatIdentifier(SQLDialect, GeneratorName,EasyFormatsStr);
  vTransaction:=FirstActiveTransaction;
  if vTransaction=nil then
   if aTransaction<>nil then
    vTransaction:=aTransaction
   else
    vTransaction:=vInternalTransaction;

  Query :=GetQueryForUse(vTransaction,
    'select gen_id(' + GenName + ', ' + IntToStr(Step) +') from RDB$DATABASE'
  );
  with Query, Transaction do
  try
    ForceOpenTr:=not Transaction.InTransaction;
    if ForceOpenTr then  StartTransaction;
    ExecQuery;
    Result := Fields[0].AsInt64;
   if ForceOpenTr then  Commit;
  finally
   FreeQueryForUse(Query);
  end;
end;



procedure TFIBDatabase.SetBlobSwapSupport(const Value: TBlobSwapSupport);
begin
  FBlobSwapSupport.Assign(Value);
end;

procedure TFIBDatabase.SetSQLLogger(const Value: ISQLLogger);
begin
  if Assigned(Value) then
  begin
   Value.SetDatabase(Self);
   if (Value.GetInstance is TComponent) then
    TComponent(Value.GetInstance).FreeNotification(Self);
  end;

  FSQLLogger := Value;
end;

procedure TFIBDatabase.SetSQLStatMaker(const Value: ISQLStatMaker);
begin
  FSQLStatMaker := Value;
end;

function TFIBDatabase.GetSQLLogger: ISQLLogger;
begin
 Result:=FSQLLogger
end;

procedure TFIBDatabase.Notification(AComponent: TComponent;
  Operation: TOperation);
var
   I: IUnknown;
begin
  if Operation=opRemove then
   if Supports(AComponent,ISQLLogger,I) then
   begin
     if I=FSQLLogger then
      FSQLLogger:=nil;
   end;
  inherited;   
end;

(* TFIBTransaction *)

constructor TFIBTransaction.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDatabases                           := TList.Create;
  FFIBBases                           := TList.Create;
  FHandle                              := nil;
  FTPB                                 := nil;
  FTPBLength                           := 0;
  FTRParams                            := TStringList.Create;
  FTRParamsChanged                     := True;
  TStringList(FTRParams).OnChange      := TRParamsChange;
  TStringList(FTRParams).OnChanging    := TRParamsChanging;
  FTimer                               := nil;
  FState                               := tsClosed;
  FTransactionID                       := 0;
  if (csDesigning in ComponentState)   and not CmpInLoadedState(Self)
  then
  begin
   FTimeOutAction := TTransactionAction(DefTimeOutAction);
   TimeOut        :=0;
   DefaultDataBase:=DefDataBase;
  end
  else
  begin
   FTimeOutAction :=taRollBack;
   TimeOut        :=DefTimeOut;
  end;
  vOnDestroy          := TNotifyEventList.Create(Self);
  vBeforeStartTransaction := TNotifyEventList.Create(Self);
  vAfterStartTransaction  := TNotifyEventList.Create(Self);

  vBeforeEndTransaction := TCallBackList.Create(Self);;
  vAfterEndTransaction  := TCallBackList.Create(Self);;

end;

destructor TFIBTransaction.Destroy;
var
  i: Integer;
begin
  if InTransaction then
  case FTimeoutAction of    
    TARollbackRetaining: EndTransaction(TARollback, True);
    TACommitRetaining  : EndTransaction(TACommit, True);  
  else
   EndTransaction(FTimeoutAction, True);
  end;
  for i := Pred(vOnDestroy.Count) downto 0 do
   vOnDestroy.Event[i](Self);
  for i := FFIBBases.Count - 1 downto 0 do
    FIBBases[i].FOnTransactionFree;
  RemoveFIBBases;
  RemoveDatabases;
  FIBAlloc(FTPB, 0, 0);
  FTRParams.Free;
  FFIBBases.Free;
  FDatabases.Free;
  inherited Destroy;
end;
 
procedure TFIBTransaction.CreateTimeoutTimer;
begin
  if not Assigned(FTimer) then
  begin
    FTimer := TFIBTimer.Create(Self);
    with FTimer do
    begin
      Enabled  := False;
      Interval := 0;
      OnTimer  := TimeoutTransaction;
    end;
  end;
end;
 
function TFIBTransaction.DoStoreActive:boolean;
begin
 Result:=Active and MainDatabase.StoreConnected
end;
 
function TFIBTransaction.Call(ErrCode: ISC_STATUS;
  RaiseError: Boolean): ISC_STATUS;
var 
  i: Integer;
begin
  Set8087CW(Default8087CW);
  Result := ErrCode;
  for i := 0 to FDatabases.Count - 1 do
    Databases[i].FCanTimeout := False;
  FCanTimeout := False;
  if (Result > 0) and RaiseError  then
    IbError(IIbClientLibrary(Databases[0]),Self);
end;

procedure TFIBTransaction.CheckDatabasesInList;
begin
  if GetDatabaseCount = 0 then
    FIBError(feNoDatabasesInTransaction, [CmpFullName(Self)]);
end;

procedure TFIBTransaction.AddEvent(Event:TNotifyEvent;EventType:TpFIBTrEventType);
begin
 case EventType of
  tetBeforeStartTransaction:vBeforeStartTransaction.Add(Event);
  tetAfterStartTransaction :vAfterStartTransaction.Add(Event);
  tetBeforeDestroy         :vOnDestroy.Add(Event);
 else
  Assert(False);
 end;
end;
 
procedure TFIBTransaction.RemoveEvent(Event:TNotifyEvent;EventType:TpFIBTrEventType);
begin
 case EventType of
  tetBeforeStartTransaction:vBeforeStartTransaction.Remove(Event);
  tetAfterStartTransaction :vAfterStartTransaction.Remove(Event);
  tetBeforeDestroy   :  vOnDestroy.Remove(Event);
 else
  Assert(False);
 end;
end;
 
procedure TFIBTransaction.AddEndEvent(Event:TEndTrEvent;EventType:TpFIBTrEventType);
begin
 case EventType of
  tetBeforeEndTransaction:vBeforeEndTransaction.RegisterCallBack(TMethod(Event));
  tetAfterEndTransaction :vAfterEndTransaction.RegisterCallBack(TMethod(Event));
 else
  Assert(False);
 end;
end;

procedure TFIBTransaction.RemoveEndEvent(Event:TEndTrEvent;EventType:TpFIBTrEventType);
begin
 case EventType of
  tetBeforeEndTransaction  :vBeforeEndTransaction.UnRegisterCallBack(TMethod(Event));
  tetAfterEndTransaction   :vAfterEndTransaction.UnRegisterCallBack(TMethod(Event));
 else
  Assert(False);  
 end;
end;
 
procedure TFIBTransaction.CheckInTransaction;
begin
  if FStreamedActive and (not InTransaction) then
    Loaded;
  if (FHandle = nil)  then
   if not (csDesigning in ComponentState)  then
    FIBError(feNotInTransaction, [CmpFullName(Self)])
   else
    StartTransaction;
end;
 
procedure TFIBTransaction.CheckNotInTransaction;
begin
  if (FHandle <> nil) then
    FIBError(feInTransaction, [CmpFullName(Self)]);
end;

function TFIBTransaction.AddDatabase(db: TFIBDatabase): Integer;
var
  i: Integer;
begin
  if not Assigned(db) then
   Result:=-1
  else
  begin
    i := FindDatabase(db);
    if i <> -1 then
      Result := i
    else
    begin
      if (FDatabases.Count>0) and
       (TFIBDatabase(FDatabases[0]).LibraryName<>db.LibraryName)
      then
       raise EAPICallException.CreateFmt(STransactionForOtherLibrary,[CmpFullName(Self)]);
      Result := FDatabases.Count;
      FDatabases.Add(db);
    end;
  end;  
end;
 
{$IFDEF USE_DEPRECATE_METHODS1}
function TFIBTransaction.AddDataSet(ds: TFIBBase): Integer;
begin
  Result:=AddFIBBase(ds);
end;
{$ENDIF}

function  TFIBTransaction.AddFIBBase(ds: TFIBBase): Integer;
begin
  Result := 0;
  while (Result < FFIBBases.Count) and (FFIBBases[Result] <> nil) do
    Inc(Result);
  if (Result = FFIBBases.Count) then
    FFIBBases.Add(ds)
  else
    FFIBBases[Result] := ds;
end;

procedure TFIBTransaction.Commit;
begin
  EndTransaction(TACommit, False);
end;

procedure TFIBTransaction.CommitRetaining;
begin
  EndTransaction(TACommitRetaining, False);
end;

(*
 * EndTransaction -
 *  End a transaction ...
 *)
procedure TFIBTransaction.EndTransaction(Action: TTransactionAction;
  Force: Boolean);
var
  status:  ISC_STATUS;
  s:string;
procedure DoBefore;
var 
  i:  Integer;
begin
  for i := FFIBBases.Count - 1 downto 0 do
   FIBBases[i].FOnTransactionEnding;
  for i := 0 to vBeforeEndTransaction.Count - 1 do
   TEndTrEvent(vBeforeEndTransaction.CallBackAddr[i]^)(Self,Action, Force);
end;

procedure DoAfter;
var
  i: Integer;
begin
  for i :=  FFIBBases.Count - 1 downto 0 do
    FIBBases[i].FOnTransactionEnded;
  for i := 0 to vAfterEndTransaction.Count - 1 do
   TEndTrEvent(vAfterEndTransaction.CallBackAddr[i]^)(Self,Action, Force);
end;
 
begin
  CheckInTransaction;
  if Assigned(MainDatabase.FSQLLogger) then
  begin
    case Action of
     TACommit:
        s:='Commit';
     TARollback:
        s:='RollBack';
     TACommitRetaining:
        s:='CommitRetianing';
    else
        s:='RollBackRetianing';
    end;
       MainDatabase.FSQLLogger.WriteData(
        CmpFullName(Self),s+'(TransactionID='+IntToStr(TransactionID)+') ',
         'TransactionParams:'#13#10+TRParams.Text,lfTransact
       );
  end;
  FTransactionID:=0;
 
  case Action of
    TARollback, TACommit:
    begin
      if (HandleIsShared) and
         (Action <> FTimeoutAction) and
         (not Force) then
        FIBError(feCantEndSharedTransaction, [nil]);
      if Action=TARollback then
       FState:=tsDoRollback
      else
       FState:=tsDoCommit;
      DoBefore;
      if HandleIsShared then
      begin
        FHandle := nil;
        FHandleIsShared := False;
        status := 0;
      end
      else
      if (Action = TARollback) then
        status := Call(IIbClientLibrary(MainDatabase).isc_rollback_transaction(StatusVector, @FHandle), False)
      else
        status := Call(IIbClientLibrary(MainDatabase).isc_commit_transaction(StatusVector, @FHandle), False);
      if ((Force) and (status > 0)) then
        status := Call(IIbClientLibrary(MainDatabase).isc_rollback_transaction(StatusVector, @FHandle), False);
      if Force then
        FHandle := nil
      else
      if (status > 0) then
        IBError(MainDatabase,Self);
      DoAfter;

    end;
    TACommitRetaining:
    begin
      FState:=tsDoCommitRetaining;
      DoBefore;
      Call(IIbClientLibrary(MainDatabase).isc_commit_retaining(StatusVector, @FHandle), True);
      DoAfter;
    end;
    TARollbackRetaining:
    begin
      FState:=tsDoRollbackRetaining;
      DoBefore;
      Call(IIbClientLibrary(MainDatabase).isc_rollback_retaining(StatusVector, @FHandle), True);
      DoAfter;
    end;
  end;
 {$IFNDEF NO_MONITOR}
   if MonitoringEnabled  then
   case Action of
    TACommit:
     if MonitorHook<>nil then
       MonitorHook.TRCommit(Self);
    TARollback:
     if MonitorHook<>nil then
       MonitorHook.TRRollback(Self);
    TACommitRetaining:
     if MonitorHook<>nil then
      MonitorHook.TRCommitRetaining(Self);
    TARollbackRetaining:
     if MonitorHook<>nil then
      MonitorHook.TRRollbackRetaining(Self);
   end;
 {$ENDIF}
  if InTransaction then
  begin
   FState:=tsActive;
  end
  else
  begin
   FState:=tsClosed ;
   if csDesigning in ComponentState then  CloseAllQueryHandles;
  end;
end;

function TFIBTransaction.GetDatabase(Index: Integer): TFIBDatabase;
begin
  Result := FDatabases[Index];
end;

function TFIBTransaction.GetDatabaseCount: Integer;
begin
  Result := FDatabases.Count;
end;
 
function  TFIBTransaction.MainDatabase:TFIBDatabase;
begin
  if Assigned(DefaultDatabase) then
   Result:=DefaultDatabase
  else
  if FDatabases.Count=0 then
   Result := nil
  else
   Result :=FDatabases[0];
end;

function TFIBTransaction.GetFIBBase(Index: Integer): TFIBBase;
begin
  Result := FFIBBases[Index];
end;
 
function TFIBTransaction.GetFIBBasesCount: Integer;
begin
  Result := FFIBBases.Count;
end;
 
function TFIBTransaction.GetInTransaction: Boolean;
begin
  Result := (FHandle <> nil);
end;
 
function TFIBTransaction.FindDatabase(db: TFIBDatabase): Integer;
begin
  if db=nil then
   Result := -1
  else
   Result:=FDatabases.IndexOf(db);
end;
 
function TFIBTransaction.GetTimeout: Cardinal;
begin
   if Assigned(FTimer) then
    Result := FTimer.Interval
   else
    Result := 0;  
end;

procedure TFIBTransaction.Loaded;
begin
  inherited Loaded;
  try
   if FStreamedActive and (not InTransaction) then StartTransaction;
  except
    if (csDesigning in ComponentState) and Assigned(AppHandleException) then
      AppHandleException(Self)
    else
      raise;
  end;
end;
 
procedure TFIBTransaction.OnDatabaseDisconnecting(DB: TFIBDatabase);
begin
  if InTransaction then
    // Force the transaction to end
  if FTimeoutAction= TACommitRetaining then
    EndTransaction(TACommit, True)
  else
    EndTransaction(FTimeoutAction, True);
end;
 
procedure TFIBTransaction.RemoveDatabase(Idx: Integer);
var 
  DB:  TFIBDatabase;
begin
  if ((Idx >= 0) and (FDatabases[Idx] <> nil)) then
  begin
    DB := Databases[Idx];
    FDatabases.Delete(Idx);
    DB.FTransactions.Remove(Self);
    if DB.FDefaultTransaction=Self then
     DB.FDefaultTransaction:=nil;
    if DB.FDefaultUpdateTransaction=Self then
     DB.FDefaultUpdateTransaction:=nil;
 
    if DB = FDefaultDatabase then
      FDefaultDatabase := nil;
  end;
end;

procedure TFIBTransaction.RemoveDatabases;
var
  i:  Integer;
begin
  for i := Pred(FDatabases.Count) downto 0 do
    RemoveDatabase(i);
end;

procedure TFIBTransaction.ReplaceDatabase(dbOld,dbNew: TFIBDatabase);
begin
  RemoveDatabase(FindDatabase(dbOld));
  AddDatabase(dbNew)
end;

{$IFDEF USE_DEPRECATE_METHODS1}
{$WARNINGS OFF }
procedure TFIBTransaction.RemoveDataSet(Idx: Integer);
begin
  RemoveFIBBase(Idx);
end;
{$WARNINGS ON }
{$ENDIF}
 
procedure TFIBTransaction.RemoveFIBBase(Idx: Integer);
var
  ds: TFIBBase;
begin
  if ((Idx >= 0) and (FFIBBases[Idx] <> nil)) then
  begin
    ds := FIBBases[Idx];
    ds.FTransaction := nil;
    if Idx<FFIBBases.Count-1 then
    begin
     ds := FFIBBases[FFIBBases.Count-1];
     FFIBBases[Idx]:=ds;
     ds.FIndexInTransaction:=Idx;
     FFIBBases.Delete(FFIBBases.Count-1);
    end
    else
     FFIBBases.Delete(Idx);
  end;
end;
{$IFDEF USE_DEPRECATE_METHODS1}
{$WARNINGS OFF }
procedure TFIBTransaction.RemoveDataSets;
begin
  RemoveFIBBases
end;
{$WARNINGS ON }
{$ENDIF}

procedure TFIBTransaction.RemoveFIBBases;
var 
  i:  Integer;
begin
  for i := FFIBBases.Count - 1 downto 0 do
//  if FFIBBases[i] <> nil then
    RemoveFIBBase(i);
end;

procedure TFIBTransaction.Rollback;
begin
  EndTransaction(TARollback, False);
end;

procedure TFIBTransaction.RollbackRetaining;
begin
   EndTransaction(TARollbackRetaining, False);
end;

procedure TFIBTransaction.SetActive(Value: Boolean);
begin
  if csReading in ComponentState then
    FStreamedActive := Value
  else
  if Value and not InTransaction then
    StartTransaction
  else
  if not Value and InTransaction then
    Rollback;
end;
 
procedure TFIBTransaction.SetDefaultDatabase(Value: TFIBDatabase);
begin
  CheckNotInTransaction;
  if (Value <> FDefaultDatabase) then
  begin
    if Assigned(Value)  then
     Value.AddTransaction(Self);
    ReplaceDatabase(FDefaultDatabase,Value)
  end;
  FDefaultDatabase := Value;
end;
 
procedure TFIBTransaction.SetHandle(Value: TISC_TR_HANDLE);
begin
  if (HandleIsShared) then
    EndTransaction(TimeoutAction, True)
  else
    CheckNotInTransaction;
  FHandle := Value;
  FHandleIsShared := (Value <> nil);
end;
 
procedure TFIBTransaction.SetTimeout(Value: Cardinal);
begin
{  if Value < 0 then
    FIBError(feTimeoutNegative, [nil])
  else}
  if (Value = 0) then
  begin
    if Assigned(FTimer) then
    begin
      FTimer.Free;
      FTimer:=nil;
    end;
  end
  else
  if (Value > 0) then
  begin
    CreateTimeoutTimer;
    FTimer.Interval := Value;
    if not (csDesigning in ComponentState) then   FTimer.Enabled := True;
  end;
end;

procedure TFIBTransaction.SetTRParams(Value: TStrings);
begin
  FTRParams.Assign(Value);
end;
 
(*
 * StartTransaction -
 *  Start a transaction....
 *)
procedure TFIBTransaction.StartTransaction;
var 
  pteb:  PISC_TEB_ARRAY;
  TPB: string;
  i: Integer;
begin
  (*
   * Check that we're not already in a transaction.
   * Check that there is at least one database in the list.
   *)

  CheckNotInTransaction;
  CheckDatabasesInList;
  (*
   * Make sure that a current TPB is generated.
   *)
  if FTRParamsChanged then
  begin
    FTRParamsChanged := False;
    GenerateTPB(FTRParams, TPB, FTPBLength);
    FIBAlloc(FTPB, 0, FTPBLength);
    Move(TPB[1], FTPB[0], FTPBLength);
  end;
  (*
   * Set up a database record for each database in the list.
   * Ordinarily, each database could have its own set of
   * transaction options; however, FIB makes a transaction have
   * one set of transaction options..
   * Is this a limitation? Certainly. It this bad?
   * I don't think so...
   *)
  GetMem(pteb,DatabaseCount * SizeOf(TISC_TEB));
  try
    for i := 0 to DatabaseCount - 1 do
    begin
      Databases[i].CheckActive;
      pteb^[i].db_handle   := @(Databases[i].Handle);
      pteb^[i].tpb_length  := FTPBLength;
      pteb^[i].tpb_address := FTPB;
    end;
    for i := 0 to FFIBBases.Count - 1 do
     FIBBases[i].FOnTransactionStarting;

    (*
     * Finally, start the transaction
     *)
    if not InTransaction then
    begin
      for i := Pred(vBeforeStartTransaction.Count) downto 0 do
       vBeforeStartTransaction.Event[i](Self);

      if (Call(IIbClientLibrary(MainDatabase).isc_start_multiple(StatusVector, @FHandle,
                                 DatabaseCount, PISC_TEB(pteb)), False) > 0)

      then
      begin
        FHandle := nil;
        IbError(MainDatabase,Self);
      end;
      for i := Pred(vAfterStartTransaction.Count) downto 0 do
       vAfterStartTransaction.Event[i](Self);
    end;

    for i := 0 to FFIBBases.Count - 1 do
      FIBBases[i].FOnTransactionStarted;
 {$IFNDEF NO_MONITOR}
   if MonitoringEnabled  then 
    if MonitorHook<>nil then
     MonitorHook.TRStart(Self);
 {$ENDIF}
  finally
    FIBAlloc(pteb, 0, 0);
  end;
  FState:=tsActive;
 
  if Assigned(MainDatabase.FSQLLogger) then
   MainDatabase.FSQLLogger.WriteData(
    CmpFullName(Self),'StartTransaction(TransactionID='+IntToStr(TransactionID)+')',
    'TransactionParams:'#13#10+TRParams.Text,lfTransact
   );
end;

procedure TFIBTransaction.ExecSQLImmediate(const SQLText:string);
begin
  CheckInTransaction;
  Call(
    MainDatabase.ClientLibrary.
    isc_dsql_execute_immediate(
     StatusVector, @MainDatabase.Handle, @FHandle, 0,
     PChar(SQLText), MainDatabase.SQLDialect, nil
    ),
   True
  );
end;
 
procedure TFIBTransaction.SetSavePoint(const SavePointName:string);
begin
 ExecSQLImmediate('savepoint '+SavePointName);
 {$IFNDEF NO_MONITOR}
   if MonitoringEnabled  then 
    if MonitorHook<>nil then
      MonitorHook.TRSavepoint(Self,SavePointName,soSet)
 {$ENDIF}
end;
 
procedure TFIBTransaction.RollBackToSavePoint(const SavePointName:string);
begin
  ExecSQLImmediate('rollback to savepoint '+SavePointName);
 {$IFNDEF NO_MONITOR}
   if MonitoringEnabled  then
    if MonitorHook<>nil then
      MonitorHook.TRSavepoint(Self,SavePointName,soRollback)
 {$ENDIF}
end;
 
procedure TFIBTransaction.ReleaseSavePoint(const SavePointName:string);
begin
 ExecSQLImmediate('release savepoint '+SavePointName);
 {$IFNDEF NO_MONITOR}
   if MonitoringEnabled  then 
    if MonitorHook<>nil then
      MonitorHook.TRSavepoint(Self,SavePointName,soRelease)
 {$ENDIF}
end;

procedure TFIBTransaction.TimeoutTransaction(Sender: TObject);
begin
  if InTransaction then
  begin
    if FCanTimeout then
    begin
      EndTransaction(FTimeoutAction, True);
      if Assigned(FOnTimeout) then  FOnTimeout(Self);
    end
    else
      FCanTimeout := True;
  end;
end;
 
procedure TFIBTransaction.TRParamsChange(Sender: TObject);
begin
  FTRParamsChanged := True;
end;

procedure TFIBTransaction.TRParamsChanging(Sender: TObject);
begin
  CheckNotInTransaction;
end;
 
function  TFIBTransaction.GetTransactionID: integer;
var tra_items: char;
    tra_info :array [0..31] of char;
begin
 
if FTransactionID>0 then
begin
 Result:=FTransactionID; Exit;
end;

if FHandle=nil then
begin
  Result:=0; Exit;
end;

if MainDatabase.FDatabaseRunState<>[] then
begin
  Result:=0; Exit;
end;

tra_items:=Char(isc_info_tra_id);
Call(IIbClientLibrary(MainDatabase).
 isc_transaction_info(
  StatusVector,@FHandle,
  sizeof (tra_items),
  @tra_items,
  sizeof (tra_info),
  tra_info
 ),true
);
 Result:=PInteger(tra_info+3)^;
 FTransactionID:=Result
end;
 
procedure TFIBTransaction.CloseAllQueryHandles;
var i:integer;
begin
  for i :=0  to Pred(FIBBaseCount) do
  begin
    if (FIBBases[i].Owner is TFIBQuery) then
     TFIBQuery(FIBBases[i].Owner).FreeHandle
  end;
end;

function  TFIBTransaction.IsReadCommitedTransaction:boolean;
begin
 Result:=(FTRParams.IndexOf('read_committed')>-1) or
 (FTRParams.IndexOf(TPBPrefix+'read_committed')>-1)
end;

procedure TFIBTransaction.DoOnSQLExec(Query:TComponent;Kind:TKindOnOperation);
begin

end;

(* TFIBBase *)
constructor TFIBBase.Create(AOwner: TObject);
begin
  FOwner := AOwner;
end;

destructor TFIBBase.Destroy;
begin
  SetDatabase(nil);
  SetTransaction(nil);
  inherited;
end;

procedure TFIBBase.CheckDatabase;
begin
  if (FDatabase = nil) then
   if Self.Owner is TComponent  then
    FIBError(feDatabaseNotAssigned, [CmpFullName(TComponent(Self.Owner))])
   else
    FIBError(feDatabaseNotAssigned, ['']);
  FDatabase.CheckActive
end;

procedure TFIBBase.CheckTransaction;
begin
  if FTransaction = nil then
   if Self.Owner is TComponent  then
    FIBError(feTransactionNotAssigned, [CmpFullName(TComponent(Self.Owner))])
   else
    FIBError(feTransactionNotAssigned, [nil]);
  FTransaction.CheckInTransaction;
end;

function TFIBBase.GetDBHandle: PISC_DB_HANDLE;
begin
  CheckDatabase;
  Result := @FDatabase.Handle;
end;
 
function TFIBBase.GetTRHandle: PISC_TR_HANDLE;
begin
  CheckTransaction;
  Result := @FTransaction.Handle;
end;
 
 procedure TFIBBase.FOnDatabaseConnecting;
 begin
   if Assigned(OnDatabaseConnecting) then
     OnDatabaseConnecting(Self);
 end;

 procedure TFIBBase.FOnDatabaseConnected;
 begin
   if Assigned(OnDatabaseConnected) then
     OnDatabaseConnected(Self);
 end;


procedure TFIBBase.FOnDatabaseDisconnecting;
begin
  if Assigned(OnDatabaseDisconnecting) then
    OnDatabaseDisconnecting(Self);
end;
 
procedure TFIBBase.FOnDatabaseDisconnected;
begin
  if Assigned(OnDatabaseDisconnected) then
    OnDatabaseDisconnected(Self);
end;
 
procedure TFIBBase.FOnDatabaseFree;
begin
  if Assigned(OnDatabaseFree) then
    OnDatabaseFree(Self);
  // Ensure that FDatabase is nil
  SetDatabase(nil);
  SetTransaction(nil);
end;
 

procedure TFIBBase.FOnTransactionStarting;
begin
  if Assigned(OnTransactionStarting) then
    OnTransactionStarting(Self);
end;

procedure TFIBBase.FOnTransactionStarted;
begin
  if Assigned(OnTransactionStarted) then
    OnTransactionStarted(Self);
end;

procedure TFIBBase.FOnTransactionEnding;
begin
  if Assigned(OnTransactionEnding) then
    OnTransactionEnding(Self);
end;
 
procedure TFIBBase.FOnTransactionEnded;
begin
  if Assigned(OnTransactionEnded) then
    OnTransactionEnded(Self);
end;

procedure TFIBBase.FOnTransactionFree;
begin
  if Assigned(OnTransactionFree) then    OnTransactionFree(Self);
  // Ensure that FTransaction is nil
  FTransaction := nil;
end;

procedure TFIBBase.SetDatabase(Value: TFIBDatabase);
begin
  if FDatabase=Value then
   Exit;
  if (FDatabase <> nil) then
    FDatabase.RemoveFIBBase(FIndexInDatabase);
  FDatabase := Value;
  if (FDatabase <> nil) then
  begin
    FIndexInDatabase := FDatabase.AddFIBBase(Self);
    if (FTransaction = nil)
     and Assigned(Owner) and not CmpInLoadedState(TComponent(Owner))
    then
      Transaction := FDatabase.DefaultTransaction;
  end;
end;

procedure TFIBBase.SetTransaction(Value: TFIBTransaction);
begin
  if FTransaction=Value then
   Exit;
  if (FTransaction <> nil) then
    FTransaction.RemoveFIBBase(FIndexInTransaction);
  FTransaction := Value;
  if (FTransaction <> nil) then
  begin
    FIndexInTransaction := FTransaction.AddFIBBase(Self);
    if (FDatabase=nil) or  (FTransaction.FindDatabase(FDatabase)=-1) then
    begin
     if FTransaction.GetDatabaseCount>0 then
     begin
       Database:=FTransaction.MainDatabase
     end;
    end;
  end;
end;

procedure CleanDatabaseList;
var
  I: Integer;
begin
 with DatabaseList.LockList do
 try
  for I:=0 to Pred(Count) do
    TFIBDatabase(Items[I]).Close;
 finally
   DatabaseList.UnLockList;
   DatabaseList.Free;
   DatabaseList:=nil
 end;
end;
 
 
initialization
 DefDataBase :=nil;
 DatabaseList:=TThreadList.Create;
{$IFDEF FIBPLUS_TRIAL}
 {$IFNDEF LINUX}
  if FindWindow( 'TAppBuilder', nil ) <= 0 then
   ShowMessage( 'Thank you very much for evaluating FIBPlus.'#10#13#10#13 +
    'Please go to http://www.devrace.com and register today.'
   );
 {$ENDIF}
{$ENDIF}
finalization
 CleanDatabaseList  ;

end.
