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

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 45 '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 tony 56 {$IFDEF DCC}
71     ByName('title').AsString := UTF8Encode('Blob Test ©€');
72     ByName('Notes').AsString := UTF8Encode('Écoute moi');
73     {$ELSE}
74 tony 45 ByName('title').AsString := 'Blob Test ©€';
75     ByName('Notes').AsString := 'Écoute moi';
76 tony 56 {$ENDIF}
77 tony 45 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 tony 56 function TTest12.TestTitle: AnsiString;
95 tony 45 begin
96     Result := 'Test 12: Character Sets';
97     end;
98    
99 tony 56 procedure TTest12.RunTest(CharSet: AnsiString; SQLDialect: integer);
100 tony 45 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