Devart Forums

Code: Select all

CREATE DATABASE 'C:\ProgramData\mydb\PA.fdb'
USER 'SYSDBA' PASSWORD 'masterkey'
PAGE_SIZE 16384
default character set UTF8 collation UNICODE_CI_AI ;

Code: Select all

---------------------------
Debugger Exception Notification
---------------------------
Project App.exe raised exception class EIBCError with message 'I/O error during "CreateFile (open)" operation for file "C:\PROGRAMDATA\MYDB\PA.FDB"
Error while trying to open file
The system cannot find the file specified. '.
---------------------------
Break   Continue   Help   
---------------------------

Code: Select all

procedure TForm1.Button1Click(Sender: TObject);
begin
  UniConnection1.Server := 'localhost';
  UniConnection1.Username := 'sysdba';
  UniConnection1.Password := 'masterkey';
  UniConnection1.LoginPrompt := False;

  UniScript1.Connection := UniConnection1;
  UniScript1.NoPreconnect := True;
  UniScript1.SQL.Text := ' CREATE DATABASE ''C:\ProgramData\mydb\PA.fdb'' ' +
                         ' USER ''SYSDBA'' ' +
                         ' PASSWORD ''masterkey'' ' +
                         ' PAGE_SIZE 16384 ' +
                         ' default character set UTF8 ' +
                         ' collation UNICODE_CI_AI;';
  UniScript1.Execute;
end;

Code: Select all

type
  [TestFixture]
  TFirebirdFixture = class(TObject)
  private
    FCon: TUniConnection;
    FUniScript: TUniScript;
    FDbFiles : TArray<string>;
    const CRLF = #13#10;
  public
    [SetupFixture]
    procedure SetupFixture;
    [TearDownFixture]
    procedure TearDownFixture;
    /// <summary>
    ///   Third time since 2014 that db creation failed, someone is NOT testing.
    /// </summary>
    [Test]
    [TestCase('Embedded (No Pooling)',   ',.\NoPooling.fdb,SYSDBA,masterkey,False')]
    [TestCase('Embedded (With Pooling)', ',.\WithPooling.fdb,SYSDBA,masterkey,True')]
    procedure TestDbCreation(const AServer, AFileName, AUser, APwd: string; const AWithPooling: Boolean);
  end;

implementation


procedure TFirebirdFixture.SetupFixture;
begin
  FCon := TUniConnection.Create(nil);
  FCon.ProviderName      := InterBaseUniProvider.TInterBaseUniProvider.GetProviderName;
  FCon.PoolingOptions.MinPoolSize := 4;
  FCon.PoolingOptions.MaxPoolSize := 100;
  FUniScript             := TUniScript.Create(FCon);
  FUniScript.Connection  := FCon;
  FUniScript.Transaction := FCon.DefaultTransaction;
end;

procedure TFirebirdFixture.TearDownFixture;
var LFileName : string;
begin
  FCon.Free;
  for LFileName in FDbFiles do DeleteFile(LFileName);
end;

procedure TFirebirdFixture.TestDbCreation(const AServer, AFileName, AUser, APwd: string; const AWithPooling: Boolean);
const script = 'CREATE DATABASE :Filename' + CRLF +
               'USER :User PASSWORD :Pwd' + CRLF +
               'PAGE_SIZE 16384' + CRLF +
               'default character set UTF8 collation UNICODE_CI_AI ;';
var LFileName : string;
begin
  if AServer.IsEmpty then begin
      LFileName := ExpandFileName(AFileName);
  end else LFileName := AFileName;
  // Will ignore non rooted files
  if FileExists(LFileName) then Assert.IsTrue(DeleteFile(LFileName), 'Unable to create the DB, it already exists and cannot be deleted.');

  FCon.Server   := AServer;
  FCon.Pooling  := AWithPooling;
  FUniScript.NoPreconnect := True; // executes DDL without connecting to an existing db
  FUniScript.SQL.Text := script;
  FUniScript.SQL.ReplaceParams([LFileName, AUser, APwd]); << You'll need to replace this
  Assert.WillNotRaiseAny(procedure begin FUniScript.Execute; end);
  FDbFiles := FDbFiles + [LFileName];
end;

initialization
  TDUnitX.RegisterTestFixture(TFirebirdFixture);
end.