1 |
unit TestManager;
|
2 |
{$IFDEF MSWINDOWS}
|
3 |
{$DEFINE WINDOWS}
|
4 |
{$ENDIF}
|
5 |
|
6 |
{$IFDEF FPC}
|
7 |
{$mode delphi}
|
8 |
{$codepage utf8}
|
9 |
{$ENDIF}
|
10 |
|
11 |
interface
|
12 |
|
13 |
uses
|
14 |
Classes, SysUtils, IB;
|
15 |
|
16 |
type
|
17 |
TTestManager = class;
|
18 |
|
19 |
{ TTestBase }
|
20 |
|
21 |
TTestBase = class
|
22 |
private
|
23 |
FOwner: TTestManager;
|
24 |
protected
|
25 |
FHexStrings: boolean;
|
26 |
function ReportResults(Statement: IStatement): IResultSet;
|
27 |
procedure ReportResult(aValue: IResults);
|
28 |
procedure PrintHexString(s: AnsiString);
|
29 |
procedure PrintDPB(DPB: IDPB);
|
30 |
procedure PrintMetaData(meta: IMetaData);
|
31 |
procedure ParamInfo(SQLParams: ISQLParams);
|
32 |
procedure WriteArray(ar: IArray);
|
33 |
procedure WriteAffectedRows(Statement: IStatement);
|
34 |
function WriteServiceQueryResult(QueryResult: IServiceQueryResults): boolean;
|
35 |
procedure writeLicence(Item: IServiceQueryResultItem);
|
36 |
procedure WriteConfig(config: IServiceQueryResultItem);
|
37 |
procedure WriteUsers(users: IServiceQueryResultItem);
|
38 |
procedure WriteDBAttachments(att: IServiceQueryResultItem);
|
39 |
procedure WriteLimboTransactions(limbo: IServiceQueryResultItem);
|
40 |
procedure WriteDBInfo(DBInfo: IDBInformation);
|
41 |
procedure WriteBytes(Bytes: TByteArray);
|
42 |
procedure WriteOperationCounts(Category: AnsiString; ops: TDBOperationCounts);
|
43 |
procedure WritePerfStats(stats: TPerfCounters);
|
44 |
procedure CheckActivity(Attachment: IAttachment); overload;
|
45 |
procedure CheckActivity(Transaction: ITransaction); overload;
|
46 |
public
|
47 |
constructor Create(aOwner: TTestManager); virtual;
|
48 |
function TestTitle: AnsiString; virtual; abstract;
|
49 |
procedure RunTest(CharSet: AnsiString; SQLDialect: integer); virtual; abstract;
|
50 |
property Owner: TTestManager read FOwner;
|
51 |
end;
|
52 |
|
53 |
TTest = class of TTestBase;
|
54 |
|
55 |
{ TTestManager }
|
56 |
|
57 |
TTestManager = class
|
58 |
private
|
59 |
FTests: TList;
|
60 |
FEmployeeDatabaseName: AnsiString;
|
61 |
FNewDatabaseName: AnsiString;
|
62 |
FSecondNewDatabaseName: AnsiString;
|
63 |
FUserName: AnsiString;
|
64 |
FPassword: AnsiString;
|
65 |
FBackupFileName: AnsiString;
|
66 |
FShowStatistics: boolean;
|
67 |
procedure CleanUp;
|
68 |
public
|
69 |
constructor Create;
|
70 |
destructor Destroy; override;
|
71 |
function GetUserName: AnsiString;
|
72 |
function GetPassword: AnsiString;
|
73 |
function GetEmployeeDatabaseName: AnsiString;
|
74 |
function GetNewDatabaseName: AnsiString;
|
75 |
function GetSecondNewDatabaseName: AnsiString;
|
76 |
function GetBackupFileName: AnsiString;
|
77 |
procedure RunAll;
|
78 |
procedure Run(TestID: integer);
|
79 |
procedure SetUserName(aValue: AnsiString);
|
80 |
procedure SetPassword(aValue: AnsiString);
|
81 |
procedure SetEmployeeDatabaseName(aValue: AnsiString);
|
82 |
procedure SetNewDatabaseName(aValue: AnsiString);
|
83 |
procedure SetSecondNewDatabaseName(aValue: AnsiString);
|
84 |
procedure SetBackupFileName(aValue: AnsiString);
|
85 |
property ShowStatistics: boolean read FShowStatistics write FShowStatistics;
|
86 |
end;
|
87 |
|
88 |
var
|
89 |
TestMgr: TTestManager = nil;
|
90 |
|
91 |
var OutFile: text;
|
92 |
|
93 |
procedure RegisterTest(aTest: TTest);
|
94 |
|
95 |
implementation
|
96 |
|
97 |
{$IFDEF MSWINDOWS}
|
98 |
uses windows;
|
99 |
|
100 |
function GetTempDir: AnsiString;
|
101 |
var
|
102 |
tempFolder: array[0..MAX_PATH] of Char;
|
103 |
begin
|
104 |
GetTempPath(MAX_PATH, @tempFolder);
|
105 |
result := StrPas(tempFolder);
|
106 |
end;
|
107 |
{$ENDIF}
|
108 |
|
109 |
procedure RegisterTest(aTest: TTest);
|
110 |
begin
|
111 |
if TestMgr = nil then
|
112 |
TestMgr := TTestManager.Create;
|
113 |
TestMgr.FTests.Add(aTest.Create(TestMgr));
|
114 |
end;
|
115 |
|
116 |
{ TTestBase }
|
117 |
|
118 |
constructor TTestBase.Create(aOwner: TTestManager);
|
119 |
begin
|
120 |
inherited Create;
|
121 |
FOwner := aOwner;
|
122 |
end;
|
123 |
|
124 |
|
125 |
function TTestBase.ReportResults(Statement: IStatement): IResultSet;
|
126 |
begin
|
127 |
Result := Statement.OpenCursor;
|
128 |
try
|
129 |
while Result.FetchNext do
|
130 |
ReportResult(Result);
|
131 |
finally
|
132 |
Result.Close;
|
133 |
end;
|
134 |
writeln(OutFile);
|
135 |
end;
|
136 |
|
137 |
procedure TTestBase.ReportResult(aValue: IResults);
|
138 |
var i: integer;
|
139 |
s: AnsiString;
|
140 |
begin
|
141 |
for i := 0 to aValue.getCount - 1 do
|
142 |
begin
|
143 |
if aValue[i].IsNull then
|
144 |
writeln(OutFile,aValue[i].Name,' = NULL')
|
145 |
else
|
146 |
case aValue[i].SQLType of
|
147 |
SQL_ARRAY:
|
148 |
begin
|
149 |
if not aValue[i].IsNull then
|
150 |
WriteArray(aValue[i].AsArray);
|
151 |
end;
|
152 |
SQL_FLOAT,SQL_DOUBLE,
|
153 |
SQL_D_FLOAT:
|
154 |
writeln(OutFile, aValue[i].Name,' = ',FormatFloat('#,##0.00',aValue[i].AsFloat));
|
155 |
|
156 |
SQL_INT64:
|
157 |
if aValue[i].Scale <> 0 then
|
158 |
writeln(OutFile, aValue[i].Name,' = ',FormatFloat('#,##0.00',aValue[i].AsFloat))
|
159 |
else
|
160 |
writeln(OutFile,aValue[i].Name,' = ',aValue[i].AsString);
|
161 |
|
162 |
SQL_BLOB:
|
163 |
if aValue[i].IsNull then
|
164 |
writeln(OutFile,aValue[i].Name,' = (null blob)')
|
165 |
else
|
166 |
if aValue[i].SQLSubType = 1 then
|
167 |
begin
|
168 |
s := aValue[i].AsString;
|
169 |
if FHexStrings then
|
170 |
begin
|
171 |
write(OutFile,aValue[i].Name,' = ');
|
172 |
PrintHexString(s);
|
173 |
writeln(OutFile,' (Charset Id = ',aValue[i].GetCharSetID, ' Codepage = ',StringCodePage(s),')');
|
174 |
end
|
175 |
else
|
176 |
begin
|
177 |
writeln(OutFile,aValue[i].Name,' (Charset Id = ',aValue[i].GetCharSetID, ' Codepage = ',StringCodePage(s),')');
|
178 |
writeln(OutFile);
|
179 |
writeln(OutFile,s);
|
180 |
end
|
181 |
end
|
182 |
else
|
183 |
writeln(OutFile,aValue[i].Name,' = (blob), Length = ',aValue[i].AsBlob.GetBlobSize);
|
184 |
|
185 |
SQL_TEXT,SQL_VARYING:
|
186 |
begin
|
187 |
s := aValue[i].AsString;
|
188 |
if FHexStrings then
|
189 |
begin
|
190 |
write(OutFile,aValue[i].Name,' = ');
|
191 |
PrintHexString(s);
|
192 |
writeln(OutFile,' (Charset Id = ',aValue[i].GetCharSetID, ' Codepage = ',StringCodePage(s),')');
|
193 |
end
|
194 |
else
|
195 |
if aValue[i].GetCharSetID > 0 then
|
196 |
writeln(OutFile,aValue[i].Name,' = ',s,' (Charset Id = ',aValue[i].GetCharSetID, ' Codepage = ',StringCodePage(s),')')
|
197 |
else
|
198 |
writeln(OutFile,aValue[i].Name,' = ',s);
|
199 |
end;
|
200 |
|
201 |
else
|
202 |
writeln(OutFile,aValue[i].Name,' = ',aValue[i].AsString);
|
203 |
end;
|
204 |
end;
|
205 |
end;
|
206 |
|
207 |
procedure TTestBase.PrintHexString(s: AnsiString);
|
208 |
var i: integer;
|
209 |
begin
|
210 |
for i := 1 to length(s) do
|
211 |
write(OutFile,Format('%x ',[byte(s[i])]));
|
212 |
end;
|
213 |
|
214 |
procedure TTestBase.PrintDPB(DPB: IDPB);
|
215 |
var i: integer;
|
216 |
begin
|
217 |
writeln(OutFile,'DPB');
|
218 |
writeln(OutFile,'Count = ', DPB.getCount);
|
219 |
for i := 0 to DPB.getCount - 1 do
|
220 |
writeln(OutFile,DPB[i].getParamType,' = ', DPB[i].AsString);
|
221 |
writeln(OutFile);
|
222 |
end;
|
223 |
|
224 |
procedure TTestBase.PrintMetaData(meta: IMetaData);
|
225 |
var i, j: integer;
|
226 |
ar: IArrayMetaData;
|
227 |
bm: IBlobMetaData;
|
228 |
Bounds: TArrayBounds;
|
229 |
begin
|
230 |
writeln(OutFile,'Metadata');
|
231 |
for i := 0 to meta.GetCount - 1 do
|
232 |
with meta[i] do
|
233 |
begin
|
234 |
writeln(OutFile,'SQLType =',GetSQLTypeName);
|
235 |
writeln(OutFile,'sub type = ',getSubType);
|
236 |
writeln(OutFile,'Table = ',getRelationName);
|
237 |
writeln(OutFile,'Owner = ',getOwnerName);
|
238 |
writeln(OutFile,'Column Name = ',getSQLName);
|
239 |
writeln(OutFile,'Alias Name = ',getAliasName);
|
240 |
writeln(OutFile,'Field Name = ',getName);
|
241 |
writeln(OutFile,'Scale = ',getScale);
|
242 |
writeln(OutFile,'Charset id = ',getCharSetID);
|
243 |
if getIsNullable then writeln(OutFile,'Nullable') else writeln(OutFile,'Not Null');
|
244 |
writeln(OutFile,'Size = ',GetSize);
|
245 |
case getSQLType of
|
246 |
SQL_ARRAY:
|
247 |
begin
|
248 |
writeln(OutFile,'Array Meta Data:');
|
249 |
ar := GetArrayMetaData;
|
250 |
writeln(OutFile,'SQLType =',ar.GetSQLTypeName);
|
251 |
writeln(OutFile,'Scale = ',ar.getScale);
|
252 |
writeln(OutFile,'Charset id = ',ar.getCharSetID);
|
253 |
writeln(OutFile,'Size = ',ar.GetSize);
|
254 |
writeln(OutFile,'Table = ',ar.GetTableName);
|
255 |
writeln(OutFile,'Column = ',ar.GetColumnName);
|
256 |
writeln(OutFile,'Dimensions = ',ar.GetDimensions);
|
257 |
write(OutFile,'Bounds: ');
|
258 |
Bounds := ar.GetBounds;
|
259 |
for j := 0 to Length(Bounds) - 1 do
|
260 |
write(OutFile,'(',Bounds[j].LowerBound,':',Bounds[j].UpperBound,') ');
|
261 |
writeln(OutFile);
|
262 |
end;
|
263 |
SQL_BLOB:
|
264 |
begin
|
265 |
writeln(OutFile);
|
266 |
writeln(OutFile,'Blob Meta Data');
|
267 |
bm := GetBlobMetaData;
|
268 |
writeln(OutFile,'SQL SubType =',bm.GetSubType);
|
269 |
writeln(OutFile,'Table = ',bm.GetRelationName);
|
270 |
writeln(OutFile,'Column = ',bm.GetColumnName);
|
271 |
writeln(OutFile,'CharSetID = ',bm.GetCharSetID);
|
272 |
writeln(OutFile,'Segment Size = ',bm.GetSegmentSize);
|
273 |
writeln(OutFile);
|
274 |
end;
|
275 |
end;
|
276 |
writeln(OutFile);
|
277 |
end;
|
278 |
end;
|
279 |
|
280 |
procedure TTestBase.ParamInfo(SQLParams: ISQLParams);
|
281 |
var i: integer;
|
282 |
begin
|
283 |
writeln(OutFile,'SQL Params');
|
284 |
for i := 0 to SQLParams.Count - 1 do
|
285 |
with SQLParams[i] do
|
286 |
begin
|
287 |
writeln(OutFile,'SQLType =',GetSQLTypeName);
|
288 |
writeln(OutFile,'sub type = ',getSubType);
|
289 |
writeln(OutFile,'Field Name = ',getName);
|
290 |
writeln(OutFile,'Scale = ',getScale);
|
291 |
writeln(OutFile,'Charset id = ',getCharSetID);
|
292 |
if getIsNullable then writeln(OutFile,'Nullable') else writeln(OutFile,'Not Null');
|
293 |
writeln(OutFile,'Size = ',GetSize);
|
294 |
writeln(OutFile);
|
295 |
end;
|
296 |
end;
|
297 |
|
298 |
procedure TTestBase.WriteArray(ar: IArray);
|
299 |
var Bounds: TArrayBounds;
|
300 |
i,j: integer;
|
301 |
begin
|
302 |
write(OutFile,'Array: ');
|
303 |
Bounds := ar.GetBounds;
|
304 |
case ar.GetDimensions of
|
305 |
1:
|
306 |
begin
|
307 |
for i := Bounds[0].LowerBound to Bounds[0].UpperBound do
|
308 |
write(OutFile,'(',i,': ',ar.GetAsVariant([i]),') ');
|
309 |
end;
|
310 |
|
311 |
2:
|
312 |
begin
|
313 |
for i := Bounds[0].LowerBound to Bounds[0].UpperBound do
|
314 |
for j := Bounds[1].LowerBound to Bounds[1].UpperBound do
|
315 |
write(OutFile,'(',i,',',j,': ',ar.GetAsVariant([i,j]),') ');
|
316 |
end;
|
317 |
end;
|
318 |
writeln(OutFile);
|
319 |
end;
|
320 |
|
321 |
procedure TTestBase.WriteAffectedRows(Statement: IStatement);
|
322 |
var SelectCount, InsertCount, UpdateCount, DeleteCount: integer;
|
323 |
begin
|
324 |
Statement.GetRowsAffected(SelectCount, InsertCount, UpdateCount, DeleteCount);
|
325 |
writeln(OutFile,'Select Count = ', SelectCount,' InsertCount = ',InsertCount,' UpdateCount = ', UpdateCount, ' DeleteCount = ',DeleteCount);
|
326 |
end;
|
327 |
|
328 |
function TTestBase.WriteServiceQueryResult(QueryResult: IServiceQueryResults): boolean;
|
329 |
var i: integer;
|
330 |
line: AnsiString;
|
331 |
begin
|
332 |
Result := true;
|
333 |
for i := 0 to QueryResult.GetCount - 1 do
|
334 |
with QueryResult[i] do
|
335 |
case getItemType of
|
336 |
isc_info_svc_version:
|
337 |
writeln(OutFile,'Service Manager Version = ',getAsInteger);
|
338 |
isc_info_svc_server_version:
|
339 |
writeln(OutFile,'Server Version = ',getAsString);
|
340 |
isc_info_svc_implementation:
|
341 |
writeln(OutFile,'Implementation = ',getAsString);
|
342 |
isc_info_svc_get_license:
|
343 |
writeLicence(QueryResult[i]);
|
344 |
isc_info_svc_get_license_mask:
|
345 |
writeln(OutFile,'Licence Mask = ',getAsInteger);
|
346 |
isc_info_svc_capabilities:
|
347 |
writeln(OutFile,'Capabilities = ',getAsInteger);
|
348 |
isc_info_svc_get_config:
|
349 |
WriteConfig(QueryResult[i]);
|
350 |
isc_info_svc_get_env:
|
351 |
writeln(OutFile,'Root Directory = ',getAsString);
|
352 |
isc_info_svc_get_env_lock:
|
353 |
writeln(OutFile,'Lock Directory = ',getAsString);
|
354 |
isc_info_svc_get_env_msg:
|
355 |
writeln(OutFile,'Message File = ',getAsString);
|
356 |
isc_info_svc_user_dbpath:
|
357 |
writeln(OutFile,'Security File = ',getAsString);
|
358 |
isc_info_svc_get_licensed_users:
|
359 |
writeln(OutFile,'Max Licenced Users = ',getAsInteger);
|
360 |
isc_info_svc_get_users:
|
361 |
WriteUsers(QueryResult[i]);
|
362 |
isc_info_svc_svr_db_info:
|
363 |
WriteDBAttachments(QueryResult[i]);
|
364 |
isc_info_svc_line:
|
365 |
begin
|
366 |
line := getAsString;
|
367 |
writeln(OutFile,line);
|
368 |
Result := line <> '';
|
369 |
end;
|
370 |
isc_info_svc_running:
|
371 |
writeln(OutFile,'Is Running = ',getAsInteger);
|
372 |
isc_info_svc_limbo_trans:
|
373 |
WriteLimboTransactions(QueryResult[i]);
|
374 |
isc_info_svc_to_eof,
|
375 |
isc_info_svc_timeout,
|
376 |
isc_info_truncated,
|
377 |
isc_info_data_not_ready,
|
378 |
isc_info_svc_stdin:
|
379 |
{ignore};
|
380 |
else
|
381 |
writeln(OutFile,'Unknown Service Response Item ', getItemType);
|
382 |
end;
|
383 |
writeln(OutFile);
|
384 |
end;
|
385 |
|
386 |
procedure TTestBase.writeLicence(Item: IServiceQueryResultItem);
|
387 |
var i: integer;
|
388 |
begin
|
389 |
for i := 0 to Item.getCount - 1 do
|
390 |
with Item[i] do
|
391 |
case getItemType of
|
392 |
isc_spb_lic_id:
|
393 |
writeln(OutFile,'Licence ID = ',GetAsString);
|
394 |
isc_spb_lic_key:
|
395 |
writeln(OutFile,'Licence Key = ',GetAsString);
|
396 |
end;
|
397 |
end;
|
398 |
|
399 |
procedure TTestBase.WriteConfig(config: IServiceQueryResultItem);
|
400 |
var i: integer;
|
401 |
begin
|
402 |
writeln(OutFile,'Firebird Configuration File');
|
403 |
for i := 0 to config.getCount - 1 do
|
404 |
writeln(OutFile,'Key = ',config[i].getItemType,', Value = ',config[i].getAsInteger);
|
405 |
writeln(OutFile);
|
406 |
end;
|
407 |
|
408 |
procedure TTestBase.WriteUsers(users: IServiceQueryResultItem);
|
409 |
var i: integer;
|
410 |
begin
|
411 |
writeln(OutFile,'Sec. Database User');
|
412 |
for i := 0 to users.getCount - 1 do
|
413 |
with users[i] do
|
414 |
case getItemType of
|
415 |
isc_spb_sec_username:
|
416 |
writeln(OutFile,'User Name = ',getAsString);
|
417 |
isc_spb_sec_firstname:
|
418 |
writeln(OutFile,'First Name = ',getAsString);
|
419 |
isc_spb_sec_middlename:
|
420 |
writeln(OutFile,'Middle Name = ',getAsString);
|
421 |
isc_spb_sec_lastname:
|
422 |
writeln(OutFile,'Last Name = ',getAsString);
|
423 |
isc_spb_sec_userid:
|
424 |
writeln(OutFile,'User ID = ',getAsInteger);
|
425 |
isc_spb_sec_groupid:
|
426 |
writeln(OutFile,'Group ID = ',getAsInteger);
|
427 |
else
|
428 |
writeln(OutFile,'Unknown user info ', getItemType);
|
429 |
end;
|
430 |
writeln(OutFile);
|
431 |
end;
|
432 |
|
433 |
procedure TTestBase.WriteDBAttachments(att: IServiceQueryResultItem);
|
434 |
var i: integer;
|
435 |
begin
|
436 |
writeln(OutFile,'DB Attachments');
|
437 |
for i := 0 to att.getCount - 1 do
|
438 |
with att[i] do
|
439 |
case getItemType of
|
440 |
isc_spb_num_att:
|
441 |
writeln(OutFile,'No. of Attachments = ',getAsInteger);
|
442 |
isc_spb_num_db:
|
443 |
writeln(OutFile,'Databases In Use = ',getAsInteger);
|
444 |
isc_spb_dbname:
|
445 |
writeln(OutFile,'DB Name = ',getAsString);
|
446 |
end;
|
447 |
end;
|
448 |
|
449 |
procedure TTestBase.WriteLimboTransactions(limbo: IServiceQueryResultItem);
|
450 |
var i: integer;
|
451 |
begin
|
452 |
writeln(OutFile,'Limbo Transactions');
|
453 |
for i := 0 to limbo.getCount - 1 do
|
454 |
with limbo[i] do
|
455 |
case getItemType of
|
456 |
isc_spb_single_tra_id:
|
457 |
writeln(OutFile,'Single DB Transaction = ',getAsInteger);
|
458 |
isc_spb_multi_tra_id:
|
459 |
writeln(OutFile,'Multi DB Transaction = ',getAsInteger);
|
460 |
isc_spb_tra_host_site:
|
461 |
writeln(OutFile,'Host Name = ',getAsString);
|
462 |
isc_spb_tra_advise:
|
463 |
writeln(OutFile,'Resolution Advisory = ',getAsInteger);
|
464 |
isc_spb_tra_remote_site:
|
465 |
writeln(OutFile,'Server Name = ',getAsString);
|
466 |
isc_spb_tra_db_path:
|
467 |
writeln(OutFile,'DB Primary File Name = ',getAsString);
|
468 |
isc_spb_tra_state:
|
469 |
begin
|
470 |
write(OutFile,'State = ');
|
471 |
case getAsInteger of
|
472 |
isc_spb_tra_state_limbo:
|
473 |
writeln(OutFile,'limbo');
|
474 |
isc_spb_tra_state_commit:
|
475 |
writeln(OutFile,'commit');
|
476 |
isc_spb_tra_state_rollback:
|
477 |
writeln(OutFile,'rollback');
|
478 |
isc_spb_tra_state_unknown:
|
479 |
writeln(OutFile,'Unknown');
|
480 |
end;
|
481 |
end;
|
482 |
end;
|
483 |
end;
|
484 |
|
485 |
procedure TTestBase.WriteDBInfo(DBInfo: IDBInformation);
|
486 |
var i, j: integer;
|
487 |
bytes: TByteArray;
|
488 |
ConType: integer;
|
489 |
DBFileName: AnsiString;
|
490 |
DBSiteName: AnsiString;
|
491 |
Version: byte;
|
492 |
VersionString: AnsiString;
|
493 |
Users: TStringList;
|
494 |
begin
|
495 |
for i := 0 to DBInfo.GetCount - 1 do
|
496 |
with DBInfo[i] do
|
497 |
case getItemType of
|
498 |
isc_info_db_read_only:
|
499 |
if getAsInteger <> 0 then
|
500 |
writeln(OutFile,'Database is Read Only')
|
501 |
else
|
502 |
writeln(OutFile,'Database is Read/Write');
|
503 |
isc_info_allocation:
|
504 |
writeln(OutFile,'Pages =',getAsInteger);
|
505 |
isc_info_base_level:
|
506 |
begin
|
507 |
bytes := getAsBytes;
|
508 |
write(OutFile,'Base Level = ');
|
509 |
WriteBytes(Bytes);
|
510 |
end;
|
511 |
isc_info_db_id:
|
512 |
begin
|
513 |
DecodeIDCluster(ConType,DBFileName,DBSiteName);
|
514 |
writeln(OutFile,'Database ID = ', ConType,' FB = ', DBFileName, ' SN = ',DBSiteName);
|
515 |
end;
|
516 |
isc_info_implementation:
|
517 |
begin
|
518 |
bytes := getAsBytes;
|
519 |
write(OutFile,'Implementation = ');
|
520 |
WriteBytes(Bytes);
|
521 |
end;
|
522 |
isc_info_no_reserve:
|
523 |
writeln(OutFile,'Reserved = ',getAsInteger);
|
524 |
isc_info_ods_minor_version:
|
525 |
writeln(OutFile,'ODS minor = ',getAsInteger);
|
526 |
isc_info_ods_version:
|
527 |
writeln(OutFile,'ODS major = ',getAsInteger);
|
528 |
isc_info_page_size:
|
529 |
writeln(OutFile,'Page Size = ',getAsInteger);
|
530 |
isc_info_version:
|
531 |
begin
|
532 |
DecodeVersionString(Version,VersionString);
|
533 |
writeln(OutFile,'Version = ',Version,': ',VersionString);
|
534 |
end;
|
535 |
isc_info_current_memory:
|
536 |
writeln(OutFile,'Server Memory = ',getAsInteger);
|
537 |
isc_info_forced_writes:
|
538 |
writeln(OutFile,'Forced Writes = ',getAsInteger);
|
539 |
isc_info_max_memory:
|
540 |
writeln(OutFile,'Max Memory = ',getAsInteger);
|
541 |
isc_info_num_buffers:
|
542 |
writeln(OutFile,'Num Buffers = ',getAsInteger);
|
543 |
isc_info_sweep_interval:
|
544 |
writeln(OutFile,'Sweep Interval = ',getAsInteger);
|
545 |
isc_info_user_names:
|
546 |
begin
|
547 |
Users := TStringList.Create;
|
548 |
try
|
549 |
write(OutFile,'Logged in Users: ');
|
550 |
DecodeUserNames(Users);
|
551 |
for j := 0 to Users.Count - 1 do
|
552 |
write(OutFile,Users[j],',');
|
553 |
|
554 |
finally
|
555 |
Users.Free;
|
556 |
end;
|
557 |
writeln(OutFile);
|
558 |
end;
|
559 |
isc_info_fetches:
|
560 |
writeln(OutFile,'Fetches = ',getAsInteger);
|
561 |
isc_info_marks:
|
562 |
writeln(OutFile,'Writes = ',getAsInteger);
|
563 |
isc_info_reads:
|
564 |
writeln(OutFile,'Reads = ',getAsInteger);
|
565 |
isc_info_writes:
|
566 |
writeln(OutFile,'Page Writes = ',getAsInteger);
|
567 |
isc_info_backout_count:
|
568 |
WriteOperationCounts('Record Version Removals',getOperationCounts);
|
569 |
isc_info_delete_count:
|
570 |
WriteOperationCounts('Deletes',getOperationCounts);
|
571 |
isc_info_expunge_count:
|
572 |
WriteOperationCounts('Expunge Count',getOperationCounts);
|
573 |
isc_info_insert_count:
|
574 |
WriteOperationCounts('Insert Count',getOperationCounts);
|
575 |
isc_info_purge_count:
|
576 |
WriteOperationCounts('Purge Count Countites',getOperationCounts);
|
577 |
isc_info_read_idx_count:
|
578 |
WriteOperationCounts('Indexed Reads Count',getOperationCounts);
|
579 |
isc_info_read_seq_count:
|
580 |
WriteOperationCounts('Sequential Table Scans',getOperationCounts);
|
581 |
isc_info_update_count:
|
582 |
WriteOperationCounts('Update Count',getOperationCounts);
|
583 |
isc_info_db_SQL_Dialect:
|
584 |
writeln(OutFile,'SQL Dialect = ',getAsInteger);
|
585 |
else
|
586 |
writeln(OutFile,'Unknown Response ',getItemType);
|
587 |
end;
|
588 |
end;
|
589 |
|
590 |
procedure TTestBase.WriteBytes(Bytes: TByteArray);
|
591 |
var i: integer;
|
592 |
begin
|
593 |
for i := 0 to length(Bytes) - 1 do
|
594 |
write(OutFile,Bytes[i],',');
|
595 |
writeln(OutFile);
|
596 |
end;
|
597 |
|
598 |
procedure TTestBase.WriteOperationCounts(Category: AnsiString;
|
599 |
ops: TDBOperationCounts);
|
600 |
var i: integer;
|
601 |
begin
|
602 |
writeln(OutFile,Category,' Operation Counts');
|
603 |
for i := 0 to Length(ops) - 1 do
|
604 |
begin
|
605 |
writeln(OutFile,'Table ID = ',ops[i].TableID);
|
606 |
writeln(OutFile,'Count = ',ops[i].Count);
|
607 |
end;
|
608 |
writeln(OutFile);
|
609 |
end;
|
610 |
|
611 |
procedure TTestBase.WritePerfStats(stats: TPerfCounters);
|
612 |
begin
|
613 |
writeln(OutFile,'Current memory = ', stats[psCurrentMemory]);
|
614 |
writeln(OutFile,'Delta memory = ', stats[psDeltaMemory]);
|
615 |
writeln(OutFile,'Max memory = ', stats[psMaxMemory]);
|
616 |
writeln(OutFile,'Elapsed time= ', FormatFloat('#0.000',stats[psRealTime]/1000),' sec');
|
617 |
writeln(OutFile,'Cpu = ', FormatFloat('#0.000',stats[psUserTime]/1000),' sec');
|
618 |
writeln(OutFile,'Buffers = ', stats[psBuffers]);
|
619 |
writeln(OutFile,'Reads = ', stats[psReads]);
|
620 |
writeln(OutFile,'Writes = ', stats[psWrites]);
|
621 |
writeln(OutFile,'Fetches = ', stats[psFetches]);
|
622 |
end;
|
623 |
|
624 |
procedure TTestBase.CheckActivity(Attachment: IAttachment);
|
625 |
begin
|
626 |
writeln(OutFile,'Database Activity = ',Attachment.HasActivity)
|
627 |
end;
|
628 |
|
629 |
procedure TTestBase.CheckActivity(Transaction: ITransaction);
|
630 |
begin
|
631 |
writeln(OutFile,'Transaction Activity = ',Transaction.HasActivity)
|
632 |
end;
|
633 |
|
634 |
{ TTestManager }
|
635 |
|
636 |
procedure TTestManager.CleanUp;
|
637 |
var DPB: IDPB;
|
638 |
Attachment: IAttachment;
|
639 |
begin
|
640 |
DPB := FirebirdAPI.AllocateDPB;
|
641 |
DPB.Add(isc_dpb_user_name).setAsString(GetUserName);
|
642 |
DPB.Add(isc_dpb_password).setAsString(GetPassword);
|
643 |
Attachment := FirebirdAPI.OpenDatabase(GetNewDatabaseName,DPB,false);
|
644 |
if Attachment <> nil then
|
645 |
Attachment.DropDatabase;
|
646 |
Attachment := FirebirdAPI.OpenDatabase(GetSecondNewDatabaseName,DPB,false);
|
647 |
if Attachment <> nil then
|
648 |
Attachment.DropDatabase;
|
649 |
end;
|
650 |
|
651 |
constructor TTestManager.Create;
|
652 |
begin
|
653 |
inherited Create;
|
654 |
FTests := TList.Create;
|
655 |
FNewDatabaseName := 'localhost:' + GetTempDir + 'fbtestsuite.fdb';
|
656 |
FSecondNewDatabaseName := 'localhost:' + GetTempDir + 'fbtestsuite2.fdb';
|
657 |
FUserName := 'SYSDBA';
|
658 |
FPassword := 'masterkey';
|
659 |
FEmployeeDatabaseName := 'localhost:employee';
|
660 |
FBackupFileName := GetTempDir + 'testbackup.gbk';
|
661 |
end;
|
662 |
|
663 |
destructor TTestManager.Destroy;
|
664 |
var i: integer;
|
665 |
begin
|
666 |
if assigned(FTests) then
|
667 |
begin
|
668 |
for i := 0 to FTests.Count - 1 do
|
669 |
TObject(FTests[i]).Free;
|
670 |
FTests.Free;
|
671 |
end;
|
672 |
inherited Destroy;
|
673 |
end;
|
674 |
|
675 |
function TTestManager.GetUserName: AnsiString;
|
676 |
begin
|
677 |
Result := FUserName;
|
678 |
end;
|
679 |
|
680 |
function TTestManager.GetPassword: AnsiString;
|
681 |
begin
|
682 |
Result := FPassword;
|
683 |
end;
|
684 |
|
685 |
function TTestManager.GetEmployeeDatabaseName: AnsiString;
|
686 |
begin
|
687 |
Result := FEmployeeDatabaseName;
|
688 |
end;
|
689 |
|
690 |
function TTestManager.GetNewDatabaseName: AnsiString;
|
691 |
begin
|
692 |
Result := FNewDatabaseName;
|
693 |
end;
|
694 |
|
695 |
function TTestManager.GetSecondNewDatabaseName: AnsiString;
|
696 |
begin
|
697 |
Result := FSecondNewDatabaseName;
|
698 |
end;
|
699 |
|
700 |
function TTestManager.GetBackupFileName: AnsiString;
|
701 |
begin
|
702 |
Result := FBackupFileName;
|
703 |
end;
|
704 |
|
705 |
procedure TTestManager.RunAll;
|
706 |
var i: integer;
|
707 |
begin
|
708 |
CleanUP;
|
709 |
for i := 0 to FTests.Count - 1 do
|
710 |
with TTestBase(FTests[i]) do
|
711 |
begin
|
712 |
writeln(OutFile,'Running ' + TestTitle);
|
713 |
writeln(ErrOutput,'Running ' + TestTitle);
|
714 |
try
|
715 |
RunTest('UTF8',3);
|
716 |
except on E:Exception do
|
717 |
begin
|
718 |
writeln(OutFile,'Test Completed with Error: ' + E.Message);
|
719 |
Exit;
|
720 |
end;
|
721 |
end;
|
722 |
writeln(OutFile);
|
723 |
writeln(OutFile);
|
724 |
end;
|
725 |
end;
|
726 |
|
727 |
procedure TTestManager.Run(TestID: integer);
|
728 |
begin
|
729 |
CleanUp;
|
730 |
if (TestID <= 0 ) or (TestID > FTests.Count) then
|
731 |
begin
|
732 |
writeln(OutFile,'Invalid Test ID - ',TestID);
|
733 |
Exit;
|
734 |
end;
|
735 |
with TTestBase(FTests[TestID-1]) do
|
736 |
begin
|
737 |
writeln(OutFile,'Running ' + TestTitle);
|
738 |
writeln(ErrOutput,'Running ' + TestTitle);
|
739 |
try
|
740 |
RunTest('UTF8',3);
|
741 |
except on E:Exception do
|
742 |
begin
|
743 |
writeln(OutFile,'Test Completed with Error: ' + E.Message);
|
744 |
Exit;
|
745 |
end;
|
746 |
end;
|
747 |
writeln(OutFile);
|
748 |
writeln(OutFile);
|
749 |
end;
|
750 |
end;
|
751 |
|
752 |
procedure TTestManager.SetUserName(aValue: AnsiString);
|
753 |
begin
|
754 |
FUserName := aValue;
|
755 |
end;
|
756 |
|
757 |
procedure TTestManager.SetPassword(aValue: AnsiString);
|
758 |
begin
|
759 |
FPassword := aValue;
|
760 |
end;
|
761 |
|
762 |
procedure TTestManager.SetEmployeeDatabaseName(aValue: AnsiString);
|
763 |
begin
|
764 |
FEmployeeDatabaseName := aValue;
|
765 |
end;
|
766 |
|
767 |
procedure TTestManager.SetNewDatabaseName(aValue: AnsiString);
|
768 |
begin
|
769 |
FNewDatabaseName := aValue;
|
770 |
end;
|
771 |
|
772 |
procedure TTestManager.SetSecondNewDatabaseName(aValue: AnsiString);
|
773 |
begin
|
774 |
FSecondNewDatabaseName := aValue;
|
775 |
end;
|
776 |
|
777 |
procedure TTestManager.SetBackupFileName(aValue: AnsiString);
|
778 |
begin
|
779 |
FBackupFileName := aValue;
|
780 |
end;
|
781 |
|
782 |
end.
|
783 |
|