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-2020 Tony Whyman, MWA Software
|
21 |
* (http://www.mwasoftware.co.uk).
|
22 |
*
|
23 |
* All Rights Reserved.
|
24 |
*
|
25 |
* Contributor(s): ______________________________________.
|
26 |
*
|
27 |
*)
|
28 |
unit FBTestApp;
|
29 |
|
30 |
{$IFDEF MSWINDOWS}
|
31 |
{$DEFINE WINDOWS}
|
32 |
{$ENDIF}
|
33 |
|
34 |
{$IFDEF FPC}
|
35 |
{$mode delphi}
|
36 |
{$codepage utf8}
|
37 |
{$ENDIF}
|
38 |
|
39 |
interface
|
40 |
|
41 |
uses
|
42 |
Classes, SysUtils, TestApplication, IB;
|
43 |
|
44 |
type
|
45 |
|
46 |
{ TFBTestBase }
|
47 |
|
48 |
TFBTestBase = class(TTestBase)
|
49 |
protected
|
50 |
function GetTestID: AnsiString; override;
|
51 |
function GetTestTitle: AnsiString; override;
|
52 |
function WriteServiceQueryResult(QueryResult: IServiceQueryResults): boolean;
|
53 |
procedure writeLicence(Item: IServiceQueryResultItem);
|
54 |
procedure WriteConfig(config: IServiceQueryResultItem);
|
55 |
procedure WriteUsers(users: IServiceQueryResultItem);
|
56 |
procedure WriteDBAttachments(att: IServiceQueryResultItem);
|
57 |
procedure WriteLimboTransactions(limbo: IServiceQueryResultItem);
|
58 |
end;
|
59 |
|
60 |
implementation
|
61 |
|
62 |
function TFBTestBase.GetTestID: AnsiString;
|
63 |
var s: AnsiString;
|
64 |
i,j: integer;
|
65 |
begin
|
66 |
i := 1;
|
67 |
s := TestTitle;
|
68 |
while not (s[i] in ['0'..'9']) and (i <= Length(s)) do inc(i);
|
69 |
j := i + 1;
|
70 |
while (s[j] in ['0'..'9']) and (i <= Length(s)) do inc(j);
|
71 |
Result := system.copy(s,i,j-i);
|
72 |
if Length(Result) = 1 then
|
73 |
Result := '0' + Result;
|
74 |
end;
|
75 |
|
76 |
function TFBTestBase.GetTestTitle: AnsiString;
|
77 |
begin
|
78 |
Result := '';
|
79 |
end;
|
80 |
|
81 |
function TFBTestBase.WriteServiceQueryResult(QueryResult: IServiceQueryResults): boolean;
|
82 |
var i: integer;
|
83 |
line: AnsiString;
|
84 |
begin
|
85 |
Result := true;
|
86 |
for i := 0 to QueryResult.GetCount - 1 do
|
87 |
with QueryResult[i] do
|
88 |
case getItemType of
|
89 |
isc_info_svc_version:
|
90 |
writeln(OutFile,'Service Manager Version = ',getAsInteger);
|
91 |
isc_info_svc_server_version:
|
92 |
writeln(OutFile,'Server Version = ',getAsString);
|
93 |
isc_info_svc_implementation:
|
94 |
writeln(OutFile,'Implementation = ',getAsString);
|
95 |
isc_info_svc_get_license:
|
96 |
writeLicence(QueryResult[i]);
|
97 |
isc_info_svc_get_license_mask:
|
98 |
writeln(OutFile,'Licence Mask = ',getAsInteger);
|
99 |
isc_info_svc_capabilities:
|
100 |
writeln(OutFile,'Capabilities = ',getAsInteger);
|
101 |
isc_info_svc_get_config:
|
102 |
WriteConfig(QueryResult[i]);
|
103 |
isc_info_svc_get_env:
|
104 |
writeln(OutFile,'Root Directory = ',getAsString);
|
105 |
isc_info_svc_get_env_lock:
|
106 |
writeln(OutFile,'Lock Directory = ',getAsString);
|
107 |
isc_info_svc_get_env_msg:
|
108 |
writeln(OutFile,'Message File = ',getAsString);
|
109 |
isc_info_svc_user_dbpath:
|
110 |
writeln(OutFile,'Security File = ',getAsString);
|
111 |
isc_info_svc_get_licensed_users:
|
112 |
writeln(OutFile,'Max Licenced Users = ',getAsInteger);
|
113 |
isc_info_svc_get_users:
|
114 |
WriteUsers(QueryResult[i]);
|
115 |
isc_info_svc_svr_db_info:
|
116 |
WriteDBAttachments(QueryResult[i]);
|
117 |
isc_info_svc_line:
|
118 |
begin
|
119 |
line := getAsString;
|
120 |
writeln(OutFile,line);
|
121 |
Result := line <> '';
|
122 |
end;
|
123 |
isc_info_svc_running:
|
124 |
writeln(OutFile,'Is Running = ',getAsInteger);
|
125 |
isc_info_svc_limbo_trans:
|
126 |
WriteLimboTransactions(QueryResult[i]);
|
127 |
isc_info_svc_to_eof,
|
128 |
isc_info_svc_timeout,
|
129 |
isc_info_truncated,
|
130 |
isc_info_data_not_ready,
|
131 |
isc_info_svc_stdin:
|
132 |
{ignore};
|
133 |
else
|
134 |
writeln(OutFile,'Unknown Service Response Item ', getItemType);
|
135 |
end;
|
136 |
writeln(OutFile);
|
137 |
end;
|
138 |
|
139 |
procedure TFBTestBase.writeLicence(Item: IServiceQueryResultItem);
|
140 |
var i: integer;
|
141 |
begin
|
142 |
for i := 0 to Item.getCount - 1 do
|
143 |
with Item[i] do
|
144 |
case getItemType of
|
145 |
isc_spb_lic_id:
|
146 |
writeln(OutFile,'Licence ID = ',GetAsString);
|
147 |
isc_spb_lic_key:
|
148 |
writeln(OutFile,'Licence Key = ',GetAsString);
|
149 |
end;
|
150 |
end;
|
151 |
|
152 |
procedure TFBTestBase.WriteConfig(config: IServiceQueryResultItem);
|
153 |
var i: integer;
|
154 |
begin
|
155 |
writeln(OutFile,'Firebird Configuration File');
|
156 |
for i := 0 to config.getCount - 1 do
|
157 |
writeln(OutFile,'Key = ',config[i].getItemType,', Value = ',config[i].getAsInteger);
|
158 |
writeln(OutFile);
|
159 |
end;
|
160 |
|
161 |
procedure TFBTestBase.WriteUsers(users: IServiceQueryResultItem);
|
162 |
var i: integer;
|
163 |
begin
|
164 |
writeln(OutFile,'Sec. Database User');
|
165 |
for i := 0 to users.getCount - 1 do
|
166 |
with users[i] do
|
167 |
case getItemType of
|
168 |
isc_spb_sec_username:
|
169 |
writeln(OutFile,'User Name = ',getAsString);
|
170 |
isc_spb_sec_firstname:
|
171 |
writeln(OutFile,'First Name = ',getAsString);
|
172 |
isc_spb_sec_middlename:
|
173 |
writeln(OutFile,'Middle Name = ',getAsString);
|
174 |
isc_spb_sec_lastname:
|
175 |
writeln(OutFile,'Last Name = ',getAsString);
|
176 |
isc_spb_sec_userid:
|
177 |
writeln(OutFile,'User ID = ',getAsInteger);
|
178 |
isc_spb_sec_groupid:
|
179 |
writeln(OutFile,'Group ID = ',getAsInteger);
|
180 |
else
|
181 |
writeln(OutFile,'Unknown user info ', getItemType);
|
182 |
end;
|
183 |
writeln(OutFile);
|
184 |
end;
|
185 |
|
186 |
procedure TFBTestBase.WriteDBAttachments(att: IServiceQueryResultItem);
|
187 |
var i: integer;
|
188 |
begin
|
189 |
writeln(OutFile,'DB Attachments');
|
190 |
for i := 0 to att.getCount - 1 do
|
191 |
with att[i] do
|
192 |
case getItemType of
|
193 |
isc_spb_num_att:
|
194 |
writeln(OutFile,'No. of Attachments = ',getAsInteger);
|
195 |
isc_spb_num_db:
|
196 |
writeln(OutFile,'Databases In Use = ',getAsInteger);
|
197 |
isc_spb_dbname:
|
198 |
writeln(OutFile,'DB Name = ',getAsString);
|
199 |
end;
|
200 |
end;
|
201 |
|
202 |
procedure TFBTestBase.WriteLimboTransactions(limbo: IServiceQueryResultItem);
|
203 |
var i: integer;
|
204 |
begin
|
205 |
writeln(OutFile,'Limbo Transactions');
|
206 |
for i := 0 to limbo.getCount - 1 do
|
207 |
with limbo[i] do
|
208 |
case getItemType of
|
209 |
isc_spb_single_tra_id:
|
210 |
writeln(OutFile,'Single DB Transaction = ',getAsInteger);
|
211 |
isc_spb_multi_tra_id:
|
212 |
writeln(OutFile,'Multi DB Transaction = ',getAsInteger);
|
213 |
isc_spb_tra_host_site:
|
214 |
writeln(OutFile,'Host Name = ',getAsString);
|
215 |
isc_spb_tra_advise:
|
216 |
writeln(OutFile,'Resolution Advisory = ',getAsInteger);
|
217 |
isc_spb_tra_remote_site:
|
218 |
writeln(OutFile,'Server Name = ',getAsString);
|
219 |
isc_spb_tra_db_path:
|
220 |
writeln(OutFile,'DB Primary File Name = ',getAsString);
|
221 |
isc_spb_tra_state:
|
222 |
begin
|
223 |
write(OutFile,'State = ');
|
224 |
case getAsInteger of
|
225 |
isc_spb_tra_state_limbo:
|
226 |
writeln(OutFile,'limbo');
|
227 |
isc_spb_tra_state_commit:
|
228 |
writeln(OutFile,'commit');
|
229 |
isc_spb_tra_state_rollback:
|
230 |
writeln(OutFile,'rollback');
|
231 |
isc_spb_tra_state_unknown:
|
232 |
writeln(OutFile,'Unknown');
|
233 |
end;
|
234 |
end;
|
235 |
end;
|
236 |
end;
|
237 |
|
238 |
end.
|
239 |
|