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, 10 months ago) by tony
Content type:	text/x-pascal
File size:	6941 byte(s)
Log Message:	Fixes Merged
#	Content
1	unit Test6;
2	{$IFDEF MSWINDOWS}
3	{$DEFINE WINDOWS}
4	{$ENDIF}
5
6	{$IFDEF FPC}
7	{$mode delphi}
8	{$codepage UTF8}
9	{$ENDIF}
10
11	{Test 6: Blob Handling}
12
13	{
14	1. Create an empty database and populate with a single table and stored procedure
15	returning a blob.
16
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	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	}
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	procedure ExecProc(Attachment: IAttachment);
53	public
54	function TestTitle: AnsiString; override;
55	procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
56	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	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	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	sqlExecProc = 'Execute Procedure TestProc ?';
87
88
89	{ 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	ByName('Fp').Clear;
134	ByName('DP').Clear;
135	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	procedure TTest6.ExecProc(Attachment: IAttachment);
151	var Transaction: ITransaction;
152	Statement: IStatement;
153	Results: IResults;
154	begin
155	writeln(OutFile,'Testing Blob as stored proc parameter');
156	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	function TTest6.TestTitle: AnsiString;
166	begin
167	Result := 'Test 6: Blob Handling';
168	end;
169
170	procedure TTest6.RunTest(CharSet: AnsiString; SQLDialect: integer);
171	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	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateProc);
182	UpdateDatabase(Attachment);
183	ExecProc(Attachment);
184
185	Attachment.DropDatabase;
186
187	{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	{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	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateProc);
209	UpdateDatabase(Attachment);
210	ExecProc(Attachment);
211
212	Attachment.DropDatabase;
213	end;
214
215	initialization
216	RegisterTest(TTest6);
217	end.
218