ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/testsuite/Test12.pas
Revision: 379
Committed: Mon Jan 10 10:08:03 2022 UTC (2 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 5836 byte(s)
Log Message:
set line ending property

File Contents

# User Rev Content
1 tony 315 (*
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 tony 56 {$IFDEF MSWINDOWS}
31     {$DEFINE WINDOWS}
32     {$ENDIF}
33 tony 45
34 tony 56 {$IFDEF FPC}
35     {$mode delphi}
36 tony 45
37     {$codepage UTF8}
38 tony 56 {$ENDIF}
39 tony 45
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 tony 315 Classes, SysUtils, TestApplication, FBTestApp, IB;
52 tony 45
53     type
54    
55     { TTest12 }
56    
57 tony 315 TTest12 = class(TFBTestBase)
58 tony 45 private
59     procedure UpdateDatabase(Attachment: IAttachment);
60     procedure QueryDatabase(Attachment: IAttachment);
61     public
62 tony 56 function TestTitle: AnsiString; override;
63     procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
64 tony 45 end;
65    
66     implementation
67    
68     const
69     sqlCreateTable =
70     'Create Table TestData ('+
71     'RowID Integer not null,'+
72     'Title VarChar(32) Character Set UTF8,'+
73 tony 60 'Notes VarChar(64) Character Set ISO8859_1 collate FR_FR,'+
74 tony 45 'BlobData Blob sub_type 1 Character Set WIN1252, '+
75     'BlobData2 Blob sub_type 1 Character Set UTF8, '+
76 tony 47 'InClear VarChar(16) Character Set OCTETS, '+
77 tony 309 'FixedWidth Char(4) Character set UTF8, '+
78 tony 45 'Primary Key(RowID)'+
79     ')';
80    
81     sqlGetCharSets = 'Select RDB$CHARACTER_SET_NAME,RDB$CHARACTER_SET_ID from RDB$CHARACTER_SETS order by 2';
82    
83 tony 309 sqlInsert = 'Insert into TestData(RowID,Title,Notes, BlobData,BlobData2,InClear,FixedWidth) '+
84     'Values(:RowID,:Title,:Notes,:BlobData,:BlobData2,:InClear,:FixedWidth)';
85 tony 45
86    
87     { TTest12 }
88    
89     procedure TTest12.UpdateDatabase(Attachment: IAttachment);
90     var Transaction: ITransaction;
91     Statement: IStatement;
92     begin
93     Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
94    
95     Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
96     ParamInfo(Statement.SQLParams);
97     with Statement.GetSQLParams do
98     begin
99     ByName('rowid').AsInteger := 1;
100 tony 56 {$IFDEF DCC}
101     ByName('title').AsString := UTF8Encode('Blob Test ©€');
102     ByName('Notes').AsString := UTF8Encode('Écoute moi');
103 tony 315 ByName('FixedWidth').AsString := UTF8Encode('É');
104 tony 56 {$ELSE}
105 tony 45 ByName('title').AsString := 'Blob Test ©€';
106     ByName('Notes').AsString := 'Écoute moi';
107 tony 315 ByName('FixedWidth').AsString := 'É';
108 tony 56 {$ENDIF}
109 tony 45 ByName('BlobData').AsString := 'Some German Special Characters like ÖÄÜöäüß';
110     ByName('BlobData2').AsBlob := Attachment.CreateBlob(Transaction,'TestData','BlobData').SetString('Some German Special Characters like ÖÄÜöäüß');
111     ByName('InClear').AsString := #$01'Test'#$0D#$C3;
112     end;
113 tony 345 writeln(Outfile,'Show Param Values');
114     ParamInfo(Statement.SQLParams);
115 tony 45 Statement.Execute;
116     end;
117    
118     procedure TTest12.QueryDatabase(Attachment: IAttachment);
119     var Transaction: ITransaction;
120     Statement: IStatement;
121     ResultSet: IResultSet;
122     begin
123     Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
124     Statement := Attachment.Prepare(Transaction,'Select * from TestData');
125     ReportResults(Statement);
126     end;
127    
128 tony 56 function TTest12.TestTitle: AnsiString;
129 tony 45 begin
130     Result := 'Test 12: Character Sets';
131     end;
132    
133 tony 56 procedure TTest12.RunTest(CharSet: AnsiString; SQLDialect: integer);
134 tony 45 var DPB: IDPB;
135     Attachment: IAttachment;
136     begin
137     FHexStrings := true;
138     DPB := FirebirdAPI.AllocateDPB;
139     DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
140     DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
141     DPB.Add(isc_dpb_lc_ctype).setAsString('UTF8');
142     DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
143     Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
144     Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
145    
146     UpdateDatabase(Attachment);
147    
148     writeln(OutFile,'Connection Character Set UTF8');
149     {Query with UTF8}
150     QueryDatabase(Attachment);
151     Attachment.Disconnect;
152    
153     writeln(OutFile,'Connection Character Set NONE');
154     {Query with No character set}
155     DPB := FirebirdAPI.AllocateDPB;
156     DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
157     DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
158     DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
159     Attachment := FirebirdAPI.OpenDatabase(Owner.GetNewDatabaseName,DPB);
160     QueryDatabase(Attachment);
161     Attachment.Disconnect;
162    
163     writeln(OutFile,'Connection Character Set WIN1252');
164     {Query with WIN1252}
165     DPB := FirebirdAPI.AllocateDPB;
166     DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
167     DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
168     DPB.Add(isc_dpb_lc_ctype).setAsString('WIN1252');
169     DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
170     Attachment := FirebirdAPI.OpenDatabase(Owner.GetNewDatabaseName,DPB);
171     QueryDatabase(Attachment);
172    
173     Attachment.DropDatabase;
174    
175     end;
176    
177     initialization
178     RegisterTest(TTest12);
179     end.
180    

Properties

Name Value
svn:eol-style native