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;

  Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
  with Statement.GetSQLParams do
  begin
    ByName('rowid').AsInteger := 2;
    ByName('title').AsString := 'Blob Test with binary string';
    aText := #$0#$09#$0a {random digits} +
             #$C9#$63#$6F#$75#$74#$65#$20#$6D#$6F#$69;  {Écoute moi' encoded in Win1252}
    ByName('BlobData').AsString := aText;
  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 Where RowID = 1');
  writeln(OutFile);
  writeln(OutFile,'Testdata');
  writeln(OutFile);
  ReportResults(Statement);
  FShowBinaryBlob := true;
  Statement := Attachment.Prepare(Transaction,'Select * from TestData Where RowID = 2');
  ReportResults(Statement);
  FShowBinaryBlob := false;

  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:	380
Committed:	Mon Jan 10 10:13:17 2022 UTC (2 years, 11 months ago) by tony
Content type:	text/x-pascal
File size:	5845 byte(s)
Log Message:	propset for eol-style
#	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	tony	345	Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
113			with Statement.GetSQLParams do
114			begin
115			ByName('rowid').AsInteger := 2;
116			ByName('title').AsString := 'Blob Test with binary string';
117			aText := #$0#$09#$0a {random digits} +
118			#$C9#$63#$6F#$75#$74#$65#$20#$6D#$6F#$69; {Écoute moi' encoded in Win1252}
119			ByName('BlobData').AsString := aText;
120			end;
121			Statement.Execute;
122
123	tony	45	BPB := Attachment.AllocateBPB;
124			BPB.Add(isc_bpb_target_type).AsInteger := 1;
125			BPB.Add(isc_bpb_target_interp).AsInteger := 4; {utf8}
126			BPB.Add(isc_bpb_source_type).AsInteger := 1;
127			BPB.Add(isc_bpb_source_interp).AsInteger := 53; {WIN1252}
128			aText := #$C9#$63#$6F#$75#$74#$65#$20#$6D#$6F#$69; {Écoute moi' encoded in Win1252}
129			aBlob := Attachment.CreateBlob(Transaction,'TestData2','BlobData',BPB).SetString(aText);
130			Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert2);
131			with Statement.GetSQLParams do
132			begin
133			ByName('rowid').AsInteger := 1;
134			ByName('title').AsString := 'Blob Test';
135			ByName('BlobData').AsBlob := aBlob;
136			end;
137			Statement.Execute;
138			end;
139
140			procedure TTest15.QueryDatabase(Attachment: IAttachment);
141			var Transaction: ITransaction;
142			Statement: IStatement;
143			begin
144			Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
145	tony	345	Statement := Attachment.Prepare(Transaction,'Select * from TestData Where RowID = 1');
146	tony	45	writeln(OutFile);
147			writeln(OutFile,'Testdata');
148			writeln(OutFile);
149			ReportResults(Statement);
150	tony	345	FShowBinaryBlob := true;
151			Statement := Attachment.Prepare(Transaction,'Select * from TestData Where RowID = 2');
152			ReportResults(Statement);
153			FShowBinaryBlob := false;
154
155	tony	45	Statement := Attachment.Prepare(Transaction,'Select * from TestData2 ');
156			writeln(OutFile);
157			writeln(OutFile,'Testdata 2');
158			writeln(OutFile);
159			ReportResults(Statement);
160			end;
161
162	tony	56	function TTest15.TestTitle: AnsiString;
163	tony	45	begin
164			Result := 'Test 15: Blob Handling and BPBs';
165			end;
166
167	tony	56	procedure TTest15.RunTest(CharSet: AnsiString; SQLDialect: integer);
168	tony	45	var DPB: IDPB;
169			Attachment: IAttachment;
170			begin
171			DPB := FirebirdAPI.AllocateDPB;
172			DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
173			DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
174			DPB.Add(isc_dpb_lc_ctype).setAsString('UTF8');
175			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
176			Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
177			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
178			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable2);
179
180			UpdateDatabase(Attachment);
181			QueryDatabase(Attachment);
182			Attachment.DropDatabase;
183			end;
184
185			initialization
186			RegisterTest(TTest15);
187			end.
188