ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/testsuite/Test12.pas
Revision: 60
Committed: Mon Mar 27 15:21:02 2017 UTC (7 years ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/testsuite/Test12.pas
File size: 4580 byte(s)
Log Message:

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 'Primary Key(RowID)'+
50 ')';
51
52 sqlGetCharSets = 'Select RDB$CHARACTER_SET_NAME,RDB$CHARACTER_SET_ID from RDB$CHARACTER_SETS order by 2';
53
54 sqlInsert = 'Insert into TestData(RowID,Title,Notes, BlobData,BlobData2,InClear) Values(:RowID,:Title,:Notes,:BlobData,:BlobData2,:InClear)';
55
56
57 { TTest12 }
58
59 procedure TTest12.UpdateDatabase(Attachment: IAttachment);
60 var Transaction: ITransaction;
61 Statement: IStatement;
62 begin
63 Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
64
65 Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
66 ParamInfo(Statement.SQLParams);
67 with Statement.GetSQLParams do
68 begin
69 ByName('rowid').AsInteger := 1;
70 {$IFDEF DCC}
71 ByName('title').AsString := UTF8Encode('Blob Test ©€');
72 ByName('Notes').AsString := UTF8Encode('Écoute moi');
73 {$ELSE}
74 ByName('title').AsString := 'Blob Test ©€';
75 ByName('Notes').AsString := 'Écoute moi';
76 {$ENDIF}
77 ByName('BlobData').AsString := 'Some German Special Characters like ÖÄÜöäüß';
78 ByName('BlobData2').AsBlob := Attachment.CreateBlob(Transaction,'TestData','BlobData').SetString('Some German Special Characters like ÖÄÜöäüß');
79 ByName('InClear').AsString := #$01'Test'#$0D#$C3;
80 end;
81 Statement.Execute;
82 end;
83
84 procedure TTest12.QueryDatabase(Attachment: IAttachment);
85 var Transaction: ITransaction;
86 Statement: IStatement;
87 ResultSet: IResultSet;
88 begin
89 Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
90 Statement := Attachment.Prepare(Transaction,'Select * from TestData');
91 ReportResults(Statement);
92 end;
93
94 function TTest12.TestTitle: AnsiString;
95 begin
96 Result := 'Test 12: Character Sets';
97 end;
98
99 procedure TTest12.RunTest(CharSet: AnsiString; SQLDialect: integer);
100 var DPB: IDPB;
101 Attachment: IAttachment;
102 begin
103 FHexStrings := true;
104 DPB := FirebirdAPI.AllocateDPB;
105 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
106 DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
107 DPB.Add(isc_dpb_lc_ctype).setAsString('UTF8');
108 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
109 Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
110 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
111
112 UpdateDatabase(Attachment);
113
114 writeln(OutFile,'Connection Character Set UTF8');
115 {Query with UTF8}
116 QueryDatabase(Attachment);
117 Attachment.Disconnect;
118
119 writeln(OutFile,'Connection Character Set NONE');
120 {Query with No character set}
121 DPB := FirebirdAPI.AllocateDPB;
122 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
123 DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
124 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
125 Attachment := FirebirdAPI.OpenDatabase(Owner.GetNewDatabaseName,DPB);
126 QueryDatabase(Attachment);
127 Attachment.Disconnect;
128
129 writeln(OutFile,'Connection Character Set WIN1252');
130 {Query with WIN1252}
131 DPB := FirebirdAPI.AllocateDPB;
132 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
133 DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
134 DPB.Add(isc_dpb_lc_ctype).setAsString('WIN1252');
135 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
136 Attachment := FirebirdAPI.OpenDatabase(Owner.GetNewDatabaseName,DPB);
137 QueryDatabase(Attachment);
138
139 Attachment.DropDatabase;
140
141 end;
142
143 initialization
144 RegisterTest(TTest12);
145 end.
146