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.

  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);
  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)'+
    ')';

  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 = ?';


{ 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;

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);
  UpdateDatabase(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);
  UpdateDatabase(Attachment);

  Attachment.DropDatabase;
end;

initialization
  RegisterTest(TTest6);
end.

Revision:	68
Committed:	Tue Oct 17 10:07:58 2017 UTC (7 years, 1 month ago) by tony
Content type:	text/x-pascal
File size:	5133 byte(s)
Log Message:	IBX: Editor Positioning tidy up FBINTF: Trap uninitialised SQL parameters on SQL Exec. Avoids Unknown SQL Type errors. Consistent setting of Modified (SQLParam).
#	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.
15
16	2. Show the character sets available (List RDB$CHARACTER_SETS)
17
18	3. Select all from new table and show metadata.
19
20	4. Insert row and include WIN1252 characters known to be in two byte UTF8, plus Fixed point
21
22	5. Select all from new table
23
24	6. Use Update Query to set blob field with plain text loaded from file
25
26	7. Select all from new table
27
28	8. Add another row with a null blob
29
30	9. Update this row's blob field with a copy of the first row (demo of blob assignment)
31
32	10. Select all from new table.
33
34	11. Drop Database and repeat above but with no default connection character set.
35	}
36
37	interface
38
39	uses
40	Classes, SysUtils, TestManager, IB;
41
42	type
43
44	{ TTest6 }
45
46	TTest6 = class(TTestBase)
47	private
48	procedure UpdateDatabase(Attachment: IAttachment);
49	public
50	function TestTitle: AnsiString; override;
51	procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
52	end;
53
54	implementation
55
56	const
57	sqlCreateTable =
58	'Create Table TestData ('+
59	'RowID Integer not null,'+
60	'FixedPoint Decimal(8,2), '+
61	'FloatingPoint Double Precision, '+
62	'Title VarChar(32) Character Set UTF8,'+
63	'BlobData Blob sub_type 1 Character Set UTF8,'+
64	'Primary Key(RowID)'+
65	')';
66
67	sqlGetCharSets = 'Select RDB$CHARACTER_SET_NAME,RDB$CHARACTER_SET_ID from RDB$CHARACTER_SETS order by 2';
68
69	sqlInsert = 'Insert into TestData(RowID,Title,FixedPoint,FloatingPoint) Values(:RowID,:Title,:FP, :DP)';
70
71	sqlUpdate = 'Update TestData Set BlobData = ? Where RowID = ?';
72
73
74	{ TTest6 }
75
76	procedure TTest6.UpdateDatabase(Attachment: IAttachment);
77	var Transaction: ITransaction;
78	Statement,
79	Statement2: IStatement;
80	ResultSet: IResultSet;
81	i: integer;
82	begin
83	Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
84
85	Statement := Attachment.Prepare(Transaction,sqlGetCharSets);
86	PrintMetaData(Statement.GetMetaData);
87	ReportResults(Statement);
88	Statement := Attachment.Prepare(Transaction,'Select * from TestData');
89	PrintMetaData(Statement.GetMetaData);
90	Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
91	ParamInfo(Statement.SQLParams);
92	with Statement.GetSQLParams do
93	begin
94	ByName('rowid').AsInteger := 1;
95	ByName('title').AsString := 'Blob Test ©€';
96	ByName('Fp').AsDouble := 20.28;
97	ByName('DP').AsDouble := 3.142;
98	end;
99	Statement.Execute;
100	Statement := Attachment.Prepare(Transaction,'Select * from TestData');
101	ReportResults(Statement);
102
103
104	Statement := Attachment.Prepare(Transaction,sqlUpdate);
105	ParamInfo(Statement.SQLParams);
106	Statement.SQLParams[0].AsBlob := Attachment.CreateBlob(Transaction,'TestData','BlobData').LoadFromFile('testtext.txt');
107	Statement.SQLParams[1].AsInteger := 1;
108	Statement.Execute;
109	Statement := Attachment.Prepare(Transaction,'Select * from TestData');
110	ReportResults(Statement);
111
112	{second row}
113	Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
114	ParamInfo(Statement.SQLParams);
115	with Statement.GetSQLParams do
116	begin
117	ByName('rowid').AsInteger := 2;
118	ByName('title').AsString := 'Blob Test ©€';
119	ByName('Fp').Clear;
120	ByName('DP').Clear;
121	end;
122	Statement.Execute;
123	Statement := Attachment.Prepare(Transaction,'Select * from TestData Where rowid = 1');
124	ResultSet := Statement.OpenCursor;
125	if ResultSet.FetchNext then
126	begin
127	Statement2 := Attachment.Prepare(Transaction,sqlUpdate);
128	Statement2.SQLParams[0].AsBlob := ResultSet.ByName('BlobData').AsBlob; {test duplication of blob}
129	Statement2.SQLParams[1].AsInteger := 2;
130	Statement2.Execute;
131	Statement := Attachment.Prepare(Transaction,'Select * from TestData');
132	ReportResults(Statement);
133	end;
134	end;
135
136	function TTest6.TestTitle: AnsiString;
137	begin
138	Result := 'Test 6: Blob Handling';
139	end;
140
141	procedure TTest6.RunTest(CharSet: AnsiString; SQLDialect: integer);
142	var DPB: IDPB;
143	Attachment: IAttachment;
144	begin
145	DPB := FirebirdAPI.AllocateDPB;
146	DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
147	DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
148	DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
149	DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
150	Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
151	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
152	UpdateDatabase(Attachment);
153
154	Attachment.DropDatabase;
155
156	{Repeat with no lc_ctype}
157	DPB := FirebirdAPI.AllocateDPB;
158	DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
159	DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
160	DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
161	Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
162	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
163	UpdateDatabase(Attachment);
164
165	Attachment.DropDatabase;
166	end;
167
168	initialization
169	RegisterTest(TTest6);
170	end.
171