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