ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/testsuite/Test15.pas
Revision: 315
Committed: Thu Feb 25 11:56:36 2021 UTC (3 years, 1 month ago) by tony
Content type: text/x-pascal
File size: 5235 byte(s)
Log Message:
Updated for IBX 4 release

File Contents

# 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 BPB := Attachment.AllocateBPB;
113 BPB.Add(isc_bpb_target_type).AsInteger := 1;
114 BPB.Add(isc_bpb_target_interp).AsInteger := 4; {utf8}
115 BPB.Add(isc_bpb_source_type).AsInteger := 1;
116 BPB.Add(isc_bpb_source_interp).AsInteger := 53; {WIN1252}
117 aText := #$C9#$63#$6F#$75#$74#$65#$20#$6D#$6F#$69; {Écoute moi' encoded in Win1252}
118 aBlob := Attachment.CreateBlob(Transaction,'TestData2','BlobData',BPB).SetString(aText);
119 Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert2);
120 with Statement.GetSQLParams do
121 begin
122 ByName('rowid').AsInteger := 1;
123 ByName('title').AsString := 'Blob Test';
124 ByName('BlobData').AsBlob := aBlob;
125 end;
126 Statement.Execute;
127 end;
128
129 procedure TTest15.QueryDatabase(Attachment: IAttachment);
130 var Transaction: ITransaction;
131 Statement: IStatement;
132 begin
133 Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
134 Statement := Attachment.Prepare(Transaction,'Select * from TestData ');
135 writeln(OutFile);
136 writeln(OutFile,'Testdata');
137 writeln(OutFile);
138 ReportResults(Statement);
139 Statement := Attachment.Prepare(Transaction,'Select * from TestData2 ');
140 writeln(OutFile);
141 writeln(OutFile,'Testdata 2');
142 writeln(OutFile);
143 ReportResults(Statement);
144 end;
145
146 function TTest15.TestTitle: AnsiString;
147 begin
148 Result := 'Test 15: Blob Handling and BPBs';
149 end;
150
151 procedure TTest15.RunTest(CharSet: AnsiString; SQLDialect: integer);
152 var DPB: IDPB;
153 Attachment: IAttachment;
154 begin
155 DPB := FirebirdAPI.AllocateDPB;
156 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
157 DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
158 DPB.Add(isc_dpb_lc_ctype).setAsString('UTF8');
159 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
160 Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
161 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
162 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable2);
163
164 UpdateDatabase(Attachment);
165 QueryDatabase(Attachment);
166 Attachment.DropDatabase;
167 end;
168
169 initialization
170 RegisterTest(TTest15);
171 end.
172