fibdatabase.pas

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

   // 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
  CheckInactive;
  if FLibraryName<>LibName then
  begin
    FLibraryName  :=LibName;
    FClientLibrary:=nil;
    FClientLibLoaded := False;    
  end;
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 Assigned(FTimer) and FTimer.Enabled then
  begin
   FTimer.Enabled:=False;
   FTimer.Enabled:=True;
  end;
  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
 if not Assigned(FBlobFilters) then
  FBlobFilters     :=TIBBlobFilters.Create;
  
 FBlobFilters.RegisterBlobFilter(BlobSubType,EncodeProc,DecodeProc);
end;

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


procedure TFIBDatabase.IBFilterBuffer(var BlobBuffer:PChar;var BlobSize:longint;
                        BlobSubType:integer;ForEncode: boolean);
begin
 if Assigned(FBlobFilters) then
  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;
  FIsFireBirdConnect:=GetIsFirebirdConnect;
  if not  FIsFireBirdConnect then
   FIsIB2007Connect:=ServerMajorVersion>=8;

  if not FIsFireBirdConnect or (ServerMajorVersion<2) then
  begin
    FIsUnicodeConnect:=(FConnectParams.CharSet='UNICODE_FSS')
    or  (FConnectParams.CharSet='UTF8');
    FNeedUnicodeFieldsTranslation:=FIsUnicodeConnect
      or      (FConnectParams.CharSet='NONE') or     (FConnectParams.CharSet='')
      ;
    FNeedUTFDecodeDDL:=False;
{$IFDEF SUPPORT_KOI8_CHARSET}
    FIsKOI8Connect:=False;
{$ENDIF}
  end
  else
  begin
    FIsUnicodeConnect:=FBAttachCharsetID in UnicodeCharSets;
    FNeedUnicodeFieldsTranslation:=FIsUnicodeConnect
     or     (FBAttachCharsetID=0);
     ;

    if FNeedUnicodeFieldsTranslation then
    begin
     if (
      (GetServerMajorVersion>2) or ((GetServerMajorVersion=2) and (GetServerMinorVersion>=1))
       ) and ((GetODSMajorVersion>11) or ((GetODSMajorVersion=11) and (GetODSMinorVersion>=1)))
     then
      FNeedUTFDecodeDDL:=True
     else
      FNeedUTFDecodeDDL:=False
    end
    else
      FNeedUTFDecodeDDL:=False;

  {$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
    if not Connected then
     Break;
    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
  );

  FServerMajorVersion:=-1; // 碾