fbintf/testsuite/Test15.pas

(*
 *  Firebird Interface (fbintf) Test suite. This program is used to
 *  test the Firebird Pascal Interface and provide a semi-automated
 *  pass/fail check for each test.
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2016 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)

unit Test15;
{$IFDEF MSWINDOWS} 
{$DEFINE WINDOWS} 
{$ENDIF}

{$IFDEF FPC}
{$mode delphi}
{$codepage UTF8}
{$ENDIF}

{Test 15: Blob Handling and BPBs}

{
  1. A database is created with two tables. One has an untyped Blob. the other
     is UTF8 text.

  2. An image is inserted into the first.

  3. Win1252 text into the second with a Blob Filter request to transform to UTF8.

  4. The Data is read back and written out.
}

interface

uses
  Classes, SysUtils, TestApplication, FBTestApp, IB;

type
      { TTest15 }

  TTest15 = class(TFBTestBase)
  private
    procedure UpdateDatabase(Attachment: IAttachment);
    procedure QueryDatabase(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,'+
    'Title VarChar(32) Character Set UTF8,'+
    'BlobData Blob sub_type 0, '+
    'Primary Key(RowID)'+
    ')';

    sqlCreateTable2 =
    'Create Table TestData2 ('+
    'RowID Integer not null,'+
    'Title VarChar(32) Character Set UTF8,'+
    'BlobData Blob sub_type 1 Character Set UTF8, '+
    'Primary Key(RowID)'+
    ')';

    sqlInsert = 'Insert into TestData(RowID,Title, BlobData) Values(:RowID,:Title,:BlobData)';
    sqlInsert2 = 'Insert into TestData2(RowID,Title, BlobData) Values(:RowID,:Title,:BlobData)';

{ TTest15 }

procedure TTest15.UpdateDatabase(Attachment: IAttachment);
var Transaction: ITransaction;
    Statement: IStatement;
    aBlob: IBlob;
    BPB: IBPB;
    aText: RawByteString;
begin
  Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);

  Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
  with Statement.GetSQLParams do
  begin
    ByName('rowid').AsInteger := 1;
    ByName('title').AsString := 'Blob Test';
    ByName('BlobData').AsBlob := Attachment.CreateBlob(Transaction,'TestData','BlobData').LoadFromFile('testimage.jpg');
  end;
  Statement.Execute;

  Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
  with Statement.GetSQLParams do
  begin
    ByName('rowid').AsInteger := 2;
    ByName('title').AsString := 'Blob Test with binary string';
    aText := #$0#$09#$0a {random digits} +
             #$C9#$63#$6F#$75#$74#$65#$20#$6D#$6F#$69;  {Écoute moi' encoded in Win1252}
    ByName('BlobData').AsString := aText;
  end;
  Statement.Execute;

  BPB := Attachment.AllocateBPB;
  BPB.Add(isc_bpb_target_type).AsInteger := 1;
  BPB.Add(isc_bpb_target_interp).AsInteger := 4; {utf8}
  BPB.Add(isc_bpb_source_type).AsInteger := 1;
  BPB.Add(isc_bpb_source_interp).AsInteger := 53; {WIN1252}
  aText := #$C9#$63#$6F#$75#$74#$65#$20#$6D#$6F#$69;  {Écoute moi' encoded in Win1252}
  aBlob := Attachment.CreateBlob(Transaction,'TestData2','BlobData',BPB).SetString(aText);
  Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert2);
  with Statement.GetSQLParams do
  begin
    ByName('rowid').AsInteger := 1;
    ByName('title').AsString := 'Blob Test';
    ByName('BlobData').AsBlob := aBlob;
  end;
  Statement.Execute;
end;

procedure TTest15.QueryDatabase(Attachment: IAttachment);
var Transaction: ITransaction;
    Statement: IStatement;
