ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/testsuite/Test12.pas
Revision: 396
Committed: Thu Feb 17 11:57:23 2022 UTC (4 months, 2 weeks ago) by tony
File size: 5714 byte(s)
Log Message:
Remove set sql dialect from clone attachment
Line File contents
1 (*
2 * Firebird Interface (fbintf) Test suite. This program is used to
3 * test the Firebird Pascal Interface and provide a semi-automated
4 * pass/fail check for each test.
5 *
6 * The contents of this file are subject to the Initial Developer's
7 * Public License Version 1.0 (the "License"); you may not use this
8 * file except in compliance with the License. You may obtain a copy
9 * of the License here:
10 *
11 * http://www.firebirdsql.org/index.php?op=doc&id=idpl
12 *
13 * Software distributed under the License is distributed on an "AS
14 * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
15 * implied. See the License for the specific language governing rights
16 * and limitations under the License.
17 *
18 * The Initial Developer of the Original Code is Tony Whyman.
19 *
20 * The Original Code is (C) 2016 Tony Whyman, MWA Software
21 * (http://www.mwasoftware.co.uk).
22 *
23 * All Rights Reserved.
24 *
25 * Contributor(s): ______________________________________.
26 *
27 *)
28
29 unit Test12;
30 {$IFDEF MSWINDOWS}
31 {$DEFINE WINDOWS}
32 {$ENDIF}
33
34 {$IFDEF FPC}
35 {$mode delphi}
36
37 {$codepage UTF8}
38 {$ENDIF}
39
40 interface
41
42 { Test 12: Character Sets
43
44 This test creates strings in a database with various code pages and then
45 reads them back with different connection character sets. The result is
46 displayed as hex strings so that the actual encoding can be checked in
47 each case.
48 }
49
50 uses
51 Classes, SysUtils, TestApplication, FBTestApp, IB;
52
53 type
54
55 { TTest12 }
56
57 TTest12 = class(TFBTestBase)
58 private
59 procedure UpdateDatabase(Attachment: IAttachment);
60 procedure QueryDatabase(Attachment: IAttachment);
61 public
62 function TestTitle: AnsiString; override;
63 procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
64 end;
65
66 implementation
67
68 const
69 sqlCreateTable =
70 'Create Table TestData ('+
71 'RowID Integer not null,'+
72 'Title VarChar(32) Character Set UTF8,'+
73 'Notes VarChar(64) Character Set ISO8859_1 collate FR_FR,'+
74 'BlobData Blob sub_type 1 Character Set WIN1252, '+
75 'BlobData2 Blob sub_type 1 Character Set UTF8, '+
76 'InClear VarChar(16) Character Set OCTETS, '+
77 'FixedWidth Char(4) Character set UTF8, '+
78 'Primary Key(RowID)'+
79 ')';
80
81 sqlGetCharSets = 'Select RDB$CHARACTER_SET_NAME,RDB$CHARACTER_SET_ID from RDB$CHARACTER_SETS order by 2';
82
83 sqlInsert = 'Insert into TestData(RowID,Title,Notes, BlobData,BlobData2,InClear,FixedWidth) '+
84 'Values(:RowID,:Title,:Notes,:BlobData,:BlobData2,:InClear,:FixedWidth)';
85
86
87 { TTest12 }
88
89 procedure TTest12.UpdateDatabase(Attachment: IAttachment);
90 var Transaction: ITransaction;
91 Statement: IStatement;
92 begin
93 Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
94
95 Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
96 ParamInfo(Statement.SQLParams);
97 with Statement.GetSQLParams do
98 begin
99 ByName('rowid').AsInteger := 1;
100 {$IFDEF DCC}
101 ByName('title').AsString := UTF8Encode('Blob Test ©€');
102 ByName('Notes').AsString := UTF8Encode('Écoute moi');
103 ByName('FixedWidth').AsString := UTF8Encode('É');
104 {$ELSE}
105 ByName('title').AsString := 'Blob Test ©€';
106 ByName('Notes').AsString := 'Écoute moi';
107 ByName('FixedWidth').AsString := 'É';
108 {$ENDIF}
109 ByName('BlobData').AsString := 'Some German Special Characters like ÖÄÜöäüß';
110 ByName('BlobData2').AsBlob := Attachment.CreateBlob(Transaction,'TestData','BlobData').SetString('Some German Special Characters like ÖÄÜöäüß');
111 ByName('InClear').AsString := #$01'Test'#$0D#$C3;
112 end;
113 writeln(Outfile,'Show Param Values');
114 ParamInfo(Statement.SQLParams);
115 Statement.Execute;
116 end;
117
118 procedure TTest12.QueryDatabase(Attachment: IAttachment);
119 var Transaction: ITransaction;
120 Statement: IStatement;
121 ResultSet: IResultSet;
122 begin
123 Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
124 Statement := Attachment.Prepare(Transaction,'Select * from TestData');
125 ReportResults(Statement);
126 end;
127
128 function TTest12.TestTitle: AnsiString;
129 begin
130 Result := 'Test 12: Character Sets';
131 end;
132
133 procedure TTest12.RunTest(CharSet: AnsiString; SQLDialect: integer);
134 var DPB: IDPB;
135 Attachment: IAttachment;
136 begin
137 FHexStrings := true;
138 DPB := FirebirdAPI.AllocateDPB;
139 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
140 DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
141 DPB.Add(isc_dpb_lc_ctype).setAsString('UTF8');
142 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
143 Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
144 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
145
146 UpdateDatabase(Attachment);
147
148 writeln(OutFile,'Connection Character Set UTF8');
149 {Query with UTF8}
150 QueryDatabase(Attachment);
151 Attachment.Disconnect;
152
153 writeln(OutFile,'Connection Character Set NONE');
154 {Query with No character set}
155 DPB := FirebirdAPI.AllocateDPB;
156 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
157 DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
158 Attachment := FirebirdAPI.OpenDatabase(Owner.GetNewDatabaseName,DPB);
159 QueryDatabase(Attachment);
160 Attachment.Disconnect;
161
162 writeln(OutFile,'Connection Character Set WIN1252');
163 {Query with WIN1252}
164 DPB := FirebirdAPI.AllocateDPB;
165 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
166 DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
167 DPB.Add(isc_dpb_lc_ctype).setAsString('WIN1252');
168 Attachment := FirebirdAPI.OpenDatabase(Owner.GetNewDatabaseName,DPB);
169 QueryDatabase(Attachment);
170
171 Attachment.DropDatabase;
172
173 end;
174
175 initialization
176 RegisterTest(TTest12);
177 end.
178

Properties

Name Value
svn:eol-style native