fbintf/testsuite/Test12.pas

(*
 *  Firebird Interface (fbintf) Test suite. This program is used to
 *  test the Firebird Pascal Interface and provide a semi-automated
 *  pass/fail check for each test.
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2016 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)

unit Test12;
{$IFDEF MSWINDOWS} 
{$DEFINE WINDOWS} 
{$ENDIF}

{$IFDEF FPC}
{$mode delphi}

{$codepage UTF8}
{$ENDIF}

interface

{ Test 12: Character Sets

  This test creates strings in a database with various code pages and then
  reads them back with different connection character sets. The result is
  displayed as hex strings so that the actual encoding can be checked in
  each case.
}

uses
  Classes, SysUtils, TestApplication, FBTestApp, IB;

type

  { TTest12 }

  TTest12 = class(TFBTestBase)
  private
    procedure UpdateDatabase(Attachment: IAttachment);
    procedure QueryDatabase(Attachment: IAttachment);
  public
    function TestTitle: AnsiString; override;
    procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
  end;

implementation

const
  sqlCreateTable =
    'Create Table TestData ('+
    'RowID Integer not null,'+
    'Title VarChar(32) Character Set UTF8,'+
    'Notes VarChar(64) Character Set ISO8859_1 collate FR_FR,'+
    'BlobData Blob sub_type 1 Character Set WIN1252, '+
    'BlobData2 Blob sub_type 1 Character Set UTF8, '+
    'InClear VarChar(16) Character Set OCTETS, '+
    'FixedWidth Char(4) Character set UTF8, '+
    'Primary Key(RowID)'+
    ')';

  sqlGetCharSets = 'Select RDB$CHARACTER_SET_NAME,RDB$CHARACTER_SET_ID from RDB$CHARACTER_SETS order by 2';

  sqlInsert = 'Insert into TestData(RowID,Title,Notes, BlobData,BlobData2,InClear,FixedWidth) '+
              'Values(:RowID,:Title,:Notes,:BlobData,:BlobData2,:InClear,:FixedWidth)';


{ TTest12 }

procedure TTest12.UpdateDatabase(Attachment: IAttachment);
var Transaction: ITransaction;
    Statement: IStatement;
begin
  Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);

  Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
  ParamInfo(Statement.SQLParams);
  with Statement.GetSQLParams do
  begin
    ByName('rowid').AsInteger := 1;
    {$IFDEF DCC}
    ByName('title').AsString := UTF8Encode('Blob Test ©€');
    ByName('Notes').AsString := UTF8Encode('Écoute moi');
    ByName('FixedWidth').AsString := UTF8Encode('É');
    {$ELSE}
    ByName('title').AsString := 'Blob Test ©€';
    ByName('Notes').AsString := 'Écoute moi';
    ByName('FixedWidth').AsString := 'É';
    {$ENDIF}
    ByName('BlobData').AsString := 'Some German Special Characters like ÖÄÜöäüß';
    ByName('BlobData2').AsBlob := Attachment.CreateBlob(Transaction,'TestData','BlobData').SetString('Some German Special Characters like ÖÄÜöäüß');
    ByName('InClear').AsString := #$01'Test'#$0D#$C3;
  end;
  Statement.Execute;
end;

procedure TTest12.QueryDatabase(Attachment: IAttachment);
var Transaction: ITransaction;
    Statement: IStatement;
    ResultSet: IResultSet;
begin
  Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
  Statement := Attachment.Prepare(Transaction,'Select * from TestData');
  ReportResults(Statement);
end;

function TTest12.TestTitle: AnsiString;
begin
  Result := 'Test 12: Character Sets';
end;

procedure TTest12.RunTest(CharSet: AnsiString; SQLDialect: integer);
var DPB: IDPB;
    Attachment: IAttachment;
begin
  FHexStrings := true;
  DPB := FirebirdAPI.AllocateDPB;
  DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
  DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
  DPB.Add(isc_dpb_lc_ctype).setAsString('UTF8');
  DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
  Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
  Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);

  UpdateDatabase(Attachment);

  writeln(OutFile,'Connection Character Set UTF8');
  {Query with UTF8}
  QueryDatabase(Attachment);
  Attachment.Disconnect;

  writeln(OutFile,'Connection Character Set NONE');
  {Query with No character set}
  DPB := FirebirdAPI.AllocateDPB;
  DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
  DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
  DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
  Attachment := FirebirdAPI.OpenDatabase(Owner.GetNewDatabaseName,DPB);
  QueryDatabase(Attachment);
  Attachment.Disconnect;

  writeln(OutFile,'Connection Character Set WIN1252');
  {Query with WIN1252}
  DPB := FirebirdAPI.AllocateDPB;
  DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
  DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
  DPB.Add(isc_dpb_lc_ctype).setAsString('WIN1252');
  DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
  Attachment := FirebirdAPI.OpenDatabase(Owner.GetNewDatabaseName,DPB);
  QueryDatabase(Attachment);

  Attachment.DropDatabase;

end;

initialization
  RegisterTest(TTest12);
end.

Revision:	341
Committed:	Wed Jul 7 13:11:53 2021 UTC (3 years, 5 months ago) by tony
Content type:	text/x-pascal
File size:	5762 byte(s)
Log Message:	Fixed Merged
#	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			Statement.Execute;
114			end;
115
116			procedure TTest12.QueryDatabase(Attachment: IAttachment);
117			var Transaction: ITransaction;
118			Statement: IStatement;
119			ResultSet: IResultSet;
120			begin
121			Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
122			Statement := Attachment.Prepare(Transaction,'Select * from TestData');
123			ReportResults(Statement);
124			end;
125
126	tony	56	function TTest12.TestTitle: AnsiString;
127	tony	45	begin
128			Result := 'Test 12: Character Sets';
129			end;
130
131	tony	56	procedure TTest12.RunTest(CharSet: AnsiString; SQLDialect: integer);
132	tony	45	var DPB: IDPB;
133			Attachment: IAttachment;
134			begin
135			FHexStrings := true;
136			DPB := FirebirdAPI.AllocateDPB;
137			DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
138			DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
139			DPB.Add(isc_dpb_lc_ctype).setAsString('UTF8');
140			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
141			Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
142			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
143
144			UpdateDatabase(Attachment);
145
146			writeln(OutFile,'Connection Character Set UTF8');
147			{Query with UTF8}
148			QueryDatabase(Attachment);
149			Attachment.Disconnect;
150
151			writeln(OutFile,'Connection Character Set NONE');
152			{Query with No character set}
153			DPB := FirebirdAPI.AllocateDPB;
154			DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
155			DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
156			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
157			Attachment := FirebirdAPI.OpenDatabase(Owner.GetNewDatabaseName,DPB);
158			QueryDatabase(Attachment);
159			Attachment.Disconnect;
160
161			writeln(OutFile,'Connection Character Set WIN1252');
162			{Query with WIN1252}
163			DPB := FirebirdAPI.AllocateDPB;
164			DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
165			DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
166			DPB.Add(isc_dpb_lc_ctype).setAsString('WIN1252');
167			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
168			Attachment := FirebirdAPI.OpenDatabase(Owner.GetNewDatabaseName,DPB);
169			QueryDatabase(Attachment);
170
171			Attachment.DropDatabase;
172
173			end;
174
175			initialization
176			RegisterTest(TTest12);
177			end.
178