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
#	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	tony	45	unit Test15;
30	tony	56	{$IFDEF MSWINDOWS}
31			{$DEFINE WINDOWS}
32			{$ENDIF}
33	tony	45
34	tony	56	{$IFDEF FPC}
35			{$mode delphi}
36	tony	45	{$codepage UTF8}
37	tony	56	{$ENDIF}
38	tony	45
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	tony	315	Classes, SysUtils, TestApplication, FBTestApp, IB;
56	tony	45
57			type
58			{ TTest15 }
59
60	tony	315	TTest15 = class(TFBTestBase)
61	tony	45	private
62			procedure UpdateDatabase(Attachment: IAttachment);
63			procedure QueryDatabase(Attachment: IAttachment);
64			public
65	tony	56	function TestTitle: AnsiString; override;
66			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
67	tony	45	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	tony	56	function TTest15.TestTitle: AnsiString;
147	tony	45	begin
148			Result := 'Test 15: Blob Handling and BPBs';
149			end;
150
151	tony	56	procedure TTest15.RunTest(CharSet: AnsiString; SQLDialect: integer);
152	tony	45	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