ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/testsuite/Test1.pas
Revision: 120
Committed: Mon Jan 22 13:58:20 2018 UTC (6 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 5227 byte(s)
Log Message:
Fixes Merged

File Contents

# 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 public
36 function TestTitle: AnsiString; override;
37 procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
38 end;
39
40 implementation
41
42 { TTest1 }
43
44 procedure TTest1.DoQuery(Attachment: IAttachment);
45 var Transaction: ITransaction;
46 Statement: IStatement;
47 ResultSet: IResultSet;
48 i: integer;
49 begin
50 Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
51 Statement := Attachment.Prepare(Transaction,'Select * from RDB$Database',3);
52 ResultSet := Statement.OpenCursor;
53 ResultSet.SetRetainInterfaces(true);
54 try
55 while ResultSet.FetchNext do
56 begin
57 for i := 0 to ResultSet.getCount - 1 do
58 writeln(OutFile,ResultSet[i].Name,' = ',ResultSet[i].AsString);
59 end;
60 finally
61 ResultSet.Close;
62 ResultSet.SetRetainInterfaces(false);
63 end;
64 end;
65
66 function TTest1.TestTitle: AnsiString;
67 begin
68 Result := 'Test 1: Create and Drop a Database';
69 end;
70
71 procedure TTest1.RunTest(CharSet: AnsiString; SQLDialect: integer);
72 var DPB: IDPB;
73 Attachment: IAttachment;
74 createSQL: AnsiString;
75 begin
76 writeln(OutFile,'Creating a Database with empty parameters');
77 Attachment := FirebirdAPI.CreateDatabase('',nil,false);
78 if Attachment = nil then
79 writeln(OutFile,'Create Database fails (as expected): ',FirebirdAPI.GetStatus.GetMessage)
80 else
81 Attachment.DropDatabase;
82
83 writeln(OutFile,'Creating a Database using an SQL Statement');
84 createSQL := Format('create database ''%s'' USER ''%s'' PASSWORD ''%s'' DEFAULT CHARACTER SET %s',
85 [Owner.GetNewDatabaseName, Owner.GetUserName, Owner.GetPassword, CharSet]);
86 Attachment := FirebirdAPI.CreateDatabase(createSQL,SQLDialect);
87 WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_db_SQL_Dialect]));
88 writeln(outfile,'DB Connect String = ',Attachment.GetConnectString);
89 writeln(outfile,'DB Charset ID = ',Attachment.GetDefaultCharSetID);
90 writeln(outfile,'DB SQL Dialect = ',Attachment.GetSQLDialect);
91 writeln(outfile,'DB Remote Protocol = ', Attachment.GetRemoteProtocol);
92 writeln(outfile,'DB ODS Major Version = ',Attachment.GetODSMajorVersion);
93 writeln(outfile,'DB ODS Minor Version = ',Attachment.GetODSMinorVersion);
94 PrintDPB(Attachment.getDPB);
95
96 {$IFDEF HASREQEX}
97 {Demonstrate reconnect when database created with SQL Statement}
98 try
99 Attachment.Disconnect;
100 Attachment.Connect;
101 except on E:Exception do
102 writeln(OutFile,'Error reconnecting to Database: ',E.Message);
103 end;
104 {$ENDIF}
105
106 writeln(OutFile,'Dropping Database');
107 if Attachment <> nil then
108 Attachment.DropDatabase;
109
110 writeln(OutFile,'Creating a Database with a DPD');
111 DPB := FirebirdAPI.AllocateDPB;
112 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
113 DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
114 DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
115 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
116
117 Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
118
119 writeln(outfile,'DB Connect String = ',Attachment.GetConnectString);
120 writeln(outfile,'DB Charset ID = ',Attachment.GetDefaultCharSetID);
121 writeln(outfile,'DB SQL Dialect = ',Attachment.GetSQLDialect);
122 writeln(outfile,'DB Remote Protocol = ', Attachment.GetRemoteProtocol);
123 writeln(outfile,'DB ODS Major Version = ',Attachment.GetODSMajorVersion);
124 writeln(outfile,'DB ODS Minor Version = ',Attachment.GetODSMinorVersion);
125
126 writeln(OutFile,'Dropping Database');
127 if Attachment <> nil then
128 Attachment.DropDatabase;
129
130 {Open Database}
131
132 PrintDPB(DPB);
133 writeln(OutFile,'Creating a Database with a DPD');
134 Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
135 if Attachment = nil then
136 begin
137 writeln(OutFile,'Create Database Failed');
138 Exit;
139 end;
140 WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version]));
141 writeln(outfile,'DB Connect String = ',Attachment.GetConnectString);
142 writeln(outfile,'DB Charset ID = ',Attachment.GetDefaultCharSetID);
143 writeln(outfile,'DB SQL Dialect = ',Attachment.GetSQLDialect);
144 writeln(outfile,'DB Remote Protocol = ', Attachment.GetRemoteProtocol);
145 writeln(outfile,'DB ODS Major Version = ',Attachment.GetODSMajorVersion);
146 writeln(outfile,'DB ODS Minor Version = ',Attachment.GetODSMinorVersion);
147
148 {Querying Database}
149 DoQuery(Attachment);
150
151 writeln(OutFile,'Dropping Database');
152 Attachment.DropDatabase;
153 end;
154
155
156 initialization
157 RegisterTest(TTest1);
158
159 end.
160