fbintf/testsuite/Test15.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 Test15;
{$IFDEF MSWINDOWS} 
{$DEFINE WINDOWS} 
{$ENDIF}

{$IFDEF FPC}
{$mode delphi}
{$codepage UTF8}
{$ENDIF}

{Test 15: Blob Handling and BPBs}

{
  1. A database is created with two tables. One has an untyped Blob. the other
     is UTF8 text.

  2. An image is inserted into the first.

  3. Win1252 text into the second with a Blob Filter request to transform to UTF8.

  4. The Data is read back and written out.
}

interface

uses
  Classes, SysUtils, TestApplication, FBTestApp, IB;

type
      { TTest15 }

  TTest15 = 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,'+
    'BlobData Blob sub_type 0, '+
    'Primary Key(RowID)'+
    ')';

    sqlCreateTable2 =
    'Create Table TestData2 ('+
    'RowID Integer not null,'+
    'Title VarChar(32) Character Set UTF8,'+
    'BlobData Blob sub_type 1 Character Set UTF8, '+
    'Primary Key(RowID)'+
    ')';

    sqlInsert = 'Insert into TestData(RowID,Title, BlobData) Values(:RowID,:Title,:BlobData)';
    sqlInsert2 = 'Insert into TestData2(RowID,Title, BlobData) Values(:RowID,:Title,:BlobData)';

{ TTest15 }

procedure TTest15.UpdateDatabase(Attachment: IAttachment);
var Transaction: ITransaction;
    Statement: IStatement;
    aBlob: IBlob;
    BPB: IBPB;
    aText: RawByteString;
begin
  Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);

  Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
  with Statement.GetSQLParams do
  begin
    ByName('rowid').AsInteger := 1;
    ByName('title').AsString := 'Blob Test';
    ByName('BlobData').AsBlob := Attachment.CreateBlob(Transaction,'TestData','BlobData').LoadFromFile('testimage.jpg');
  end;
  Statement.Execute;

  BPB := Attachment.AllocateBPB;
  BPB.Add(isc_bpb_target_type).AsInteger := 1;
  BPB.Add(isc_bpb_target_interp).AsInteger := 4; {utf8}
  BPB.Add(isc_bpb_source_type).AsInteger := 1;
  BPB.Add(isc_bpb_source_interp).AsInteger := 53; {WIN1252}
  aText := #$C9#$63#$6F#$75#$74#$65#$20#$6D#$6F#$69;  {Écoute moi' encoded in Win1252}
  aBlob := Attachment.CreateBlob(Transaction,'TestData2','BlobData',BPB).SetString(aText);
  Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert2);
  with Statement.GetSQLParams do
  begin
    ByName('rowid').AsInteger := 1;
    ByName('title').AsString := 'Blob Test';
    ByName('BlobData').AsBlob := aBlob;
  end;
  Statement.Execute;
end;

procedure TTest15.QueryDatabase(Attachment: IAttachment);
var Transaction: ITransaction;
    Statement: IStatement;
begin
  Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
  Statement := Attachment.Prepare(Transaction,'Select * from TestData ');
  writeln(OutFile);
  writeln(OutFile,'Testdata');
  writeln(OutFile);
  ReportResults(Statement);
  Statement := Attachment.Prepare(Transaction,'Select * from TestData2 ');
  writeln(OutFile);
  writeln(OutFile,'Testdata 2');
  writeln(OutFile);
  ReportResults(Statement);
end;

function TTest15.TestTitle: AnsiString;
begin
  Result := 'Test 15: Blob Handling and BPBs';
end;

procedure TTest15.RunTest(CharSet: AnsiString; SQLDialect: integer);
var DPB: IDPB;
    Attachment: IAttachment;
begin
  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);
  Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable2);

  UpdateDatabase(Attachment);
  QueryDatabase(Attachment);
  Attachment.DropDatabase;
end;

