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 |
procedure TransliterationTest; |
62 |
public |
63 |
function TestTitle: AnsiString; override; |
64 |
procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override; |
65 |
end; |
66 |
|
67 |
implementation |
68 |
|
69 |
uses IBUtils; |
70 |
|
71 |
const |
72 |
sqlCreateTable = |
73 |
'Create Table TestData ('+ |
74 |
'RowID Integer not null,'+ |
75 |
'Title VarChar(32) Character Set UTF8,'+ |
76 |
'Notes VarChar(64) Character Set ISO8859_1 collate FR_FR,'+ |
77 |
'BlobData Blob sub_type 1 Character Set WIN1252, '+ |
78 |
'BlobData2 Blob sub_type 1 Character Set UTF8, '+ |
79 |
'InClear VarChar(16) Character Set OCTETS, '+ |
80 |
'FixedWidth Char(4) Character set UTF8, '+ |
81 |
'Primary Key(RowID)'+ |
82 |
')'; |
83 |
|
84 |
sqlCreateException = 'Create Exception CharSetTest ''Some German Special Characters like ÖÄÜöäüß'''; |
85 |
|
86 |
sqlCreateProc = 'Create Procedure DoException As Begin Exception CharSetTest; End'; |
87 |
|
88 |
sqlGetCharSets = 'Select RDB$CHARACTER_SET_NAME,RDB$CHARACTER_SET_ID from RDB$CHARACTER_SETS order by 2'; |
89 |
|
90 |
sqlInsert = 'Insert into TestData(RowID,Title,Notes, BlobData,BlobData2,InClear,FixedWidth) '+ |
91 |
'Values(:RowID,:Title,:Notes,:BlobData,:BlobData2,:InClear,:FixedWidth)'; |
92 |
|
93 |
|
94 |
{ TTest12 } |
95 |
|
96 |
procedure TTest12.UpdateDatabase(Attachment: IAttachment); |
97 |
var Transaction: ITransaction; |
98 |
Statement: IStatement; |
99 |
begin |
100 |
Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit); |
101 |
|
102 |
Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert); |
103 |
ParamInfo(Statement.SQLParams); |
104 |
with Statement.GetSQLParams do |
105 |
begin |
106 |
ByName('rowid').AsInteger := 1; |
107 |
{$IFDEF DCC} |
108 |
ByName('title').AsString := UTF8Encode('Blob Test ©€'); |
109 |
ByName('Notes').AsString := UTF8Encode('Écoute moi'); |
110 |
ByName('FixedWidth').AsString := UTF8Encode('É'); |
111 |
{$ELSE} |
112 |
ByName('title').AsString := 'Blob Test ©€'; |
113 |
ByName('Notes').AsString := 'Écoute moi'; |
114 |
ByName('FixedWidth').AsString := 'É'; |
115 |
{$ENDIF} |
116 |
ByName('BlobData').AsString := 'Some German Special Characters like ÖÄÜöäüß'; |
117 |
ByName('BlobData2').AsBlob := Attachment.CreateBlob(Transaction,'TestData','BlobData').SetString('Some German Special Characters like ÖÄÜöäüß'); |
118 |
ByName('InClear').AsString := #$01'Test'#$0D#$C3; |
119 |
end; |
120 |
writeln(Outfile,'Show Param Values'); |
121 |
ParamInfo(Statement.SQLParams); |
122 |
Statement.Execute; |
123 |
end; |
124 |
|
125 |
procedure TTest12.QueryDatabase(Attachment: IAttachment); |
126 |
var Transaction: ITransaction; |
127 |
Statement: IStatement; |
128 |
ResultSet: IResultSet; |
129 |
begin |
130 |
Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit); |
131 |
Statement := Attachment.Prepare(Transaction,'Select * from TestData'); |
132 |
ReportResults(Statement); |
133 |
write(Outfile,'Test Exception Message = '); |
134 |
PrintHexString(Attachment.OpenCursorAtStart(Transaction,'Select RDB$MESSAGE From RDB$EXCEPTIONS Where RDB$EXCEPTION_NAME = ''CHARSETTEST''',[])[0].AsString); |
135 |
writeln(OutFile); |
136 |
try |
137 |
Attachment.ExecuteSQL([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],'Execute Procedure DoException',[]); |
138 |
except On E:Exception do |
139 |
writeln(Outfile,'Exception returned: ',E.Message); |
140 |
end; |
141 |
end; |
142 |
|
143 |
procedure TTest12.TransliterationTest; |
144 |
const |
145 |
Win1252Test1: UTF8String = 'WIN1252 Characters ÖÄÜöäüß'; |
146 |
Win1252Test2: UTF8String = 'Я Écoute moi'; |
147 |
|
148 |
var |
149 |
str: AnsiString; |
150 |
begin |
151 |
writeln(Outfile,'Transliteration Tests'); |
152 |
writeln(Outfile,'Default System Code Page = ',DefaultSystemCodePage); |
153 |
writeln(Outfile,'Actual System Code Page = ',FBGetSystemCodePage); |
154 |
writeln(Outfile,'Input String = ', Win1252Test1,', Character Set = ',StringCodePage(Win1252Test1),' Hex Values:'); |
155 |
PrintHexString(Win1252Test1); |
156 |
writeln(OutFile); |
157 |
str := TransliterateToCodePage(Win1252Test1,1252); |
158 |
writeln(Outfile,'Code Page = ',StringCodePage(str)); |
159 |
PrintHexString(str); |
160 |
writeln(OutFile); |
161 |
writeln(Outfile,'Back to UTF8'); |
162 |
str := TransliterateToCodePage(str,CP_UTF8); |
163 |
writeln(Outfile,'Code Page = ',StringCodePage(str)); |
164 |
writeln(Outfile,str); |
165 |
PrintHexString(str); |
166 |
writeln(OutFile); |
167 |
writeln(Outfile,'ANSI(1252) to ANSI(1251) Test'); |
168 |
writeln(Outfile,'Input String = ', Win1252Test2,', Character Set = ',StringCodePage(Win1252Test2),' Hex Values:'); |
169 |
PrintHexString(Win1252Test2); |
170 |
writeln(OutFile); |
171 |
str := TransliterateToCodePage(Win1252Test2,1251); |
172 |
writeln(Outfile,'After conversion to 1251'); |
173 |
writeln(Outfile,'Code Page = ',StringCodePage(str)); |
174 |
PrintHexString(str); |
175 |
writeln(OutFile); |
176 |
writeln(Outfile,'Now Transliterate to WIN1252'); |
177 |
str := TransliterateToCodePage(str,1252); |
178 |
writeln(Outfile,'Code Page = ',StringCodePage(str)); |
179 |
PrintHexString(str); |
180 |
writeln(OutFile); |
181 |
end; |
182 |
|
183 |
function TTest12.TestTitle: AnsiString; |
184 |
begin |
185 |
Result := 'Test 12: Character Sets'; |
186 |
end; |
187 |
|
188 |
procedure TTest12.RunTest(CharSet: AnsiString; SQLDialect: integer); |
189 |
var DPB: IDPB; |
190 |
Attachment: IAttachment; |
191 |
begin |
192 |
TransliterationTest; |
193 |
FHexStrings := true; |
194 |
DPB := FirebirdAPI.AllocateDPB; |
195 |
DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName); |
196 |
DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword); |
197 |
DPB.Add(isc_dpb_lc_ctype).setAsString('UTF8'); |
198 |
DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect); |
199 |
Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB); |
200 |
Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable); |
201 |
Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateException); |
202 |
Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateProc); |
203 |
Attachment.Disconnect; |
204 |
|
205 |
{Query with UTF8} |
206 |
DPB := FirebirdAPI.AllocateDPB; |
207 |
DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName); |
208 |
DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword); |
209 |
DPB.Add(isc_dpb_lc_ctype).setAsString('UTF8'); |
210 |
Attachment := FirebirdAPI.OpenDatabase(Owner.GetNewDatabaseName,DPB); |
211 |
UpdateDatabase(Attachment); |
212 |
|
213 |
writeln(OutFile,'Connection Character Set UTF8'); |
214 |
QueryDatabase(Attachment); |
215 |
Attachment.Disconnect; |
216 |
|
217 |
writeln(OutFile,'Connection Character Set NONE'); |
218 |
{Query with No character set} |
219 |
DPB := FirebirdAPI.AllocateDPB; |
220 |
DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName); |
221 |
DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword); |
222 |
Attachment := FirebirdAPI.OpenDatabase(Owner.GetNewDatabaseName,DPB); |
223 |
QueryDatabase(Attachment); |
224 |
Attachment.Disconnect; |
225 |
|
226 |
writeln(OutFile,'Connection Character Set WIN1252'); |
227 |
{Query with WIN1252} |
228 |
DPB := FirebirdAPI.AllocateDPB; |
229 |
DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName); |
230 |
DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword); |
231 |
DPB.Add(isc_dpb_lc_ctype).setAsString('WIN1252'); |
232 |
Attachment := FirebirdAPI.OpenDatabase(Owner.GetNewDatabaseName,DPB); |
233 |
QueryDatabase(Attachment); |
234 |
|
235 |
Attachment.DropDatabase; |
236 |
|
237 |
writeln(Outfile,'Recreate Database with WIN1252 as the connection character set'); |
238 |
DPB := FirebirdAPI.AllocateDPB; |
239 |
DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName); |
240 |
DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword); |
241 |
DPB.Add(isc_dpb_lc_ctype).setAsString('WIN1252'); |
242 |
DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect); |
243 |
Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB); |
244 |
Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable); |
245 |
Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateException); |
246 |
Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateProc); |
247 |
Attachment.Disconnect; |
248 |
|
249 |
writeln(OutFile,'Query Database with UTF8, NONE and WIN1252 connections'); |
250 |
|
251 |
{Query with UTF8} |
252 |
DPB := FirebirdAPI.AllocateDPB; |
253 |
DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName); |
254 |
DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword); |
255 |
DPB.Add(isc_dpb_lc_ctype).setAsString('UTF8'); |
256 |
Attachment := FirebirdAPI.OpenDatabase(Owner.GetNewDatabaseName,DPB); |
257 |
UpdateDatabase(Attachment); |
258 |
|
259 |
writeln(OutFile,'Connection Character Set UTF8'); |
260 |
QueryDatabase(Attachment); |
261 |
Attachment.Disconnect; |
262 |
|
263 |
writeln(OutFile,'Connection Character Set NONE'); |
264 |
{Query with No character set} |
265 |
DPB := FirebirdAPI.AllocateDPB; |
266 |
DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName); |
267 |
DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword); |
268 |
Attachment := FirebirdAPI.OpenDatabase(Owner.GetNewDatabaseName,DPB); |
269 |
QueryDatabase(Attachment); |
270 |
Attachment.Disconnect; |
271 |
|
272 |
writeln(OutFile,'Connection Character Set WIN1252'); |
273 |
{Query with WIN1252} |
274 |
DPB := FirebirdAPI.AllocateDPB; |
275 |
DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName); |
276 |
DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword); |
277 |
DPB.Add(isc_dpb_lc_ctype).setAsString('WIN1252'); |
278 |
Attachment := FirebirdAPI.OpenDatabase(Owner.GetNewDatabaseName,DPB); |
279 |
QueryDatabase(Attachment); |
280 |
|
281 |
Attachment.DropDatabase; |
282 |
|
283 |
end; |
284 |
|
285 |
initialization |
286 |
RegisterTest(TTest12); |
287 |
end. |
288 |
|