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, 9 months ago) by tony
Content type:	text/x-pascal
File size:	7937 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 Test6;
30	{$IFDEF MSWINDOWS}
31	{$DEFINE WINDOWS}
32	{$ENDIF}
33
34	{$IFDEF FPC}
35	{$mode delphi}
36	{$codepage UTF8}
37	{$ENDIF}
38
39	{Test 6: Blob Handling}
40
41	{
42	1. Create an empty database and populate with a single table and stored procedure
43	returning a blob.
44
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	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	}
67
68	interface
69
70	uses
71	Classes, SysUtils, TestApplication, FBTestApp, IB;
72
73	type
74
75	{ TTest6 }
76
77	TTest6 = class(TFBTestBase)
78	private
79	procedure UpdateDatabase(Attachment: IAttachment);
80	procedure ExecProc(Attachment: IAttachment);
81	public
82	function TestTitle: AnsiString; override;
83	procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
84	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	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	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	sqlExecProc = 'Execute Procedure TestProc ?';
115
116
117	{ 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	ByName('Fp').Clear;
162	ByName('DP').Clear;
163	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	procedure TTest6.ExecProc(Attachment: IAttachment);
179	var Transaction: ITransaction;
180	Statement: IStatement;
181	Results: IResults;
182	begin
183	writeln(OutFile,'Testing Blob as stored proc parameter');
184	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	function TTest6.TestTitle: AnsiString;
194	begin
195	Result := 'Test 6: Blob Handling';
196	end;
197
198	procedure TTest6.RunTest(CharSet: AnsiString; SQLDialect: integer);
199	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	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateProc);
210	UpdateDatabase(Attachment);
211	ExecProc(Attachment);
212
213	Attachment.DropDatabase;
214
215	{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	{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	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateProc);
237	UpdateDatabase(Attachment);
238	ExecProc(Attachment);
239
240	Attachment.DropDatabase;
241	end;
242
243	initialization
244	RegisterTest(TTest6);
245	end.
246