ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/testsuite/Test1.pas
Revision: 308
Committed: Sat Jul 18 10:26:30 2020 UTC (3 years, 8 months ago) by tony
Content type: text/x-pascal
File size: 5725 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 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