fibdatabase.pas

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

{$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;
{$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(FTimer) then
   SetTimeOut(0);
// FTimer.Enabled:=False;
  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;