1 |
(*
|
2 |
* IBX Test suite. This program is used to test the IBX non-visual
|
3 |
* components and provides a semi-automated pass/fail check for each test.
|
4 |
*
|
5 |
* The contents of this file are subject to the Initial Developer's
|
6 |
* Public License Version 1.0 (the "License"); you may not use this
|
7 |
* file except in compliance with the License. You may obtain a copy
|
8 |
* of the License here:
|
9 |
*
|
10 |
* http://www.firebirdsql.org/index.php?op=doc&id=idpl
|
11 |
*
|
12 |
* Software distributed under the License is distributed on an "AS
|
13 |
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
14 |
* implied. See the License for the specific language governing rights
|
15 |
* and limitations under the License.
|
16 |
*
|
17 |
* The Initial Developer of the Original Code is Tony Whyman.
|
18 |
*
|
19 |
* The Original Code is (C) 2021 Tony Whyman, MWA Software
|
20 |
* (http://www.mwasoftware.co.uk).
|
21 |
*
|
22 |
* All Rights Reserved.
|
23 |
*
|
24 |
* Contributor(s): ______________________________________.
|
25 |
*
|
26 |
*)
|
27 |
unit Test08;
|
28 |
|
29 |
{$mode objfpc}{$H+}
|
30 |
|
31 |
{Test 8: TIBDataset: Locate, Bookmark and Lookup}
|
32 |
|
33 |
{ This test uses IBX to access the employee database in console mode.
|
34 |
The program opens the database, runs a query and writes the result to stdout.
|
35 |
It includes SQL parsing, and parameter setting prior to opening. The dataset
|
36 |
is also searched abd bookmarked
|
37 |
|
38 |
}
|
39 |
|
40 |
interface
|
41 |
|
42 |
uses
|
43 |
Classes, SysUtils, TestApplication, IBXTestBase, DB, IB, IBCustomDataSet, IBDatabase, IBQuery;
|
44 |
|
45 |
const
|
46 |
aTestID = '08';
|
47 |
aTestTitle = 'TIBDataset: Locate, Bookmark and Lookup';
|
48 |
|
49 |
type
|
50 |
|
51 |
{ TCalcQuery }
|
52 |
|
53 |
TCalcQuery = class(TIBQuery)
|
54 |
protected
|
55 |
procedure CreateFields; override;
|
56 |
end;
|
57 |
|
58 |
{ TTest08 }
|
59 |
|
60 |
TTest08 = class(TIBXTestBase)
|
61 |
private
|
62 |
FQuery: TIBQuery;
|
63 |
procedure HandleBeforeOpen(DataSet: TDataSet);
|
64 |
procedure HandleCalcFields(DataSet: TDataSet);
|
65 |
procedure PrintFields(aDataSet: TDataSet);
|
66 |
protected
|
67 |
procedure CreateObjects(Application: TTestApplication); override;
|
68 |
function GetTestID: AnsiString; override;
|
69 |
function GetTestTitle: AnsiString; override;
|
70 |
procedure InitTest; override;
|
71 |
public
|
72 |
procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
|
73 |
end;
|
74 |
|
75 |
|
76 |
implementation
|
77 |
|
78 |
uses Variants, DateUtils;
|
79 |
|
80 |
const
|
81 |
sqlExample =
|
82 |
'with recursive Depts As ( '+
|
83 |
'Select DEPT_NO, DEPARTMENT, HEAD_DEPT, cast(DEPARTMENT as VarChar(256)) as DEPT_PATH,'+
|
84 |
'cast(DEPT_NO as VarChar(64)) as DEPT_KEY_PATH '+
|
85 |
'From DEPARTMENT Where HEAD_DEPT is NULL '+
|
86 |
'UNION ALL '+
|
87 |
'Select D.DEPT_NO, D.DEPARTMENT, D.HEAD_DEPT, Depts.DEPT_PATH || '' / '' || D.DEPARTMENT as DEPT_PATH,'+
|
88 |
'Depts.DEPT_KEY_PATH || '';'' || D.DEPT_NO as DEPT_KEY_PATH '+
|
89 |
'From DEPARTMENT D '+
|
90 |
'JOIN Depts On D.HEAD_DEPT = Depts.DEPT_NO '+
|
91 |
')'+
|
92 |
|
93 |
'Select A.EMP_NO, A.FIRST_NAME, A.LAST_NAME, A.PHONE_EXT, A.HIRE_DATE, A.DEPT_NO, A.JOB_CODE,'+
|
94 |
'A.JOB_GRADE, A.JOB_COUNTRY, A.SALARY, A.FULL_NAME, D.DEPT_PATH, D.DEPT_KEY_PATH '+
|
95 |
'From EMPLOYEE A '+
|
96 |
'JOIN Depts D On D.DEPT_NO = A.DEPT_NO order by 1';
|
97 |
|
98 |
{ TCalcQuery }
|
99 |
|
100 |
procedure TCalcQuery.CreateFields;
|
101 |
var f: TFieldDef;
|
102 |
begin
|
103 |
FieldDefs.Update;
|
104 |
f := FieldDefs.AddFieldDef;
|
105 |
f.Name := 'HireYear';
|
106 |
f.DataType := ftInteger;
|
107 |
f.InternalCalcField := true;
|
108 |
f := FieldDefs.AddFieldDef;
|
109 |
f.Name := 'HireDatePlus1';
|
110 |
f.DataType := ftDate;
|
111 |
f.InternalCalcField := true;
|
112 |
inherited CreateFields;
|
113 |
FieldByName('HireYear').FieldKind := fkCalculated;
|
114 |
FieldByName('HireDatePlus1').FieldKind := fkCalculated;
|
115 |
end;
|
116 |
|
117 |
{ TTest08 }
|
118 |
|
119 |
procedure TTest08.HandleBeforeOpen(DataSet: TDataSet);
|
120 |
begin
|
121 |
(Dataset as TIBParserDataset).Parser.Add2WhereClause('A.HIRE_DATE < :HIREDATE');
|
122 |
(DataSet as TIBQuery).ParamByName('HireDate').AsString := '1/5/1991';
|
123 |
end;
|
124 |
|
125 |
procedure TTest08.HandleCalcFields(DataSet: TDataSet);
|
126 |
begin
|
127 |
DataSet.FieldByName('HireYear').AsInteger := YearOf(DataSet.FieldByName('HIRE_DATE').AsDateTime);
|
128 |
DataSet.FieldByName('HireDatePlus1').AsDateTime := DataSet.FieldByName('HIRE_DATE').AsDateTime + 1;
|
129 |
end;
|
130 |
|
131 |
procedure TTest08.PrintFields(aDataSet: TDataSet);
|
132 |
var i: integer;
|
133 |
begin
|
134 |
for i := 0 to aDataSet.Fields.Count - 1 do
|
135 |
with aDataSet.Fields[i] do
|
136 |
writeln(OutFile,'Field No ',FieldNo,' Name = ',FieldName, ' DataType = ',DataType);
|
137 |
end;
|
138 |
|
139 |
procedure TTest08.CreateObjects(Application: TTestApplication);
|
140 |
begin
|
141 |
inherited CreateObjects(Application);
|
142 |
FQuery := TCalcQuery.Create(Application);
|
143 |
FQuery.Database := IBDatabase;
|
144 |
FQuery.BeforeOpen := @HandleBeforeOpen;
|
145 |
FQuery.OnCalcFields := @HandleCalcFields;
|
146 |
end;
|
147 |
|
148 |
function TTest08.GetTestID: AnsiString;
|
149 |
begin
|
150 |
Result := aTestID;
|
151 |
end;
|
152 |
|
153 |
function TTest08.GetTestTitle: AnsiString;
|
154 |
begin
|
155 |
Result := aTestTitle;
|
156 |
end;
|
157 |
|
158 |
procedure TTest08.InitTest;
|
159 |
begin
|
160 |
inherited InitTest;
|
161 |
IBDatabase.DatabaseName := Owner.GetEmployeeDatabaseName;
|
162 |
ReadOnlyTransaction;
|
163 |
FQuery.SQL.Text := sqlExample;
|
164 |
end;
|
165 |
|
166 |
procedure TTest08.RunTest(CharSet: AnsiString; SQLDialect: integer);
|
167 |
var stats: TPerfCounters;
|
168 |
aBookmark: TBookmark;
|
169 |
aResultFields: variant;
|
170 |
i: integer;
|
171 |
begin
|
172 |
with FQuery do
|
173 |
begin
|
174 |
AllowAutoActivateTransaction := true;
|
175 |
Active := true;
|
176 |
PrintFields(FQuery);
|
177 |
if Locate('EMP_NO', 12, []) then
|
178 |
PrintDataSetRow(FQuery)
|
179 |
else
|
180 |
begin
|
181 |
writeln(OutFile,'Error: Row not found for EMP_NO = 12');
|
182 |
Exit;
|
183 |
end;
|
184 |
|
185 |
aBookmark := Bookmark;
|
186 |
if Locate('FIRST_NAME;LAST_NAME', VarArrayOf(['roger','Reeves']), [loCaseInsensitive]) then
|
187 |
PrintDataSetRow(FQuery)
|
188 |
else
|
189 |
begin
|
190 |
writeln(OutFile,'Error: Row not found for Roger Reeves');
|
191 |
Exit;
|
192 |
end;
|
193 |
Bookmark := aBookmark;
|
194 |
writeln(OutFile,'Back to EMP_NO = 12');
|
195 |
PrintDataSetRow(FQuery);
|
196 |
|
197 |
writeln(OutFile,'Locate Employee 20, First Name and Last Name');
|
198 |
aResultFields := Lookup('EMP_NO',20,'FIRST_NAME;LAST_NAME');
|
199 |
if varType(aResultFields) <> varNull then
|
200 |
begin
|
201 |
for i := VarArrayLowBound(aResultFields,1) to VarArrayHighBound(aResultFields,1) do
|
202 |
writeln(OutFile,'Field No. ',i,' = ',aResultFields[i]);
|
203 |
end
|
204 |
else
|
205 |
begin
|
206 |
writeln(OutFile,'Lookup Failed');
|
207 |
Exit;
|
208 |
end;
|
209 |
|
210 |
|
211 |
writeln(OutFile);
|
212 |
writeln(OutFile,'Print All');
|
213 |
PrintDataSet(FQuery);
|
214 |
Active := false;
|
215 |
end;
|
216 |
end;
|
217 |
|
218 |
initialization
|
219 |
RegisterTest(TTest08);
|
220 |
|
221 |
end.
|
222 |
|