fbintf/testsuite/Test6.pas

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, TestManager, IB;

type

  { TTest6 }

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