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

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

{Test 6: Blob Handling}

{
  1. Create an empty database and populate with a single table and stored procedure
     returning a blob.

  2. Show the character sets available (List RDB$CHARACTER_SETS)

  3. Select all from new table and show metadata.

  4. Insert row and include WIN1252 characters known to be in two byte UTF8, plus Fixed point

  5. Select all from new table

  6. Use Update Query to set blob field with plain text loaded from file

  7. Select all from new table

  8. Add another row with a null blob

  9. Update this row's blob field with a copy of the first row (demo of blob assignment)

  10. Select all from new table.

  11. Execute Stored proc and display results

  12. Drop Database and repeat above but with WIN1252 and  no default connection character set.
}

interface

uses
  Classes, SysUtils, TestApplication, FBTestApp, IB;

type

  { TTest6 }

  TTest6 = class(TFBTestBase)
  private
    procedure UpdateDatabase(Attachment: IAttachment);
    procedure ExecProc(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,'+
    'FixedPoint Decimal(8,2), '+
    'FloatingPoint Double Precision, '+
    'Title VarChar(32) Character Set UTF8,'+
    'BlobData Blob sub_type 1 Character Set UTF8,'+
    'Primary Key(RowID)'+
    ')';

  sqlCreateProc =
    'Create Procedure TestProc (RowID Integer) '+
    'Returns (BlobData Blob sub_type 1 Character Set UTF8) '+
    'As ' +
    'Begin ' +
    ' Select BlobData From TestData Where RowID = :RowID Into :BlobData; '+
    'End';


  sqlGetCharSets = 'Select RDB$CHARACTER_SET_NAME,RDB$CHARACTER_SET_ID from RDB$CHARACTER_SETS order by 2';

  sqlInsert = 'Insert into TestData(RowID,Title,FixedPoint,FloatingPoint) Values(:RowID,:Title,:FP, :DP)';

  sqlUpdate = 'Update TestData Set BlobData = ? Where RowID = ?';

  sqlExecProc = 'Execute Procedure TestProc ?';


{ TTest6 }

procedure TTest6.UpdateDatabase(Attachment: IAttachment);
var Transaction: ITransaction;
    Statement,
    Statement2: IStatement;
    ResultSet: IResultSet;
begin
  Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);

  Statement := Attachment.Prepare(Transaction,sqlGetCharSets);
  PrintMetaData(Statement.GetMetaData);
  ReportResults(Statement);
  Statement := Attachment.Prepare(Transaction,'Select * from TestData');
  PrintMetaData(Statement.GetMetaData);
  Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
  ParamInfo(Statement.SQLParams);
  with Statement.GetSQLParams do
  begin
    ByName('rowid').AsInteger := 1;
    ByName('title').AsString := 'Blob Test ©€';
    ByName('Fp').AsDouble := 20.28;
    ByName('DP').AsDouble := 3.142;
  end;
  Statement.Execute;
  Statement := Attachment.Prepare(Transaction,'Select * from TestData');
  ReportResults(Statement);


  Statement := Attachment.Prepare(Transaction,sqlUpdate);
  ParamInfo(Statement.SQLParams);
  Statement.SQLParams[0].AsBlob := Attachment.CreateBlob(Transaction,'TestData','BlobData').LoadFromFile('testtext.txt');
  Statement.SQLParams[1].AsInteger := 1;
  Statement.Execute;
  Statement := Attachment.Prepare(Transaction,'Select * from TestData');
  ReportResults(Statement);

  {second row}
  Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
  ParamInfo(Statement.SQLParams);
  with Statement.GetSQLParams do
  begin
    ByName('rowid').AsInteger := 2;
    ByName('title').AsString := 'Blob Test ©€';
    ByName('Fp').Clear;
    ByName('DP').Clear;
  end;
  Statement.Execute;
  Statement := Attachment.Prepare(Transaction,'Select * from TestData Where rowid = 1');
  ResultSet := Statement.OpenCursor;
  if ResultSet.FetchNext then
  begin
    Statement2 := Attachment.Prepare(Transaction,sqlUpdate);
    Statement2.SQLParams[0].AsBlob := ResultSet.ByName('BlobData').AsBlob; {test duplication of blob}
    Statement2.SQLParams[1].AsInteger := 2;
    Statement2.Execute;
    Statement := Attachment.Prepare(Transaction,'Select * from TestData');
    ReportResults(Statement);
  end;
