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, 2 months 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).
#	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			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	tony	56	function TestTitle: AnsiString; override;
51			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
52	tony	45	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	tony	68	ByName('Fp').Clear;
120			ByName('DP').Clear;
121	tony	45	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	tony	56	function TTest6.TestTitle: AnsiString;
137	tony	45	begin
138			Result := 'Test 6: Blob Handling';
139			end;
140
141	tony	56	procedure TTest6.RunTest(CharSet: AnsiString; SQLDialect: integer);
142	tony	45	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