fbintf/testsuite/Test1.pas

unit Test1;
{$IFDEF MSWINDOWS} 
{$DEFINE WINDOWS} 
{$ENDIF}

{Create and Drop a Database}
{
 This test first attempts to create a database without specifying any parameters
 (should fail). It then goes on to create and drop a database, print out the
 parameters and then creates it again (will fail if the dropdatabase failed silently.

 Some basic database info is then accessed and printed.

 A basic query is performed and finally the database dropped.
}

{$IFDEF FPC}
{$mode delphi}
{$codepage utf8}
{$define HASREQEX}
{$ENDIF}

interface

uses
  Classes, SysUtils, TestManager, IB;

type

  { TTest1 }

  TTest1 = class(TTestBase)
  private
    procedure DoQuery(Attachment: IAttachment);
    procedure WriteAttachmentInfo(Attachment: IAttachment);
  public
    function TestTitle: AnsiString; override;
    procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
  end;

implementation

{ TTest1 }

procedure TTest1.DoQuery(Attachment: IAttachment);
var Transaction: ITransaction;
    Statement: IStatement;
    ResultSet: IResultSet;
    i: integer;
begin
    Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
    Statement := Attachment.Prepare(Transaction,'Select * from RDB$Database',3);
    ResultSet := Statement.OpenCursor;
    ResultSet.SetRetainInterfaces(true);
    try
      while ResultSet.FetchNext do
      begin
        for i := 0 to ResultSet.getCount - 1 do
          writeln(OutFile,ResultSet[i].Name,' = ',Trim(ResultSet[i].AsString));
      end;
    finally
      ResultSet.Close;
      ResultSet.SetRetainInterfaces(false);
    end;
end;

procedure TTest1.WriteAttachmentInfo(Attachment: IAttachment);
begin
  writeln(outfile,'DB Connect String = ',Attachment.GetConnectString);
  writeln(outfile,'DB Charset ID = ',Attachment.GetDefaultCharSetID);
  writeln(outfile,'DB SQL Dialect = ',Attachment.GetSQLDialect);
  writeln(outfile,'DB Remote Protocol = ', Attachment.GetRemoteProtocol);
  writeln(outfile,'DB ODS Major Version = ',Attachment.GetODSMajorVersion);
  writeln(outfile,'DB ODS Minor Version = ',Attachment.GetODSMinorVersion);
  writeln(outfile,'User Authentication Method = ',Attachment.GetAuthenticationMethod);
  writeln(outfile,'Firebird Library Path = ',Attachment.getFirebirdAPI.GetFBLibrary.GetLibraryFilePath);
  writeln(outfile,'DB Client Implementation Version = ',Attachment.getFirebirdAPI.GetImplementationVersion);
end;

function TTest1.TestTitle: AnsiString;
begin
  Result := 'Test 1: Create and Drop a Database';
end;

procedure TTest1.RunTest(CharSet: AnsiString; SQLDialect: integer);
var DPB: IDPB;
    Attachment: IAttachment;
    createSQL: AnsiString;
    libpath: string;
    FBLibrary: IFirebirdLibrary;
begin
  writeln(OutFile,'Creating a Database with empty parameters');
  Attachment := FirebirdAPI.CreateDatabase('',nil,false);
  if Attachment = nil then
    writeln(OutFile,'Create Database fails (as expected): ',FirebirdAPI.GetStatus.GetMessage)
  else
    Attachment.DropDatabase;

  writeln(OutFile,'Creating a Database using an SQL Statement');
  createSQL := Format('create database ''%s'' USER ''%s'' PASSWORD ''%s'' DEFAULT CHARACTER SET %s',
                      [ExtractDBName(Owner.GetNewDatabaseName), Owner.GetUserName, Owner.GetPassword, CharSet]);
  Attachment := FirebirdAPI.CreateDatabase(createSQL,SQLDialect);
  WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_db_SQL_Dialect]));
  WriteAttachmentInfo(Attachment);
  PrintDPB(Attachment.getDPB);

  {$IFDEF HASREQEX}
  {Demonstrate reconnect when database created with SQL Statement}
  try
    Attachment.Disconnect;
    Attachment.Connect;
  except on E:Exception do
    writeln(OutFile,'Error reconnecting to Database: ',E.Message);
  end;
  {$ENDIF}

  writeln(OutFile,'Dropping Database');
  if Attachment <> nil then
    Attachment.DropDatabase;

  writeln(OutFile,'Creating a Database with a DPD');
  DPB := FirebirdAPI.AllocateDPB;
  DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
  DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
  DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
  DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);

  Attachment := FirebirdAPI.CreateDatabase(ExtractDBName(Owner.GetNewDatabaseName),DPB);

  WriteAttachmentInfo(Attachment);

  writeln(OutFile,'Dropping Database');
  if Attachment <> nil then
    Attachment.DropDatabase;

  {Open Database}

  PrintDPB(DPB);
  writeln(OutFile,'Creating a Database with a DPD');
  Attachment := FirebirdAPI.CreateDatabase(ExtractDBName(Owner.GetNewDatabaseName),DPB);
  if Attachment = nil then
  begin
    writeln(OutFile,'Create Database Failed');
    Exit;
  end;
  WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version]));
  WriteAttachmentInfo(Attachment);

  {Querying Database}
  DoQuery(Attachment);

  writeln(OutFile,'Dropping Database');
  Attachment.DropDatabase;

  libpath := GetEnvironmentVariable('TESTFIREBIRDLIBRARY');
  if libpath <> '' then
  begin
    FBLibrary := LoadFBLibrary(libpath);

    writeln(OutFile,'Creating a Database with a DPD using Firebird Library in ',libpath);
    Attachment := FBLibrary.GetFirebirdAPI.CreateDatabase(ExtractDBName(Owner.GetNewDatabaseName),DPB);
    if Attachment = nil then
    begin
      writeln(OutFile,'Create Database Failed');
      Exit;
    end;
    WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version]));
    WriteAttachmentInfo(Attachment);

    {Querying Database}
    DoQuery(Attachment);

    writeln(OutFile,'Dropping Database');
    Attachment.DropDatabase;
  end;
