ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/testsuite/Test6.pas
Revision: 110
Committed: Thu Jan 18 14:37:51 2018 UTC (6 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 6889 byte(s)
Log Message:
Fixes Merged

File Contents

# Content
1 unit Test6;
2 {$IFDEF MSWINDOWS}
3 {$DEFINE WINDOWS}
4 {$ENDIF}
5
6 {$IFDEF FPC}
7 {$mode delphi}
8 {$codepage UTF8}
9 {$ENDIF}
10
11 {Test 6: Blob Handling}
12
13 {
14 1. Create an empty database and populate with a single table and stored procedure
15 returning a blob.
16
17 2. Show the character sets available (List RDB$CHARACTER_SETS)
18
19 3. Select all from new table and show metadata.
20
21 4. Insert row and include WIN1252 characters known to be in two byte UTF8, plus Fixed point
22
23 5. Select all from new table
24
25 6. Use Update Query to set blob field with plain text loaded from file
26
27 7. Select all from new table
28
29 8. Add another row with a null blob
30
31 9. Update this row's blob field with a copy of the first row (demo of blob assignment)
32
33 10. Select all from new table.
34
35 11. Drop Database and repeat above but with no default connection character set.
36 }
37
38 interface
39
40 uses
41 Classes, SysUtils, TestManager, IB;
42
43 type
44
45 { TTest6 }
46
47 TTest6 = class(TTestBase)
48 private
49 procedure UpdateDatabase(Attachment: IAttachment);
50 procedure ExecProc(Attachment: IAttachment);
51 public
52 function TestTitle: AnsiString; override;
53 procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
54 end;
55
56 implementation
57
58 const
59 sqlCreateTable =
60 'Create Table TestData ('+
61 'RowID Integer not null,'+
62 'FixedPoint Decimal(8,2), '+
63 'FloatingPoint Double Precision, '+
64 'Title VarChar(32) Character Set UTF8,'+
65 'BlobData Blob sub_type 1 Character Set UTF8,'+
66 'Primary Key(RowID)'+
67 ')';
68
69 sqlCreateProc =
70 'Create Procedure TestProc (RowID Integer) '+
71 'Returns (BlobData Blob sub_type 1 Character Set UTF8) '+
72 'As ' +
73 'Begin ' +
74 ' Select BlobData From TestData Where RowID = :RowID Into :BlobData; '+
75 'End';
76
77
78 sqlGetCharSets = 'Select RDB$CHARACTER_SET_NAME,RDB$CHARACTER_SET_ID from RDB$CHARACTER_SETS order by 2';
79
80 sqlInsert = 'Insert into TestData(RowID,Title,FixedPoint,FloatingPoint) Values(:RowID,:Title,:FP, :DP)';
81
82 sqlUpdate = 'Update TestData Set BlobData = ? Where RowID = ?';
83
84 sqlExecProc = 'Execute Procedure TestProc ?';
85
86
87 { TTest6 }
88
89 procedure TTest6.UpdateDatabase(Attachment: IAttachment);
90 var Transaction: ITransaction;
91 Statement,
92 Statement2: IStatement;
93 ResultSet: IResultSet;
94 i: integer;
95 begin
96 Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
97
98 Statement := Attachment.Prepare(Transaction,sqlGetCharSets);
99 PrintMetaData(Statement.GetMetaData);
100 ReportResults(Statement);
101 Statement := Attachment.Prepare(Transaction,'Select * from TestData');
102 PrintMetaData(Statement.GetMetaData);
103 Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
104 ParamInfo(Statement.SQLParams);
105 with Statement.GetSQLParams do
106 begin
107 ByName('rowid').AsInteger := 1;
108 ByName('title').AsString := 'Blob Test ©€';
109 ByName('Fp').AsDouble := 20.28;
110 ByName('DP').AsDouble := 3.142;
111 end;
112 Statement.Execute;
113 Statement := Attachment.Prepare(Transaction,'Select * from TestData');
114 ReportResults(Statement);
115
116
117 Statement := Attachment.Prepare(Transaction,sqlUpdate);
118 ParamInfo(Statement.SQLParams);
119 Statement.SQLParams[0].AsBlob := Attachment.CreateBlob(Transaction,'TestData','BlobData').LoadFromFile('testtext.txt');
120 Statement.SQLParams[1].AsInteger := 1;
121 Statement.Execute;
122 Statement := Attachment.Prepare(Transaction,'Select * from TestData');
123 ReportResults(Statement);
124
125 {second row}
126 Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
127 ParamInfo(Statement.SQLParams);
128 with Statement.GetSQLParams do
129 begin
130 ByName('rowid').AsInteger := 2;
131 ByName('title').AsString := 'Blob Test ©€';
132 ByName('Fp').Clear;
133 ByName('DP').Clear;
134 end;
135 Statement.Execute;
136 Statement := Attachment.Prepare(Transaction,'Select * from TestData Where rowid = 1');
137 ResultSet := Statement.OpenCursor;
138 if ResultSet.FetchNext then
139 begin
140 Statement2 := Attachment.Prepare(Transaction,sqlUpdate);
141 Statement2.SQLParams[0].AsBlob := ResultSet.ByName('BlobData').AsBlob; {test duplication of blob}
142 Statement2.SQLParams[1].AsInteger := 2;
143 Statement2.Execute;
144 Statement := Attachment.Prepare(Transaction,'Select * from TestData');
145 ReportResults(Statement);
146 end;
147 end;
148
149 procedure TTest6.ExecProc(Attachment: IAttachment);
150 var Transaction: ITransaction;
151 Statement: IStatement;
152 Results: IResults;
153 begin
154 writeln('Testing Blob as stored proc parameter');
155 Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
156
157 Statement := Attachment.Prepare(Transaction,sqlExecProc);
158 PrintMetaData(Statement.GetMetaData);
159 Statement.SQLParams[0].AsInteger := 1;
160 Results := Statement.Execute;
161 ReportResult(Results);
162 end;
163
164 function TTest6.TestTitle: AnsiString;
165 begin
166 Result := 'Test 6: Blob Handling';
167 end;
168
169 procedure TTest6.RunTest(CharSet: AnsiString; SQLDialect: integer);
170 var DPB: IDPB;
171 Attachment: IAttachment;
172 begin
173 DPB := FirebirdAPI.AllocateDPB;
174 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
175 DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
176 DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
177 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
178 Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
179 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
180 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateProc);
181 UpdateDatabase(Attachment);
182 ExecProc(Attachment);
183
184 Attachment.DropDatabase;
185
186 {Repeat with WIN1252}
187 DPB := FirebirdAPI.AllocateDPB;
188 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
189 DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
190 DPB.Add(isc_dpb_lc_ctype).setAsString('WIN1252');
191 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
192 Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
193 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
194 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateProc);
195 UpdateDatabase(Attachment);
196 ExecProc(Attachment);
197
198 Attachment.DropDatabase;
199
200 {Repeat with no lc_ctype}
201 DPB := FirebirdAPI.AllocateDPB;
202 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
203 DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
204 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
205 Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
206 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
207 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateProc);
208 UpdateDatabase(Attachment);
209 ExecProc(Attachment);
210
211 Attachment.DropDatabase;
212 end;
213
214 initialization
215 RegisterTest(TTest6);
216 end.
217