// Загрузить клиентскую библиотеку Firebird
function LoadFBLib(const Path: string): Boolean;
const
  LibString = 'IBServer';
var
  iLib: IGDSLibrary;
  tmpLibString: String;
begin
  tmpLibString := LibString;
  iLib := GetGDSLibrary(tmpLibString);
  iLib.SetLibraryPath(Path + FB_DLL);
  Result := iLib.TryIBLoad;
end;

procedure TestDB;
const
  TransParamsRO = 'wait;read;read_committed;rec_version';
var
  db: TIBDatabase;
  q: TIBSQL; 
begin
  if not LoadFBLib('') then
    raise Err('Load fail %s %s', [FBLibPath, LastErrMsg]);
  try
    db:= TIBDatabase.Create(nil);
    db.LoginPrompt := False;
    db.ServerType := 'IBServer';
    db.Params.Values[DPBConstantNames[isc_dpb_lc_ctype]] := 'UTF8';
    db.DatabaseName := 'localhost:someDB';
    db.Params.Values[DPBConstantNames[isc_dpb_user_name]] := 'SYSDBA';
    db.Params.Values[DPBConstantNames[isc_dpb_password]] := 'masterkey';
    db.Connected := True;

    q := TIBSQL.Create(nil);
    q.Database := DB;
    q.Transaction := TIBTransaction.Create(q);
    q.Transaction.Params.Delimiter := ';';
    q.Transaction.DefaultAction := TARollback; // Для всех транзакций - откат в случае неполадок
    q.Transaction.DefaultDatabase := q.Database;
    q.SQL.Text := 'select CURRENT_USER from Rdb$Database;';
    q.Transaction.Params.DelimitedText := TransParamsRO;
    q.Transaction.StartTransaction;
    q.ExecQuery; // ! BOOM
    q.Transaction.Commit;
  finally
    if (q <> nil) and q.Transaction.InTransaction then
      q.Transaction.Rollback;
    FreeAndNil(q);
    FreeAndNil(db);
  end;
end;

Posted via ActualForum NNTP Server 1.5

Posted via ActualForum NNTP Server 1.5

Posted via ActualForum NNTP Server 1.5

Posted via ActualForum NNTP Server 1.5

procedure AddLib;
var
  LLib: IGDSLibrary;
begin
  LLib := TFBServerLibrary.Create;
  AddIBInterface(CFBServerType, LLib);
  LLib := TFBEmbeddedLibrary.Create;
  AddIBInterface(CFBEmpeddedServerType, LLib);
end;

initialization
  AddLib;

finalization
  IBClientInterface.Remove(CFBServerType);
  IBClientInterface.Remove(CFBEmpeddedServerType);

end.

type
  TIBDatabaseSelectionEditor = class(TSelectionEditor)
  public
    procedure RequiresUnits(AProc: TGetStrProc); override;
  end;

{ TIBDatabaseSelectionEditor }

procedure TIBDatabaseSelectionEditor.RequiresUnits(AProc: TGetStrProc);
var
  Li: Integer;
  LDB: TIBDatabase;
begin
  for Li := 0 to Designer.Root.ComponentCount - 1 do begin
    if Designer.Root.Components[Li] is TIBDatabase then begin
      LDB := TIBDatabase(Designer.Root.Components[Li]);
      if (LDB.ServerType = CFBServerType) or (LDB.ServerType = CFBEmpeddedServerType) then begin
        AProc('UFBIntfImpl');
        Exit;
      end;
    end;
  end;
end;

procedure Register;
begin
  RegisterSelectionEditor(TIBDatabase, TIBDatabaseSelectionEditor);
end;

procedure TIBServerLibrary.SetLibraryPath(const Path: string);
begin
  FLibPath := Path;
end;

function TIBServerLibrary.LibraryName: String;
begin
  // empty custom path - use default filename
  if FLibPath = '' then
    Result := IBASE_DLL
  // custom path is directory - add default filename
  else if DirectoryExists(FLibPath) then
    Result := IncludeTrailingPathDelimiter(FLibPath) + IBASE_DLL
  // full custom path - use it
  else
    Result := FLibPath;
end;

Posted via ActualForum NNTP Server 1.5