end;


initialization
  RegisterTest(TTest1);

end.

Revision:	308
Committed:	Sat Jul 18 10:26:30 2020 UTC (4 years, 5 months ago) by tony
Content type:	text/x-pascal
File size:	5725 byte(s)
Log Message:	Fixes Merged
#	Content
1	unit Test1;
2	{$IFDEF MSWINDOWS}
3	{$DEFINE WINDOWS}
4	{$ENDIF}
5
6	{Create and Drop a Database}
7	{
8	This test first attempts to create a database without specifying any parameters
9	(should fail). It then goes on to create and drop a database, print out the
10	parameters and then creates it again (will fail if the dropdatabase failed silently.
11
12	Some basic database info is then accessed and printed.
13
14	A basic query is performed and finally the database dropped.
15	}
16
17	{$IFDEF FPC}
18	{$mode delphi}
19	{$codepage utf8}
20	{$define HASREQEX}
21	{$ENDIF}
22
23	interface
24
25	uses
26	Classes, SysUtils, TestManager, IB;
27
28	type
29
30	{ TTest1 }
31
32	TTest1 = class(TTestBase)
33	private
34	procedure DoQuery(Attachment: IAttachment);
35	procedure WriteAttachmentInfo(Attachment: IAttachment);
36	public
37	function TestTitle: AnsiString; override;
38	procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
39	end;
40
41	implementation
42
43	{ TTest1 }
44
45	procedure TTest1.DoQuery(Attachment: IAttachment);
46	var Transaction: ITransaction;
47	Statement: IStatement;
48	ResultSet: IResultSet;
49	i: integer;
50	begin
51	Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
52	Statement := Attachment.Prepare(Transaction,'Select * from RDB$Database',3);
53	ResultSet := Statement.OpenCursor;
54	ResultSet.SetRetainInterfaces(true);
55	try
56	while ResultSet.FetchNext do
57	begin
58	for i := 0 to ResultSet.getCount - 1 do
59	writeln(OutFile,ResultSet[i].Name,' = ',Trim(ResultSet[i].AsString));
60	end;
61	finally
62	ResultSet.Close;
63	ResultSet.SetRetainInterfaces(false);
64	end;
65	end;
66
67	procedure TTest1.WriteAttachmentInfo(Attachment: IAttachment);
68	begin
69	writeln(outfile,'DB Connect String = ',Attachment.GetConnectString);
70	writeln(outfile,'DB Charset ID = ',Attachment.GetDefaultCharSetID);
71	writeln(outfile,'DB SQL Dialect = ',Attachment.GetSQLDialect);
72	writeln(outfile,'DB Remote Protocol = ', Attachment.GetRemoteProtocol);
73	writeln(outfile,'DB ODS Major Version = ',Attachment.GetODSMajorVersion);
74	writeln(outfile,'DB ODS Minor Version = ',Attachment.GetODSMinorVersion);
75	writeln(outfile,'User Authentication Method = ',Attachment.GetAuthenticationMethod);
76	writeln(outfile,'Firebird Library Path = ',Attachment.getFirebirdAPI.GetFBLibrary.GetLibraryFilePath);
77	writeln(outfile,'DB Client Implementation Version = ',Attachment.getFirebirdAPI.GetImplementationVersion);
78	end;
79
80	function TTest1.TestTitle: AnsiString;
81	begin
82	Result := 'Test 1: Create and Drop a Database';
83	end;
84
85	procedure TTest1.RunTest(CharSet: AnsiString; SQLDialect: integer);
86	var DPB: IDPB;
87	Attachment: IAttachment;
88	createSQL: AnsiString;
89	libpath: string;
90	FBLibrary: IFirebirdLibrary;
91	begin
92	writeln(OutFile,'Creating a Database with empty parameters');
93	Attachment := FirebirdAPI.CreateDatabase('',nil,false);
94	if Attachment = nil then
95	writeln(OutFile,'Create Database fails (as expected): ',FirebirdAPI.GetStatus.GetMessage)
96	else
97	Attachment.DropDatabase;
98
99	writeln(OutFile,'Creating a Database using an SQL Statement');
100	createSQL := Format('create database ''%s'' USER ''%s'' PASSWORD ''%s'' DEFAULT CHARACTER SET %s',
101	[ExtractDBName(Owner.GetNewDatabaseName), Owner.GetUserName, Owner.GetPassword, CharSet]);
102	Attachment := FirebirdAPI.CreateDatabase(createSQL,SQLDialect);
103	WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_db_SQL_Dialect]));
104	WriteAttachmentInfo(Attachment);
105	PrintDPB(Attachment.getDPB);
106
107	{$IFDEF HASREQEX}
108	{Demonstrate reconnect when database created with SQL Statement}
109	try
110	Attachment.Disconnect;
111	Attachment.Connect;
112	except on E:Exception do
113	writeln(OutFile,'Error reconnecting to Database: ',E.Message);
114	end;
115	{$ENDIF}
116
117	writeln(OutFile,'Dropping Database');
118	if Attachment <> nil then
119	Attachment.DropDatabase;
120
121	writeln(OutFile,'Creating a Database with a DPD');
122	DPB := FirebirdAPI.AllocateDPB;
123	DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
124	DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
125	DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
126	DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
127
128	Attachment := FirebirdAPI.CreateDatabase(ExtractDBName(Owner.GetNewDatabaseName),DPB);
129
130	WriteAttachmentInfo(Attachment);
131
132	writeln(OutFile,'Dropping Database');
133	if Attachment <> nil then
134	Attachment.DropDatabase;
135
136	{Open Database}
137
138	PrintDPB(DPB);
139	writeln(OutFile,'Creating a Database with a DPD');
140	Attachment := FirebirdAPI.CreateDatabase(ExtractDBName(Owner.GetNewDatabaseName),DPB);
141	if Attachment = nil then
142	begin
143	writeln(OutFile,'Create Database Failed');
144	Exit;
145	end;
146	WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version]));
147	WriteAttachmentInfo(Attachment);
148
149	{Querying Database}
150	DoQuery(Attachment);
151
152	writeln(OutFile,'Dropping Database');
153	Attachment.DropDatabase;
154
155	libpath := GetEnvironmentVariable('TESTFIREBIRDLIBRARY');
156	if libpath <> '' then
157	begin
158	FBLibrary := LoadFBLibrary(libpath);
159
160	writeln(OutFile,'Creating a Database with a DPD using Firebird Library in ',libpath);
161	Attachment := FBLibrary.GetFirebirdAPI.CreateDatabase(ExtractDBName(Owner.GetNewDatabaseName),DPB);
162	if Attachment = nil then
163	begin
164	writeln(OutFile,'Create Database Failed');
165	Exit;
166	end;
167	WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version]));
168	WriteAttachmentInfo(Attachment);
169
170	{Querying Database}
171	DoQuery(Attachment);
172
173	writeln(OutFile,'Dropping Database');
174	Attachment.DropDatabase;
175	end;
176	end;
177
178
179	initialization
180	RegisterTest(TTest1);
181
182	end.
183