fbintf/testsuite/Test15.pas

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

type
      { TTest15 }

  TTest15 = class(TTestBase)
  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;

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