end;

procedure TTest6.ExecProc(Attachment: IAttachment);
var Transaction: ITransaction;
    Statement: IStatement;
    Results: IResults;
begin
  writeln(OutFile,'Testing Blob as stored proc parameter');
  Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);

  Statement := Attachment.Prepare(Transaction,sqlExecProc);
  PrintMetaData(Statement.GetMetaData);
  Statement.SQLParams[0].AsInteger := 1;
  Results := Statement.Execute;
  ReportResult(Results);
end;

function TTest6.TestTitle: AnsiString;
begin
  Result := 'Test 6: Blob Handling';
end;

procedure TTest6.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(CharSet);
  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],sqlCreateProc);
  UpdateDatabase(Attachment);
  ExecProc(Attachment);

  Attachment.DropDatabase;

  {Repeat 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.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],sqlCreateProc);
  UpdateDatabase(Attachment);
  ExecProc(Attachment);

  Attachment.DropDatabase;

  {Repeat with no lc_ctype}
  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.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],sqlCreateProc);
  UpdateDatabase(Attachment);
  ExecProc(Attachment);

  Attachment.DropDatabase;
end;

initialization
  RegisterTest(TTest6);
end.

Revision:	315
Committed:	Thu Feb 25 11:56:36 2021 UTC (3 years, 1 month ago) by tony
Content type:	text/x-pascal
File size:	7937 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 Test6;
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 6: Blob Handling}
40
41			{
42	tony	110	1. Create an empty database and populate with a single table and stored procedure
43			returning a blob.
44	tony	45
45			2. Show the character sets available (List RDB$CHARACTER_SETS)
46
47			3. Select all from new table and show metadata.
48
49			4. Insert row and include WIN1252 characters known to be in two byte UTF8, plus Fixed point
50
51			5. Select all from new table
52
53			6. Use Update Query to set blob field with plain text loaded from file
54
55			7. Select all from new table
56
57			8. Add another row with a null blob
58
59			9. Update this row's blob field with a copy of the first row (demo of blob assignment)
60
61			10. Select all from new table.
62
63	tony	111	11. Execute Stored proc and display results
64
65			12. Drop Database and repeat above but with WIN1252 and no default connection character set.
66	tony	45	}
67
68			interface
69
70			uses
71	tony	315	Classes, SysUtils, TestApplication, FBTestApp, IB;
72	tony	45
73			type
74
75			{ TTest6 }
76
77	tony	315	TTest6 = class(TFBTestBase)
78	tony	45	private
79			procedure UpdateDatabase(Attachment: IAttachment);
80	tony	110	procedure ExecProc(Attachment: IAttachment);
81	tony	45	public
82	tony	56	function TestTitle: AnsiString; override;
83			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
84	tony	45	end;
85
86			implementation
87
88			const
89			sqlCreateTable =
90			'Create Table TestData ('+
91			'RowID Integer not null,'+
92			'FixedPoint Decimal(8,2), '+
93			'FloatingPoint Double Precision, '+
94			'Title VarChar(32) Character Set UTF8,'+
95			'BlobData Blob sub_type 1 Character Set UTF8,'+
96			'Primary Key(RowID)'+
97			')';
98
99	tony	110	sqlCreateProc =
100			'Create Procedure TestProc (RowID Integer) '+
101			'Returns (BlobData Blob sub_type 1 Character Set UTF8) '+
102			'As ' +
103			'Begin ' +
104			' Select BlobData From TestData Where RowID = :RowID Into :BlobData; '+
105			'End';
106
107
108	tony	45	sqlGetCharSets = 'Select RDB$CHARACTER_SET_NAME,RDB$CHARACTER_SET_ID from RDB$CHARACTER_SETS order by 2';
109
110			sqlInsert = 'Insert into TestData(RowID,Title,FixedPoint,FloatingPoint) Values(:RowID,:Title,:FP, :DP)';
111
112			sqlUpdate = 'Update TestData Set BlobData = ? Where RowID = ?';
113
114	tony	110	sqlExecProc = 'Execute Procedure TestProc ?';
115	tony	45
116	tony	110
117	tony	45	{ TTest6 }
118
119			procedure TTest6.UpdateDatabase(Attachment: IAttachment);
120			var Transaction: ITransaction;
121			Statement,
122			Statement2: IStatement;
123			ResultSet: IResultSet;
124			begin
125			Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
126
127			Statement := Attachment.Prepare(Transaction,sqlGetCharSets);
128			PrintMetaData(Statement.GetMetaData);
129			ReportResults(Statement);
130			Statement := Attachment.Prepare(Transaction,'Select * from TestData');
131			PrintMetaData(Statement.GetMetaData);
132			Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
133			ParamInfo(Statement.SQLParams);
134			with Statement.GetSQLParams do
135			begin
136			ByName('rowid').AsInteger := 1;
137			ByName('title').AsString := 'Blob Test ©€';
138			ByName('Fp').AsDouble := 20.28;
139			ByName('DP').AsDouble := 3.142;
140			end;
141			Statement.Execute;
142			Statement := Attachment.Prepare(Transaction,'Select * from TestData');
143			ReportResults(Statement);
144
145
146			Statement := Attachment.Prepare(Transaction,sqlUpdate);
147			ParamInfo(Statement.SQLParams);
148			Statement.SQLParams[0].AsBlob := Attachment.CreateBlob(Transaction,'TestData','BlobData').LoadFromFile('testtext.txt');
149			Statement.SQLParams[1].AsInteger := 1;
150			Statement.Execute;
151			Statement := Attachment.Prepare(Transaction,'Select * from TestData');
152			ReportResults(Statement);
153
154			{second row}
155			Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
156			ParamInfo(Statement.SQLParams);
157			with Statement.GetSQLParams do
158			begin
159			ByName('rowid').AsInteger := 2;
160			ByName('title').AsString := 'Blob Test ©€';
161	tony	68	ByName('Fp').Clear;
162			ByName('DP').Clear;
163	tony	45	end;
164			Statement.Execute;
165			Statement := Attachment.Prepare(Transaction,'Select * from TestData Where rowid = 1');
166			ResultSet := Statement.OpenCursor;
167			if ResultSet.FetchNext then
168			begin
169			Statement2 := Attachment.Prepare(Transaction,sqlUpdate);
170			Statement2.SQLParams[0].AsBlob := ResultSet.ByName('BlobData').AsBlob; {test duplication of blob}
171			Statement2.SQLParams[1].AsInteger := 2;
172			Statement2.Execute;
173			Statement := Attachment.Prepare(Transaction,'Select * from TestData');
174			ReportResults(Statement);
175			end;
176			end;
177
178	tony	110	procedure TTest6.ExecProc(Attachment: IAttachment);
179			var Transaction: ITransaction;
180			Statement: IStatement;
181			Results: IResults;
182			begin
183	tony	111	writeln(OutFile,'Testing Blob as stored proc parameter');
184	tony	110	Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
185
186			Statement := Attachment.Prepare(Transaction,sqlExecProc);
187			PrintMetaData(Statement.GetMetaData);
188			Statement.SQLParams[0].AsInteger := 1;
189			Results := Statement.Execute;
190			ReportResult(Results);
191			end;
192
193	tony	56	function TTest6.TestTitle: AnsiString;
194	tony	45	begin
195			Result := 'Test 6: Blob Handling';
196			end;
197
198	tony	56	procedure TTest6.RunTest(CharSet: AnsiString; SQLDialect: integer);
199	tony	45	var DPB: IDPB;
200			Attachment: IAttachment;
201			begin
202			DPB := FirebirdAPI.AllocateDPB;
203			DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
204			DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
205			DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
206			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
207			Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
208			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
209	tony	110	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateProc);
210	tony	45	UpdateDatabase(Attachment);
211	tony	110	ExecProc(Attachment);
212	tony	45
213			Attachment.DropDatabase;
214
215	tony	110	{Repeat with WIN1252}
216			DPB := FirebirdAPI.AllocateDPB;
217			DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
218			DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
219			DPB.Add(isc_dpb_lc_ctype).setAsString('WIN1252');
220			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
221			Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
222			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
223			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateProc);
224			UpdateDatabase(Attachment);
225			ExecProc(Attachment);
226
227			Attachment.DropDatabase;
228
229	tony	45	{Repeat with no lc_ctype}
230			DPB := FirebirdAPI.AllocateDPB;
231			DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
232			DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
233			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
234			Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
235			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
236	tony	110	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateProc);
237	tony	45	UpdateDatabase(Attachment);
238	tony	110	ExecProc(Attachment);
239	tony	45
240			Attachment.DropDatabase;
241			end;
242
243			initialization
244			RegisterTest(TTest6);
245			end.
246