fibdatabase.pas

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

//    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;
{$IFDEF CSMonitor}
    property CSMonitorSupport: TCSMonitorSupport read FCSMonitorSupport  write SetCSMonitorSupport;
{$ENDIF}

  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;

var
    vConnectCS: TRTLCriticalSection;  

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;
{$IFDEF CSMonitor}
  FCSMonitorSupport := TCSMonitorSupport.Create(Self);
{$ENDIF}  

  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;
  vInternalTransaction.TimeoutAction:=taCommit;
  vInternalTransaction.Timeout      :=1000;
  
  with vInternalTransaction.TRParams do
  begin
   Text:='write'+#13#10+
         'isc_tpb_nowait'+#13#10+
         'read_committed'+#13#10+
         'rec_version'+#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
{$IFDEF CSMonitor}
  FCSMonitorSupport.Free;
{$ENDIF}

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