initialization
  RegisterTest(TTest15);
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:	5235 byte(s)
Log Message:	Updated for IBX 4 release
#	Content
1	(*
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 Test15;
30	{$IFDEF MSWINDOWS}
31	{$DEFINE WINDOWS}
32	{$ENDIF}
33
34	{$IFDEF FPC}
35	{$mode delphi}
36	{$codepage UTF8}
37	{$ENDIF}
38
39	{Test 15: Blob Handling and BPBs}
40
41	{
42	1. A database is created with two tables. One has an untyped Blob. the other
43	is UTF8 text.
44
45	2. An image is inserted into the first.
46
47	3. Win1252 text into the second with a Blob Filter request to transform to UTF8.
48
49	4. The Data is read back and written out.
50	}
51
52	interface
53
54	uses
55	Classes, SysUtils, TestApplication, FBTestApp, IB;
56
57	type
58	{ TTest15 }
59
60	TTest15 = class(TFBTestBase)
61	private
62	procedure UpdateDatabase(Attachment: IAttachment);
63	procedure QueryDatabase(Attachment: IAttachment);
64	public
65	function TestTitle: AnsiString; override;
66	procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
67	end;
68
69
70	implementation
71
72	const
73	sqlCreateTable =
74	'Create Table TestData ('+
75	'RowID Integer not null,'+
76	'Title VarChar(32) Character Set UTF8,'+
77	'BlobData Blob sub_type 0, '+
78	'Primary Key(RowID)'+
79	')';
80
81	sqlCreateTable2 =
82	'Create Table TestData2 ('+
83	'RowID Integer not null,'+
84	'Title VarChar(32) Character Set UTF8,'+
85	'BlobData Blob sub_type 1 Character Set UTF8, '+
86	'Primary Key(RowID)'+
87	')';
88
89	sqlInsert = 'Insert into TestData(RowID,Title, BlobData) Values(:RowID,:Title,:BlobData)';
90	sqlInsert2 = 'Insert into TestData2(RowID,Title, BlobData) Values(:RowID,:Title,:BlobData)';
91
92	{ TTest15 }
93
94	procedure TTest15.UpdateDatabase(Attachment: IAttachment);
95	var Transaction: ITransaction;
96	Statement: IStatement;
97	aBlob: IBlob;
98	BPB: IBPB;
99	aText: RawByteString;
100	begin
101	Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
102
103	Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
104	with Statement.GetSQLParams do
105	begin
106	ByName('rowid').AsInteger := 1;
107	ByName('title').AsString := 'Blob Test';
108	ByName('BlobData').AsBlob := Attachment.CreateBlob(Transaction,'TestData','BlobData').LoadFromFile('testimage.jpg');
109	end;
110	Statement.Execute;
111
112	BPB := Attachment.AllocateBPB;
113	BPB.Add(isc_bpb_target_type).AsInteger := 1;
114	BPB.Add(isc_bpb_target_interp).AsInteger := 4; {utf8}
115	BPB.Add(isc_bpb_source_type).AsInteger := 1;
116	BPB.Add(isc_bpb_source_interp).AsInteger := 53; {WIN1252}
117	aText := #$C9#$63#$6F#$75#$74#$65#$20#$6D#$6F#$69; {Écoute moi' encoded in Win1252}
118	aBlob := Attachment.CreateBlob(Transaction,'TestData2','BlobData',BPB).SetString(aText);
119	Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert2);
120	with Statement.GetSQLParams do
121	begin
122	ByName('rowid').AsInteger := 1;
123	ByName('title').AsString := 'Blob Test';
124	ByName('BlobData').AsBlob := aBlob;
125	end;
126	Statement.Execute;
127	end;
128
129	procedure TTest15.QueryDatabase(Attachment: IAttachment);
130	var Transaction: ITransaction;
131	Statement: IStatement;
132	begin
133	Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
134	Statement := Attachment.Prepare(Transaction,'Select * from TestData ');
135	writeln(OutFile);
136	writeln(OutFile,'Testdata');
137	writeln(OutFile);
138	ReportResults(Statement);
139	Statement := Attachment.Prepare(Transaction,'Select * from TestData2 ');
140	writeln(OutFile);
141	writeln(OutFile,'Testdata 2');
142	writeln(OutFile);
143	ReportResults(Statement);
144	end;
145
146	function TTest15.TestTitle: AnsiString;
147	begin
148	Result := 'Test 15: Blob Handling and BPBs';
149	end;
150
151	procedure TTest15.RunTest(CharSet: AnsiString; SQLDialect: integer);
152	var DPB: IDPB;
153	Attachment: IAttachment;
154	begin
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_lc_ctype).setAsString('UTF8');
159	DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
160	Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
161	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
162	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable2);
163
164	UpdateDatabase(Attachment);
165	QueryDatabase(Attachment);
166	Attachment.DropDatabase;
167	end;
168
169	initialization
170	RegisterTest(TTest15);
171	end.
172