fbintf/testsuite/Test15.pas

unit Test15;

{$mode objfpc}{$H+}
{$codepage UTF8}

{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, TestManager, IB;

type
      { TTest15 }

  TTest15 = class(TTestBase)
  private
    procedure UpdateDatabase(Attachment: IAttachment);
    procedure QueryDatabase(Attachment: IAttachment);
  public
    function TestTitle: string; override;
    procedure RunTest(CharSet: string; 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;

  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 ');
  writeln(OutFile);
  writeln(OutFile,'Testdata');
  writeln(OutFile);
  ReportResults(Statement);
  Statement := Attachment.Prepare(Transaction,'Select * from TestData2 ');
  writeln(OutFile);
  writeln(OutFile,'Testdata 2');
  writeln(OutFile);
  ReportResults(Statement);
end;

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

procedure TTest15.RunTest(CharSet: string; 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:	45
Committed:	Tue Dec 6 10:33:46 2016 UTC (7 years, 4 months ago) by tony
Content type:	text/x-pascal
File size:	4158 byte(s)
Log Message:	Committing updates for Release R2-0-0
#	User	Rev	Content
1	tony	45	unit Test15;
2
3			{$mode objfpc}{$H+}
4			{$codepage UTF8}
5
6			{Test 15: Blob Handling and BPBs}
7
8			{
9			1. A database is created with two tables. One has an untyped Blob. the other
10			is UTF8 text.
11
12			2. An image is inserted into the first.
13
14			3. Win1252 text into the second with a Blob Filter request to transform to UTF8.
15
16			4. The Data is read back and written out.
17			}
18
19			interface
20
21			uses
22			Classes, SysUtils, TestManager, IB;
23
24			type
25			{ TTest15 }
26
27			TTest15 = class(TTestBase)
28			private
29			procedure UpdateDatabase(Attachment: IAttachment);
30			procedure QueryDatabase(Attachment: IAttachment);
31			public
32			function TestTitle: string; override;
33			procedure RunTest(CharSet: string; SQLDialect: integer); override;
34			end;
35
36
37			implementation
38
39			const
40			sqlCreateTable =
41			'Create Table TestData ('+
42			'RowID Integer not null,'+
43			'Title VarChar(32) Character Set UTF8,'+
44			'BlobData Blob sub_type 0, '+
45			'Primary Key(RowID)'+
46			')';
47
48			sqlCreateTable2 =
49			'Create Table TestData2 ('+
50			'RowID Integer not null,'+
51			'Title VarChar(32) Character Set UTF8,'+
52			'BlobData Blob sub_type 1 Character Set UTF8, '+
53			'Primary Key(RowID)'+
54			')';
55
56			sqlInsert = 'Insert into TestData(RowID,Title, BlobData) Values(:RowID,:Title,:BlobData)';
57			sqlInsert2 = 'Insert into TestData2(RowID,Title, BlobData) Values(:RowID,:Title,:BlobData)';
58
59			{ TTest15 }
60
61			procedure TTest15.UpdateDatabase(Attachment: IAttachment);
62			var Transaction: ITransaction;
63			Statement: IStatement;
64			aBlob: IBlob;
65			BPB: IBPB;
66			aText: RawByteString;
67			begin
68			Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
69
70			Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
71			with Statement.GetSQLParams do
72			begin
73			ByName('rowid').AsInteger := 1;
74			ByName('title').AsString := 'Blob Test';
75			ByName('BlobData').AsBlob := Attachment.CreateBlob(Transaction,'TestData','BlobData').LoadFromFile('testimage.jpg');
76			end;
77			Statement.Execute;
78
79			BPB := Attachment.AllocateBPB;
80			BPB.Add(isc_bpb_target_type).AsInteger := 1;
81			BPB.Add(isc_bpb_target_interp).AsInteger := 4; {utf8}
82			BPB.Add(isc_bpb_source_type).AsInteger := 1;
83			BPB.Add(isc_bpb_source_interp).AsInteger := 53; {WIN1252}
84			aText := #$C9#$63#$6F#$75#$74#$65#$20#$6D#$6F#$69; {Écoute moi' encoded in Win1252}
85			aBlob := Attachment.CreateBlob(Transaction,'TestData2','BlobData',BPB).SetString(aText);
86			Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert2);
87			with Statement.GetSQLParams do
88			begin
89			ByName('rowid').AsInteger := 1;
90			ByName('title').AsString := 'Blob Test';
91			ByName('BlobData').AsBlob := aBlob;
92			end;
93			Statement.Execute;
94			end;
95
96			procedure TTest15.QueryDatabase(Attachment: IAttachment);
97			var Transaction: ITransaction;
98			Statement: IStatement;
99			begin
100			Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
101			Statement := Attachment.Prepare(Transaction,'Select * from TestData ');
102			writeln(OutFile);
103			writeln(OutFile,'Testdata');
104			writeln(OutFile);
105			ReportResults(Statement);
106			Statement := Attachment.Prepare(Transaction,'Select * from TestData2 ');
107			writeln(OutFile);
108			writeln(OutFile,'Testdata 2');
109			writeln(OutFile);
110			ReportResults(Statement);
111			end;
112
113			function TTest15.TestTitle: string;
114			begin
115			Result := 'Test 15: Blob Handling and BPBs';
116			end;
117
118			procedure TTest15.RunTest(CharSet: string; SQLDialect: integer);
119			var DPB: IDPB;
120			Attachment: IAttachment;
121			begin
122			DPB := FirebirdAPI.AllocateDPB;
123			DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
124			DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
125			DPB.Add(isc_dpb_lc_ctype).setAsString('UTF8');
126			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
127			Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
128			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
129			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable2);
130
131			UpdateDatabase(Attachment);
132			QueryDatabase(Attachment);
133			Attachment.DropDatabase;
134			end;
135
136			initialization
137			RegisterTest(TTest15);
138			end.
139