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;
  writeln(Outfile,'Show Param Values');
  ParamInfo(Statement.SQLParams);
  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:	380
Committed:	Mon Jan 10 10:13:17 2022 UTC (2 years, 11 months ago) by tony
Content type:	text/x-pascal
File size:	5836 byte(s)
Log Message:	propset for eol-style
#	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