ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/testsuite/Test1.pas
Revision: 56
Committed: Mon Mar 6 10:20:02 2017 UTC (7 years, 9 months ago) by tony
Content type: text/x-pascal
File size: 3623 byte(s)
Log Message:
Committing updates for Trunk

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 {$ENDIF}
21
22 interface
23
24 uses
25 Classes, SysUtils, TestManager, IB;
26
27 type
28
29 { TTest1 }
30
31 TTest1 = class(TTestBase)
32 private
33 procedure DoQuery(Attachment: IAttachment);
34 public
35 function TestTitle: AnsiString; override;
36 procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
37 end;
38
39 implementation
40
41 { TTest1 }
42
43 procedure TTest1.DoQuery(Attachment: IAttachment);
44 var Transaction: ITransaction;
45 Statement: IStatement;
46 ResultSet: IResultSet;
47 i: integer;
48 begin
49 Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
50 Statement := Attachment.Prepare(Transaction,'Select * from RDB$Database',3);
51 ResultSet := Statement.OpenCursor;
52 ResultSet.SetRetainInterfaces(true);
53 try
54 while ResultSet.FetchNext do
55 begin
56 for i := 0 to ResultSet.getCount - 1 do
57 writeln(OutFile,ResultSet[i].Name,' = ',ResultSet[i].AsString);
58 end;
59 finally
60 ResultSet.Close;
61 ResultSet.SetRetainInterfaces(false);
62 end;
63 end;
64
65 function TTest1.TestTitle: AnsiString;
66 begin
67 Result := 'Test 1: Create and Drop a Database';
68 end;
69
70 procedure TTest1.RunTest(CharSet: AnsiString; SQLDialect: integer);
71 var DPB: IDPB;
72 Attachment: IAttachment;
73 createSQL: AnsiString;
74 begin
75 writeln(OutFile,'Creating a Database with empty parameters');
76 Attachment := FirebirdAPI.CreateDatabase('',nil,false);
77 if Attachment = nil then
78 writeln(OutFile,'Create Database fails (as expected): ',FirebirdAPI.GetStatus.GetMessage)
79 else
80 Attachment.DropDatabase;
81
82 writeln(OutFile,'Creating a Database using an SQL Statement');
83 createSQL := Format('CREATE DATABASE ''%s'' USER ''%s'' PASSWORD ''%s'' DEFAULT CHARACTER SET %s',
84 [Owner.GetNewDatabaseName, Owner.GetUserName, Owner.GetPassword, CharSet]);
85 Attachment := FirebirdAPI.CreateDatabase(createSQL,SQLDialect);
86 WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_db_SQL_Dialect]));
87
88 writeln(OutFile,'Dropping Database');
89 if Attachment <> nil then
90 Attachment.DropDatabase;
91
92 writeln(OutFile,'Creating a Database with a DPD');
93 DPB := FirebirdAPI.AllocateDPB;
94 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
95 DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
96 DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
97 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
98
99 Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
100
101 writeln(OutFile,'Dropping Database');
102 if Attachment <> nil then
103 Attachment.DropDatabase;
104
105 {Open Database}
106
107 PrintDPB(DPB);
108 writeln(OutFile,'Creating a Database with a DPD');
109 Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
110 if Attachment = nil then
111 begin
112 writeln(OutFile,'Create Database Failed');
113 Exit;
114 end;
115 WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version]));
116
117 {Querying Database}
118 DoQuery(Attachment);
119
120 writeln(OutFile,'Dropping Database');
121 Attachment.DropDatabase;
122 end;
123
124
125 initialization
126 RegisterTest(TTest1);
127
128 end.
129