fbintf/testsuite/Test1.pas

unit Test1;
{$IFDEF MSWINDOWS} 
{$DEFINE WINDOWS} 
{$IF defined(CompilerVersion) and (CompilerVersion >= 28)}
{Delphi XE7 onwards}}
{$define HASREQEX}
{$IFEND}
{$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);
  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,' = ',ResultSet[i].AsString);
      end;
    finally
      ResultSet.Close;
      ResultSet.SetRetainInterfaces(false);
    end;
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;
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',
                      [Owner.GetNewDatabaseName, Owner.GetUserName, Owner.GetPassword, CharSet]);
  Attachment := FirebirdAPI.CreateDatabase(createSQL,SQLDialect);
  WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_db_SQL_Dialect]));
  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);
  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(Owner.GetNewDatabaseName,DPB);

  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,'Dropping Database');
  if Attachment <> nil then
    Attachment.DropDatabase;

  {Open Database}

  PrintDPB(DPB);
  writeln(OutFile,'Creating a Database with a DPD');
  Attachment := FirebirdAPI.CreateDatabase(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]));
  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);

  {Querying Database}
  DoQuery(Attachment);

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


initialization
  RegisterTest(TTest1);

end.

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