fbintf/testsuite/Test12.pas

unit Test12;

{$mode objfpc}{$H+}

{$codepage UTF8}

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: string; override;
    procedure RunTest(CharSet: string; 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,'+
    '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;
    ByName('title').AsString := 'Blob Test ©€';
    ByName('Notes').AsString := 'Écoute moi';
    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: string;
begin
  Result := 'Test 12: Character Sets';
end;

procedure TTest12.RunTest(CharSet: string; 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:	47
Committed:	Mon Jan 9 15:31:51 2017 UTC (7 years, 11 months ago) by tony
Content type:	text/x-pascal
File size:	4318 byte(s)
Log Message:	Committing updates for Release R2-0-1
#	User	Rev	Content
1	tony	45	unit Test12;
2
3			{$mode objfpc}{$H+}
4
5			{$codepage UTF8}
6
7			interface
8
9			{ Test 12: Character Sets
10
11			This test creates strings in a database with various code pages and then
12			reads them back with different connection character sets. The result is
13			displayed as hex strings so that the actual encoding can be checked in
14			each case.
15			}
16
17			uses
18			Classes, SysUtils, TestManager, IB;
19
20			type
21
22			{ TTest12 }
23
24			TTest12 = class(TTestBase)
25			private
26			procedure UpdateDatabase(Attachment: IAttachment);
27			procedure QueryDatabase(Attachment: IAttachment);
28			public
29			function TestTitle: string; override;
30			procedure RunTest(CharSet: string; SQLDialect: integer); override;
31			end;
32
33			implementation
34
35			const
36			sqlCreateTable =
37			'Create Table TestData ('+
38			'RowID Integer not null,'+
39			'Title VarChar(32) Character Set UTF8,'+
40			'Notes VarChar(64) Character Set ISO8859_1,'+
41			'BlobData Blob sub_type 1 Character Set WIN1252, '+
42			'BlobData2 Blob sub_type 1 Character Set UTF8, '+
43	tony	47	'InClear VarChar(16) Character Set OCTETS, '+
44	tony	45	'Primary Key(RowID)'+
45			')';
46
47			sqlGetCharSets = 'Select RDB$CHARACTER_SET_NAME,RDB$CHARACTER_SET_ID from RDB$CHARACTER_SETS order by 2';
48
49			sqlInsert = 'Insert into TestData(RowID,Title,Notes, BlobData,BlobData2,InClear) Values(:RowID,:Title,:Notes,:BlobData,:BlobData2,:InClear)';
50
51
52			{ TTest12 }
53
54			procedure TTest12.UpdateDatabase(Attachment: IAttachment);
55			var Transaction: ITransaction;
56			Statement: IStatement;
57			begin
58			Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
59
60			Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
61			ParamInfo(Statement.SQLParams);
62			with Statement.GetSQLParams do
63			begin
64			ByName('rowid').AsInteger := 1;
65			ByName('title').AsString := 'Blob Test ©€';
66			ByName('Notes').AsString := 'Écoute moi';
67			ByName('BlobData').AsString := 'Some German Special Characters like ÖÄÜöäüß';
68			ByName('BlobData2').AsBlob := Attachment.CreateBlob(Transaction,'TestData','BlobData').SetString('Some German Special Characters like ÖÄÜöäüß');
69			ByName('InClear').AsString := #$01'Test'#$0D#$C3;
70			end;
71			Statement.Execute;
72			end;
73
74			procedure TTest12.QueryDatabase(Attachment: IAttachment);
75			var Transaction: ITransaction;
76			Statement: IStatement;
77			ResultSet: IResultSet;
78			begin
79			Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
80			Statement := Attachment.Prepare(Transaction,'Select * from TestData');
81			ReportResults(Statement);
82			end;
83
84			function TTest12.TestTitle: string;
85			begin
86			Result := 'Test 12: Character Sets';
87			end;
88
89			procedure TTest12.RunTest(CharSet: string; SQLDialect: integer);
90			var DPB: IDPB;
91			Attachment: IAttachment;
92			begin
93			FHexStrings := true;
94			DPB := FirebirdAPI.AllocateDPB;
95			DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
96			DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
97			DPB.Add(isc_dpb_lc_ctype).setAsString('UTF8');
98			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
99			Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
100			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
101
102			UpdateDatabase(Attachment);
103
104			writeln(OutFile,'Connection Character Set UTF8');
105			{Query with UTF8}
106			QueryDatabase(Attachment);
107			Attachment.Disconnect;
108
109			writeln(OutFile,'Connection Character Set NONE');
110			{Query with No character set}
111			DPB := FirebirdAPI.AllocateDPB;
112			DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
113			DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
114			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
115			Attachment := FirebirdAPI.OpenDatabase(Owner.GetNewDatabaseName,DPB);
116			QueryDatabase(Attachment);
117			Attachment.Disconnect;
118
119			writeln(OutFile,'Connection Character Set WIN1252');
120			{Query with WIN1252}
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_lc_ctype).setAsString('WIN1252');
125			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
126			Attachment := FirebirdAPI.OpenDatabase(Owner.GetNewDatabaseName,DPB);
127			QueryDatabase(Attachment);
128
129			Attachment.DropDatabase;
130
131			end;
132
133			initialization
134			RegisterTest(TTest12);
135			end.
136