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