fbintf/testsuite/Test12.pas

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, TestManager, IB;

type

  { TTest12 }

  TTest12 = class(TTestBase)
  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');
    {$ELSE}
    ByName('title').AsString := 'Blob Test ©€';
    ByName('Notes').AsString := 'Écoute moi';
    {$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:	309
Committed:	Tue Jul 21 08:00:42 2020 UTC (4 years, 4 months ago) by tony
Content type:	text/x-pascal
File size:	4711 byte(s)
Log Message:	Fixes Merged
#	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	309	'FixedWidth Char(4) Character set UTF8, '+
50	tony	45	'Primary Key(RowID)'+
51			')';
52
53			sqlGetCharSets = 'Select RDB$CHARACTER_SET_NAME,RDB$CHARACTER_SET_ID from RDB$CHARACTER_SETS order by 2';
54
55	tony	309	sqlInsert = 'Insert into TestData(RowID,Title,Notes, BlobData,BlobData2,InClear,FixedWidth) '+
56			'Values(:RowID,:Title,:Notes,:BlobData,:BlobData2,:InClear,:FixedWidth)';
57	tony	45
58
59			{ TTest12 }
60
61			procedure TTest12.UpdateDatabase(Attachment: IAttachment);
62			var Transaction: ITransaction;
63			Statement: IStatement;
64			begin
65			Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
66
67			Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
68			ParamInfo(Statement.SQLParams);
69			with Statement.GetSQLParams do
70			begin
71			ByName('rowid').AsInteger := 1;
72	tony	56	{$IFDEF DCC}
73			ByName('title').AsString := UTF8Encode('Blob Test ©€');
74			ByName('Notes').AsString := UTF8Encode('Écoute moi');
75			{$ELSE}
76	tony	45	ByName('title').AsString := 'Blob Test ©€';
77			ByName('Notes').AsString := 'Écoute moi';
78	tony	56	{$ENDIF}
79	tony	45	ByName('BlobData').AsString := 'Some German Special Characters like ÖÄÜöäüß';
80			ByName('BlobData2').AsBlob := Attachment.CreateBlob(Transaction,'TestData','BlobData').SetString('Some German Special Characters like ÖÄÜöäüß');
81			ByName('InClear').AsString := #$01'Test'#$0D#$C3;
82	tony	309	ByName('FixedWidth').AsString := 'É';
83	tony	45	end;
84			Statement.Execute;
85			end;
86
87			procedure TTest12.QueryDatabase(Attachment: IAttachment);
88			var Transaction: ITransaction;
89			Statement: IStatement;
90			ResultSet: IResultSet;
91			begin
92			Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
93			Statement := Attachment.Prepare(Transaction,'Select * from TestData');
94			ReportResults(Statement);
95			end;
96
97	tony	56	function TTest12.TestTitle: AnsiString;
98	tony	45	begin
99			Result := 'Test 12: Character Sets';
100			end;
101
102	tony	56	procedure TTest12.RunTest(CharSet: AnsiString; SQLDialect: integer);
103	tony	45	var DPB: IDPB;
104			Attachment: IAttachment;
105			begin
106			FHexStrings := true;
107			DPB := FirebirdAPI.AllocateDPB;
108			DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
109			DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
110			DPB.Add(isc_dpb_lc_ctype).setAsString('UTF8');
111			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
112			Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
113			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
114
115			UpdateDatabase(Attachment);
116
117			writeln(OutFile,'Connection Character Set UTF8');
118			{Query with UTF8}
119			QueryDatabase(Attachment);
120			Attachment.Disconnect;
121
122			writeln(OutFile,'Connection Character Set NONE');
123			{Query with No character set}
124			DPB := FirebirdAPI.AllocateDPB;
125			DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
126			DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
127			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
128			Attachment := FirebirdAPI.OpenDatabase(Owner.GetNewDatabaseName,DPB);
129			QueryDatabase(Attachment);
130			Attachment.Disconnect;
131
132			writeln(OutFile,'Connection Character Set WIN1252');
133			{Query with WIN1252}
134			DPB := FirebirdAPI.AllocateDPB;
135			DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
136			DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
137			DPB.Add(isc_dpb_lc_ctype).setAsString('WIN1252');
138			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
139			Attachment := FirebirdAPI.OpenDatabase(Owner.GetNewDatabaseName,DPB);
140			QueryDatabase(Attachment);
141
142			Attachment.DropDatabase;
143
144			end;
145
146			initialization
147			RegisterTest(TTest12);
148			end.
149