ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/testsuite/Test15.pas
Revision: 379
Committed: Mon Jan 10 10:08:03 2022 UTC (2 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 5845 byte(s)
Log Message:
set line ending property

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 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

Properties

Name Value
svn:eol-style native