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

File Contents

# User Rev Content
1 tony 56 unit Test12;
2     {$IFDEF MSWINDOWS}
3     {$DEFINE WINDOWS}
4     {$ENDIF}
5 tony 45
6 tony 56 {$IFDEF FPC}
7     {$mode delphi}
8 tony 45
9     {$codepage UTF8}
10 tony 56 {$ENDIF}
11 tony 45
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 tony 56 function TestTitle: AnsiString; override;
35     procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
36 tony 45 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 tony 60 'Notes VarChar(64) Character Set ISO8859_1 collate FR_FR,'+
46 tony 45 'BlobData Blob sub_type 1 Character Set WIN1252, '+
47     'BlobData2 Blob sub_type 1 Character Set UTF8, '+
48 tony 47 'InClear VarChar(16) Character Set OCTETS, '+
49 tony 309 'FixedWidth Char(4) Character set UTF8, '+
50 tony 45 '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 tony 309 sqlInsert = 'Insert into TestData(RowID,Title,Notes, BlobData,BlobData2,InClear,FixedWidth) '+
56     'Values(:RowID,:Title,:Notes,:BlobData,:BlobData2,:InClear,:FixedWidth)';
57 tony 45
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 tony 56 {$IFDEF DCC}
73     ByName('title').AsString := UTF8Encode('Blob Test ©€');
74     ByName('Notes').AsString := UTF8Encode('Écoute moi');
75     {$ELSE}
76 tony 45 ByName('title').AsString := 'Blob Test ©€';
77     ByName('Notes').AsString := 'Écoute moi';
78 tony 56 {$ENDIF}
79 tony 45 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 tony 309 ByName('FixedWidth').AsString := 'É';
83 tony 45 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 tony 56 function TTest12.TestTitle: AnsiString;
98 tony 45 begin
99     Result := 'Test 12: Character Sets';
100     end;
101    
102 tony 56 procedure TTest12.RunTest(CharSet: AnsiString; SQLDialect: integer);
103 tony 45 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