udr/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, '+
    '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) Values(:RowID,:Title,:Notes,:BlobData,:BlobData2,:InClear)';


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