begin
  Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
  Statement := Attachment.Prepare(Transaction,'Select * from TestData Where RowID = 1');
  writeln(OutFile);
  writeln(OutFile,'Testdata');
  writeln(OutFile);
  ReportResults(Statement);
  FShowBinaryBlob := true;
  Statement := Attachment.Prepare(Transaction,'Select * from TestData Where RowID = 2');
  ReportResults(Statement);
  FShowBinaryBlob := false;

  Statement := Attachment.Prepare(Transaction,'Select * from TestData2 ');
  writeln(OutFile);
  writeln(OutFile,'Testdata 2');
  writeln(OutFile);
  ReportResults(Statement);
end;

function TTest15.TestTitle: AnsiString;
begin
  Result := 'Test 15: Blob Handling and BPBs';
end;

procedure TTest15.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('UTF8');
  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],sqlCreateTable2);

  UpdateDatabase(Attachment);
  QueryDatabase(Attachment);
  Attachment.DropDatabase;
end;

initialization
  RegisterTest(TTest15);
end.

Revision:	380
Committed:	Mon Jan 10 10:13:17 2022 UTC (2 years, 10 months ago) by tony
Content type:	text/x-pascal
File size:	5845 byte(s)
Log Message:	propset for eol-style
#	Content
1	(*
2	* Firebird Interface (fbintf) Test suite. This program is used to
3	* test the Firebird Pascal Interface and provide a semi-automated
4	* pass/fail check for each test.
5	*
6	* The contents of this file are subject to the Initial Developer's
7	* Public License Version 1.0 (the "License"); you may not use this
8	* file except in compliance with the License. You may obtain a copy
9	* of the License here:
10	*
11	* http://www.firebirdsql.org/index.php?op=doc&id=idpl
12	*
13	* Software distributed under the License is distributed on an "AS
14	* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
15	* implied. See the License for the specific language governing rights
16	* and limitations under the License.
17	*
18	* The Initial Developer of the Original Code is Tony Whyman.
19	*
20	* The Original Code is (C) 2016 Tony Whyman, MWA Software
21	* (http://www.mwasoftware.co.uk).
22	*
23	* All Rights Reserved.
24	*
25	* Contributor(s): ______________________________________.
26	*
27	*)
28
29	unit Test15;
30	{$IFDEF MSWINDOWS}
31	{$DEFINE WINDOWS}
32	{$ENDIF}
33
34	{$IFDEF FPC}
35	{$mode delphi}
36	{$codepage UTF8}
37	{$ENDIF}
38
39	{Test 15: Blob Handling and BPBs}
40
41	{
42	1. A database is created with two tables. One has an untyped Blob. the other
43	is UTF8 text.
44
45	2. An image is inserted into the first.
46
47	3. Win1252 text into the second with a Blob Filter request to transform to UTF8.
48
49	4. The Data is read back and written out.
50	}
51
52	interface
53
54	uses
55	Classes, SysUtils, TestApplication, FBTestApp, IB;
56
57	type
58	{ TTest15 }
59
60	TTest15 = class(TFBTestBase)
61	private
62	procedure UpdateDatabase(Attachment: IAttachment);
63	procedure QueryDatabase(Attachment: IAttachment);
64	public
65	function TestTitle: AnsiString; override;
66	procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
67	end;
68
69
70	implementation
71
72	const
73	sqlCreateTable =
74	'Create Table TestData ('+
75	'RowID Integer not null,'+
76	'Title VarChar(32) Character Set UTF8,'+
77	'BlobData Blob sub_type 0, '+
78	'Primary Key(RowID)'+
79	')';
80
81	sqlCreateTable2 =
82	'Create Table TestData2 ('+
83	'RowID Integer not null,'+
84	'Title VarChar(32) Character Set UTF8,'+
85	'BlobData Blob sub_type 1 Character Set UTF8, '+
86	'Primary Key(RowID)'+
87	')';
88
89	sqlInsert = 'Insert into TestData(RowID,Title, BlobData) Values(:RowID,:Title,:BlobData)';
90	sqlInsert2 = 'Insert into TestData2(RowID,Title, BlobData) Values(:RowID,:Title,:BlobData)';
91
92	{ TTest15 }
93
94	procedure TTest15.UpdateDatabase(Attachment: IAttachment);
95	var Transaction: ITransaction;
96	Statement: IStatement;
97	aBlob: IBlob;
98	BPB: IBPB;
99	aText: RawByteString;
100	begin
101	Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
102
103	Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
104	with Statement.GetSQLParams do
105	begin
106	ByName('rowid').AsInteger := 1;
107	ByName('title').AsString := 'Blob Test';
108	ByName('BlobData').AsBlob := Attachment.CreateBlob(Transaction,'TestData','BlobData').LoadFromFile('testimage.jpg');
109	end;
110	Statement.Execute;
111
112	Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
113	with Statement.GetSQLParams do
114	begin
115	ByName('rowid').AsInteger := 2;
116	ByName('title').AsString := 'Blob Test with binary string';
117	aText := #$0#$09#$0a {random digits} +
118	#$C9#$63#$6F#$75#$74#$65#$20#$6D#$6F#$69; {Écoute moi' encoded in Win1252}
119	ByName('BlobData').AsString := aText;
120	end;
121	Statement.Execute;
122
123	BPB := Attachment.AllocateBPB;
124	BPB.Add(isc_bpb_target_type).AsInteger := 1;
125	BPB.Add(isc_bpb_target_interp).AsInteger := 4; {utf8}
126	BPB.Add(isc_bpb_source_type).AsInteger := 1;
127	BPB.Add(isc_bpb_source_interp).AsInteger := 53; {WIN1252}
128	aText := #$C9#$63#$6F#$75#$74#$65#$20#$6D#$6F#$69; {Écoute moi' encoded in Win1252}
129	aBlob := Attachment.CreateBlob(Transaction,'TestData2','BlobData',BPB).SetString(aText);
130	Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert2);
131	with Statement.GetSQLParams do
132	begin
133	ByName('rowid').AsInteger := 1;
134	ByName('title').AsString := 'Blob Test';
135	ByName('BlobData').AsBlob := aBlob;
136	end;
137	Statement.Execute;
138	end;
139
140	procedure TTest15.QueryDatabase(Attachment: IAttachment);
141	var Transaction: ITransaction;
142	Statement: IStatement;
143	begin
144	Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
145	Statement := Attachment.Prepare(Transaction,'Select * from TestData Where RowID = 1');
146	writeln(OutFile);
147	writeln(OutFile,'Testdata');
148	writeln(OutFile);
149	ReportResults(Statement);
150	FShowBinaryBlob := true;
151	Statement := Attachment.Prepare(Transaction,'Select * from TestData Where RowID = 2');
152	ReportResults(Statement);
153	FShowBinaryBlob := false;
154
155	Statement := Attachment.Prepare(Transaction,'Select * from TestData2 ');
156	writeln(OutFile);
157	writeln(OutFile,'Testdata 2');
158	writeln(OutFile);
159	ReportResults(Statement);
160	end;
161
162	function TTest15.TestTitle: AnsiString;
163	begin
164	Result := 'Test 15: Blob Handling and BPBs';
165	end;
166
167	procedure TTest15.RunTest(CharSet: AnsiString; SQLDialect: integer);
168	var DPB: IDPB;
169	Attachment: IAttachment;
170	begin
171	DPB := FirebirdAPI.AllocateDPB;
172	DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
173	DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
174	DPB.Add(isc_dpb_lc_ctype).setAsString('UTF8');
175	DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
176	Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
177	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
178	Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable2);
179
180	UpdateDatabase(Attachment);
181	QueryDatabase(Attachment);
182	Attachment.DropDatabase;
183	end;
184
185	initialization
186	RegisterTest(TTest15);
187	end.
188