ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/testsuite/Test6.pas
Revision: 111
Committed: Thu Jan 18 14:37:53 2018 UTC (6 years, 3 months ago) by tony
Content type: text/x-pascal
File size: 6941 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. Execute Stored proc and display results
36
37 12. Drop Database and repeat above but with WIN1252 and no default connection character set.
38 }
39
40 interface
41
42 uses
43 Classes, SysUtils, TestManager, IB;
44
45 type
46
47 { TTest6 }
48
49 TTest6 = class(TTestBase)
50 private
51 procedure UpdateDatabase(Attachment: IAttachment);
52 procedure ExecProc(Attachment: IAttachment);
53 public
54 function TestTitle: AnsiString; override;
55 procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
56 end;
57
58 implementation
59
60 const
61 sqlCreateTable =
62 'Create Table TestData ('+
63 'RowID Integer not null,'+
64 'FixedPoint Decimal(8,2), '+
65 'FloatingPoint Double Precision, '+
66 'Title VarChar(32) Character Set UTF8,'+
67 'BlobData Blob sub_type 1 Character Set UTF8,'+
68 'Primary Key(RowID)'+
69 ')';
70
71 sqlCreateProc =
72 'Create Procedure TestProc (RowID Integer) '+
73 'Returns (BlobData Blob sub_type 1 Character Set UTF8) '+
74 'As ' +
75 'Begin ' +
76 ' Select BlobData From TestData Where RowID = :RowID Into :BlobData; '+
77 'End';
78
79
80 sqlGetCharSets = 'Select RDB$CHARACTER_SET_NAME,RDB$CHARACTER_SET_ID from RDB$CHARACTER_SETS order by 2';
81
82 sqlInsert = 'Insert into TestData(RowID,Title,FixedPoint,FloatingPoint) Values(:RowID,:Title,:FP, :DP)';
83
84 sqlUpdate = 'Update TestData Set BlobData = ? Where RowID = ?';
85
86 sqlExecProc = 'Execute Procedure TestProc ?';
87
88
89 { TTest6 }
90
91 procedure TTest6.UpdateDatabase(Attachment: IAttachment);
92 var Transaction: ITransaction;
93 Statement,
94 Statement2: IStatement;
95 ResultSet: IResultSet;
96 begin
97 Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
98
99 Statement := Attachment.Prepare(Transaction,sqlGetCharSets);
100 PrintMetaData(Statement.GetMetaData);
101 ReportResults(Statement);
102 Statement := Attachment.Prepare(Transaction,'Select * from TestData');
103 PrintMetaData(Statement.GetMetaData);
104 Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
105 ParamInfo(Statement.SQLParams);
106 with Statement.GetSQLParams do
107 begin
108 ByName('rowid').AsInteger := 1;
109 ByName('title').AsString := 'Blob Test ©€';
110 ByName('Fp').AsDouble := 20.28;
111 ByName('DP').AsDouble := 3.142;
112 end;
113 Statement.Execute;
114 Statement := Attachment.Prepare(Transaction,'Select * from TestData');
115 ReportResults(Statement);
116
117
118 Statement := Attachment.Prepare(Transaction,sqlUpdate);
119 ParamInfo(Statement.SQLParams);
120 Statement.SQLParams[0].AsBlob := Attachment.CreateBlob(Transaction,'TestData','BlobData').LoadFromFile('testtext.txt');
121 Statement.SQLParams[1].AsInteger := 1;
122 Statement.Execute;
123 Statement := Attachment.Prepare(Transaction,'Select * from TestData');
124 ReportResults(Statement);
125
126 {second row}
127 Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
128 ParamInfo(Statement.SQLParams);
129 with Statement.GetSQLParams do
130 begin
131 ByName('rowid').AsInteger := 2;
132 ByName('title').AsString := 'Blob Test ©€';
133 ByName('Fp').Clear;
134 ByName('DP').Clear;
135 end;
136 Statement.Execute;
137 Statement := Attachment.Prepare(Transaction,'Select * from TestData Where rowid = 1');
138 ResultSet := Statement.OpenCursor;
139 if ResultSet.FetchNext then
140 begin
141 Statement2 := Attachment.Prepare(Transaction,sqlUpdate);
142 Statement2.SQLParams[0].AsBlob := ResultSet.ByName('BlobData').AsBlob; {test duplication of blob}
143 Statement2.SQLParams[1].AsInteger := 2;
144 Statement2.Execute;
145 Statement := Attachment.Prepare(Transaction,'Select * from TestData');
146 ReportResults(Statement);
147 end;
148 end;
149
150 procedure TTest6.ExecProc(Attachment: IAttachment);
151 var Transaction: ITransaction;
152 Statement: IStatement;
153 Results: IResults;
154 begin
155 writeln(OutFile,'Testing Blob as stored proc parameter');
156 Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
157
158 Statement := Attachment.Prepare(Transaction,sqlExecProc);
159 PrintMetaData(Statement.GetMetaData);
160 Statement.SQLParams[0].AsInteger := 1;
161 Results := Statement.Execute;
162 ReportResult(Results);
163 end;
164
165 function TTest6.TestTitle: AnsiString;
166 begin
167 Result := 'Test 6: Blob Handling';
168 end;
169
170 procedure TTest6.RunTest(CharSet: AnsiString; SQLDialect: integer);
171 var DPB: IDPB;
172 Attachment: IAttachment;
173 begin
174 DPB := FirebirdAPI.AllocateDPB;
175 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
176 DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
177 DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
178 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
179 Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
180 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
181 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateProc);
182 UpdateDatabase(Attachment);
183 ExecProc(Attachment);
184
185 Attachment.DropDatabase;
186
187 {Repeat with WIN1252}
188 DPB := FirebirdAPI.AllocateDPB;
189 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
190 DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
191 DPB.Add(isc_dpb_lc_ctype).setAsString('WIN1252');
192 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
193 Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
194 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
195 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateProc);
196 UpdateDatabase(Attachment);
197 ExecProc(Attachment);
198
199 Attachment.DropDatabase;
200
201 {Repeat with no lc_ctype}
202 DPB := FirebirdAPI.AllocateDPB;
203 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
204 DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
205 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
206 Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
207 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
208 Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateProc);
209 UpdateDatabase(Attachment);
210 ExecProc(Attachment);
211
212 Attachment.DropDatabase;
213 end;
214
215 initialization
216 RegisterTest(TTest6);
217 end.
218