ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/testsuite/Test12.pas
Revision: 309
Committed: Tue Jul 21 08:00:42 2020 UTC (4 years, 4 months ago) by tony
Content type: text/x-pascal
File size: 4711 byte(s)
Log Message:
Fixes Merged

File Contents

# Content
1 unit Test12;
2 {$IFDEF MSWINDOWS}
3 {$DEFINE WINDOWS}
4 {$ENDIF}
5
6 {$IFDEF FPC}
7 {$mode delphi}
8
9 {$codepage UTF8}
10 {$ENDIF}
11
12 interface
13
14 { Test 12: Character Sets
15
16 This test creates strings in a database with various code pages and then
17 reads them back with different connection character sets. The result is
18 displayed as hex strings so that the actual encoding can be checked in
19 each case.
20 }
21
22 uses
23 Classes, SysUtils, TestManager, IB;
24
25 type
26
27 { TTest12 }
28
29 TTest12 = class(TTestBase)
30 private
31 procedure UpdateDatabase(Attachment: IAttachment);
32 procedure QueryDatabase(Attachment: IAttachment);
33 public
34 function TestTitle: AnsiString; override;
35 procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
36 end;
37
38 implementation
39
40 const
41 sqlCreateTable =
42 'Create Table TestData ('+
43 'RowID Integer not null,'+
44 'Title VarChar(32) Character Set UTF8,'+
45 'Notes VarChar(64) Character Set ISO8859_1 collate FR_FR,'+
46 'BlobData Blob sub_type 1 Character Set WIN1252, '+
47 'BlobData2 Blob sub_type 1 Character Set UTF8, '+
48 'InClear VarChar(16) Character Set OCTETS, '+
49 'FixedWidth Char(4) Character set UTF8, '+
50 'Primary Key(RowID)'+
51 ')';
52
53 sqlGetCharSets = 'Select RDB$CHARACTER_SET_NAME,RDB$CHARACTER_SET_ID from RDB$CHARACTER_SETS order by 2';
54
55 sqlInsert = 'Insert into TestData(RowID,Title,Notes, BlobData,BlobData2,InClear,FixedWidth) '+
56 'Values(:RowID,:Title,:Notes,:BlobData,:BlobData2,:InClear,:FixedWidth)';
57
58
59 { TTest12 }
60
61 procedure TTest12.UpdateDatabase(Attachment: IAttachment);
62 var Transaction: ITransaction;
63 Statement: IStatement;
64 begin
65 Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
66
67 Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
68 ParamInfo(Statement.SQLParams);
69 with Statement.GetSQLParams do
70 begin
71 ByName('rowid').AsInteger := 1;
72 {$IFDEF DCC}
73 ByName('title').AsString := UTF8Encode('Blob Test ©€');
74 ByName('Notes').AsString := UTF8Encode('Écoute moi');
75 {$ELSE}
76 ByName('title').AsString := 'Blob Test ©€';
77 ByName('Notes').AsString := 'Écoute moi';
78 {$ENDIF}
79 ByName('BlobData').AsString := 'Some German Special Characters like ÖÄÜöäüß';
80 ByName('BlobData2').AsBlob := Attachment.CreateBlob(Transaction,'TestData','BlobData').SetString('Some German Special Characters like ÖÄÜöäüß');
81 ByName('InClear').AsString := #$01'Test'#$0D#$C3;
82 ByName('FixedWidth').AsString := 'É';
83 end;
84 Statement.Execute;
85 end;
86
87 procedure TTest12.QueryDatabase(Attachment: IAttachment);
88 var Transaction: ITransaction;
89 Statement: IStatement;
90 ResultSet: IResultSet;
91 begin
92 Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
93 Statement := Attachment.Prepare(Transaction,'Select * from TestData');
94 ReportResults(Statement);
95 end;
96
97 function TTest12.TestTitle: AnsiString;
98 begin
99 Result := 'Test 12: Character Sets';
100 end;
101
102 procedure TTest12.RunTest(CharSet: AnsiString; SQLDialect: integer);
103 var DPB: IDPB;
104 Attachment: IAttachment;
105 begin
106 FHexStrings := true;
107 DPB := FirebirdAPI.AllocateDPB;
108 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
109 DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
110 DPB.Add(isc_dpb_lc_ctype).setAsString('UTF8');
111 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
112 Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
113 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
114
115 UpdateDatabase(Attachment);
116
117 writeln(OutFile,'Connection Character Set UTF8');
118 {Query with UTF8}
119 QueryDatabase(Attachment);
120 Attachment.Disconnect;
121
122 writeln(OutFile,'Connection Character Set NONE');
123 {Query with No character set}
124 DPB := FirebirdAPI.AllocateDPB;
125 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
126 DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
127 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
128 Attachment := FirebirdAPI.OpenDatabase(Owner.GetNewDatabaseName,DPB);
129 QueryDatabase(Attachment);
130 Attachment.Disconnect;
131
132 writeln(OutFile,'Connection Character Set WIN1252');
133 {Query with WIN1252}
134 DPB := FirebirdAPI.AllocateDPB;
135 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
136 DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
137 DPB.Add(isc_dpb_lc_ctype).setAsString('WIN1252');
138 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
139 Attachment := FirebirdAPI.OpenDatabase(Owner.GetNewDatabaseName,DPB);
140 QueryDatabase(Attachment);
141
142 Attachment.DropDatabase;
143
144 end;
145
146 initialization
147 RegisterTest(TTest12);
148 end.
149