ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/nongui/IBDatabaseInfo.pas
Revision: 345
Committed: Mon Aug 23 14:22:29 2021 UTC (2 years, 7 months ago) by tony
Content type: text/x-pascal
File size: 17160 byte(s)
Log Message:
Merged into public release

File Contents

# Content
1 {************************************************************************}
2 { }
3 { Borland Delphi Visual Component Library }
4 { InterBase Express core components }
5 { }
6 { Copyright (c) 1998-2000 Inprise Corporation }
7 { }
8 { InterBase Express is based in part on the product }
9 { Free IB Components, written by Gregory H. Deatz for }
10 { Hoagland, Longo, Moran, Dunst & Doukas Company. }
11 { Free IB Components is used under license. }
12 { }
13 { The contents of this file are subject to the InterBase }
14 { Public License Version 1.0 (the "License"); you may not }
15 { use this file except in compliance with the License. You }
16 { may obtain a copy of the License at http://www.Inprise.com/IPL.html }
17 { Software distributed under the License is distributed on }
18 { an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either }
19 { express or implied. See the License for the specific language }
20 { governing rights and limitations under the License. }
21 { Portions created by Inprise Corporation are Copyright (C) Inprise }
22 { Corporation. All Rights Reserved. }
23 { Contributor(s): Jeff Overcash }
24 { }
25 { IBX For Lazarus (Firebird Express) }
26 { Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
27 { Portions created by MWA Software are copyright McCallum Whyman }
28 { Associates Ltd 2011 - 2018 }
29 { }
30 {************************************************************************}
31
32 unit IBDatabaseInfo;
33
34 {$Mode Delphi}
35
36 interface
37
38 uses
39 SysUtils, Classes, IB, IBExternals, IBDatabase;
40
41 type
42
43 { TIBDatabaseInfo }
44
45 TIBDatabaseInfo = class(TComponent)
46 private
47 function GetDateDBCreated: TDateTime;
48 function GetEncrypted: boolean;
49 function GetEncryptionKeyName: string;
50 function GetPagesFree: int64;
51 function GetPagesUsed: int64;
52 function GetTransactionCount: int64;
53 protected
54 FDatabase: TIBDatabase;
55 FUserNames : TStringList;
56 FBackoutCount: TStringList;
57 FDeleteCount: TStringList;
58 FExpungeCount: TStringList;
59 FInsertCount: TStringList;
60 FPurgeCount: TStringList;
61 FReadIdxCount: TStringList;
62 FReadSeqCount: TStringList;
63 FUpdateCount: TStringList;
64 procedure CheckDatabase;
65 function GetAllocation: int64;
66 function GetBaseLevel: byte;
67 function GetDBFileName: String;
68 function GetDBSiteName: String;
69 function GetDBImplementationNo: byte;
70 function GetDBImplementationClass: byte;
71 function GetNoReserve: int64;
72 function GetODSMinorVersion: integer;
73 function GetODSMajorVersion: integer;
74 function GetPageSize: int64;
75 function GetVersion: String;
76 function GetCurrentMemory: Int64;
77 function GetForcedWrites: Int64;
78 function GetMaxMemory: Int64;
79 function GetNumBuffers: Int64;
80 function GetSweepInterval: Int64;
81 function GetUserNames: TStringList;
82 function GetFetches: Int64;
83 function GetMarks: Int64;
84 function GetReads: Int64;
85 function GetWrites: Int64;
86 function GetBackoutCount: TStringList;
87 function GetDeleteCount: TStringList;
88 function GetExpungeCount: TStringList;
89 function GetInsertCount: TStringList;
90 function GetPurgeCount: TStringList;
91 function GetReadIdxCount: TStringList;
92 function GetReadSeqCount: TStringList;
93 function GetUpdateCount: TStringList;
94 function GetOperationCounts(DBInfoCommand: Integer; var FOperation: TStringList): TStringList;
95 function GetReadOnly: Int64;
96 function GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
97 function GetDBSQLDialect: Int64;
98 public
99 constructor Create(AOwner: TComponent); override;
100 destructor Destroy; override;
101 function GetLongDatabaseInfo(DatabaseInfoCommand: Integer): long; deprecated 'Use GetIntDatabaseInfo instead';
102 function GetIntDatabaseInfo(DatabaseInfoCommand: Integer): Int64;
103 function GetDatabasePage(PageNo: integer): string;
104 property Allocation: Int64 read GetAllocation;
105 property BaseLevel: byte read GetBaseLevel;
106 property DateDBCreated: TDateTime read GetDateDBCreated;
107 property DBFileName: String read GetDBFileName;
108 property DBSiteName: String read GetDBSiteName;
109 property DBImplementationNo: byte read GetDBImplementationNo;
110 property DBImplementationClass: byte read GetDBImplementationClass;
111 property Encrypted: boolean read GetEncrypted;
112 property EncryptionKeyName: string read GetEncryptionKeyName;
113 property NoReserve: Int64 read GetNoReserve;
114 property ODSMinorVersion: integer read GetODSMinorVersion;
115 property ODSMajorVersion: integer read GetODSMajorVersion;
116 property PageSize: Int64 read GetPageSize;
117 property Version: String read GetVersion;
118 property CurrentMemory: Int64 read GetCurrentMemory;
119 property ForcedWrites: Int64 read GetForcedWrites;
120 property MaxMemory: Int64 read GetMaxMemory;
121 property NumBuffers: Int64 read GetNumBuffers;
122 property SweepInterval: Int64 read GetSweepInterval;
123 property UserNames: TStringList read GetUserNames;
124 property Fetches: Int64 read GetFetches;
125 property Marks: Int64 read GetMarks;
126 property Reads: Int64 read GetReads;
127 property Writes: Int64 read GetWrites;
128 property TransactionCount: Int64 read GetTransactionCount;
129 property BackoutCount: TStringList read GetBackoutCount;
130 property DeleteCount: TStringList read GetDeleteCount;
131 property ExpungeCount: TStringList read GetExpungeCount;
132 property InsertCount: TStringList read GetInsertCount;
133 property PurgeCount: TStringList read GetPurgeCount;
134 property ReadIdxCount: TStringList read GetReadIdxCount;
135 property ReadSeqCount: TStringList read GetReadSeqCount;
136 property UpdateCount: TStringList read GetUpdateCount;
137 property DBSQLDialect : Int64 read GetDBSQLDialect;
138 property PagesUsed: Int64 read GetPagesUsed;
139 property PagesFree: Int64 read GetPagesFree;
140 property ReadOnly: Int64 read GetReadOnly;
141 published
142 property Database: TIBDatabase read FDatabase write FDatabase;
143 end;
144
145 implementation
146
147 uses
148 IBMessages;
149
150 { TIBDatabaseInfo }
151
152 constructor TIBDatabaseInfo.Create(AOwner: TComponent);
153 begin
154 inherited Create(AOwner);
155 FUserNames := TStringList.Create;
156 FBackoutCount := nil;
157 FDeleteCount := nil;
158 FExpungeCount := nil;
159 FInsertCount := nil;
160 FPurgeCount := nil;
161 FReadIdxCount := nil;
162 FReadSeqCount := nil;
163 FUpdateCount := nil;
164 end;
165
166 destructor TIBDatabaseInfo.Destroy;
167 begin
168 if assigned(FUserNames) then FUserNames.Free;
169 if assigned(FBackoutCount) then FBackoutCount.Free;
170 if assigned(FDeleteCount) then FDeleteCount.Free;
171 if assigned(FExpungeCount) then FExpungeCount.Free;
172 if assigned(FInsertCount) then FInsertCount.Free;
173 if assigned(FPurgeCount) then FPurgeCount.Free;
174 if assigned(FReadIdxCount) then FReadIdxCount.Free;
175 if assigned(FReadSeqCount) then FReadSeqCount.Free;
176 if assigned(FUpdateCount) then FUpdateCount.Free;
177 inherited Destroy;
178 end;
179
180 function TIBDatabaseInfo.GetDateDBCreated: TDateTime;
181 begin
182 CheckDatabase;
183 with Database.Attachment.GetDBInformation([isc_info_creation_date]) do
184 if (Count > 0) and (Items[0].GetItemType = isc_info_creation_date) then
185 Result := Items[0].GetAsDateTime
186 else
187 IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
188 end;
189
190 function TIBDatabaseInfo.GetEncrypted: boolean;
191 var ConnFlags: Int64;
192 begin
193 Result := ODSMajorVersion >= 12;
194 if Result then
195 try
196 ConnFlags := GetIntDatabaseInfo(fb_info_conn_flags);
197 Result := (ConnFlags and fb_info_crypt_encrypted) <> 0;
198 except
199 Result := false; {Introduced in Firebird 3.0.3}
200 end;
201 end;
202
203 function TIBDatabaseInfo.GetEncryptionKeyName: string;
204 begin
205 CheckDatabase;
206 {Introduced in Firebird 3.0.3}
207 with Database.Attachment.GetDBInformation([fb_info_crypt_key]) do
208 if (Count > 0) and (Items[0].GetItemType = fb_info_crypt_key) then
209 Result := Items[0].AsString
210 else
211 IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
212 end;
213
214 function TIBDatabaseInfo.GetPagesFree: int64;
215 begin
216 result := GetIntDatabaseInfo(fb_info_pages_used);
217 end;
218
219 function TIBDatabaseInfo.GetPagesUsed: int64;
220 begin
221 result := GetIntDatabaseInfo(fb_info_pages_free);
222 end;
223
224 function TIBDatabaseInfo.GetTransactionCount: int64;
225 begin
226 result := GetIntDatabaseInfo(isc_info_active_tran_count);
227 end;
228
229 procedure TIBDatabaseInfo.CheckDatabase;
230 begin
231 if Database = nil then
232 IBError(ibxeDatabaseNotAssigned,[]);
233 if Database.Attachment = nil then
234 IBError(ibxeDatabaseClosed,[]);
235 end;
236
237 function TIBDatabaseInfo.GetAllocation: int64;
238 begin
239 result := GetIntDatabaseInfo(isc_info_allocation);
240 end;
241
242 function TIBDatabaseInfo.GetBaseLevel: byte;
243 var Response: TByteArray;
244 begin
245 CheckDatabase;
246 with Database.Attachment.GetDBInformation([isc_info_base_level]) do
247 if (Count > 0) and (Items[0].GetItemType = isc_info_base_level) then
248 begin
249 Response := Items[0].GetAsBytes;
250 Result := Response[1];
251 end
252 else
253 IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
254 end;
255
256 function TIBDatabaseInfo.GetDBFileName: String;
257 var
258 ConnectionType: integer;
259 SiteName: string;
260 begin
261 CheckDatabase;
262 with Database.Attachment.GetDBInformation([isc_info_db_id]) do
263 if (Count > 0) and (Items[0].GetItemType = isc_info_db_id) then
264 Items[0].DecodeIDCluster(ConnectionType,Result,SiteName)
265 else
266 IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
267 end;
268
269 function TIBDatabaseInfo.GetDBSiteName: String;
270 var
271 ConnectionType: integer;
272 FileName: string;
273 begin
274 CheckDatabase;
275 with Database.Attachment.GetDBInformation([isc_info_db_id]) do
276 if (Count > 0) and (Items[0].GetItemType = isc_info_db_id) then
277 Items[0].DecodeIDCluster(ConnectionType,FileName,Result)
278 else
279 IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
280 end;
281
282 function TIBDatabaseInfo.GetDBImplementationNo: byte;
283 var Response: TByteArray;
284 begin
285 CheckDatabase;
286 with Database.Attachment.GetDBInformation([isc_info_implementation]) do
287 if (Count > 0) and (Items[0].GetItemType = isc_info_implementation) then
288 begin
289 Response := Items[0].GetAsBytes;
290 Result := Response[1];
291 end
292 else
293 IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
294 end;
295
296 function TIBDatabaseInfo.GetDBImplementationClass: byte;
297 var Response: TByteArray;
298 begin
299 CheckDatabase;
300 with Database.Attachment.GetDBInformation([isc_info_implementation]) do
301 if (Count > 0) and (Items[0].GetItemType = isc_info_implementation) then
302 begin
303 Response := Items[0].GetAsBytes;
304 Result := Response[2];
305 end
306 else
307 IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
308 end;
309
310 function TIBDatabaseInfo.GetNoReserve: int64;
311 begin
312 result := GetIntDatabaseInfo(isc_info_no_reserve);
313 end;
314
315 function TIBDatabaseInfo.GetODSMinorVersion: integer;
316 begin
317 CheckDatabase;
318 Result := Database.Attachment.GetODSMinorVersion;
319 end;
320
321 function TIBDatabaseInfo.GetODSMajorVersion: integer;
322 begin
323 CheckDatabase;
324 Result := Database.Attachment.GetODSMajorVersion;
325 end;
326
327 function TIBDatabaseInfo.GetPageSize: int64;
328 begin
329 result := GetIntDatabaseInfo(isc_info_page_size);
330 end;
331
332 function TIBDatabaseInfo.GetVersion: String;
333 var Version: byte;
334 begin
335 CheckDatabase;
336 with Database.Attachment.GetDBInformation([isc_info_version]) do
337 if (Count > 0) and (Items[0].GetItemType = isc_info_version) then
338 Items[0].DecodeVersionString(Version,Result)
339 else
340 IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
341 end;
342
343 function TIBDatabaseInfo.GetCurrentMemory: Int64;
344 begin
345 result := GetIntDatabaseInfo(isc_info_current_memory);
346 end;
347
348 function TIBDatabaseInfo.GetForcedWrites: Int64;
349 begin
350 result := GetIntDatabaseInfo(isc_info_forced_writes);
351 end;
352
353 function TIBDatabaseInfo.GetMaxMemory: Int64;
354 begin
355 result := GetIntDatabaseInfo(isc_info_max_memory);
356 end;
357
358 function TIBDatabaseInfo.GetNumBuffers: Int64;
359 begin
360 result := GetIntDatabaseInfo(isc_info_num_buffers);
361 end;
362
363 function TIBDatabaseInfo.GetSweepInterval: Int64;
364 begin
365 result := GetIntDatabaseInfo(isc_info_sweep_interval);
366 end;
367
368 function TIBDatabaseInfo.GetUserNames: TStringList;
369 begin
370 CheckDatabase;
371 Result := FUserNames;
372 FUserNames.Clear;
373 with Database.Attachment.GetDBInformation([isc_info_user_names]) do
374 if (Count > 0) and (Items[0].GetItemType = isc_info_user_names) then
375 Items[0].DecodeUserNames(Result)
376 else
377 IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
378 end;
379
380 function TIBDatabaseInfo.GetFetches: Int64;
381 begin
382 result := GetIntDatabaseInfo(isc_info_fetches);
383 end;
384
385 function TIBDatabaseInfo.GetMarks: Int64;
386 begin
387 result := GetIntDatabaseInfo(isc_info_marks);
388 end;
389
390 function TIBDatabaseInfo.GetReads: Int64;
391 begin
392 result := GetIntDatabaseInfo(isc_info_reads);
393 end;
394
395 function TIBDatabaseInfo.GetWrites: Int64;
396 begin
397 result := GetIntDatabaseInfo(isc_info_writes);
398 end;
399
400 function TIBDatabaseInfo.GetOperationCounts(DBInfoCommand: Integer;
401 var FOperation: TStringList): TStringList;
402 var opCounts: TDBOperationCounts;
403 i: integer;
404 begin
405 CheckDatabase;
406 if FOperation = nil then FOperation := TStringList.Create;
407 result := FOperation;
408 with Database.Attachment.GetDBInformation([DBInfoCommand]) do
409 if (Count > 0) and (Items[0].GetItemType = DBInfoCommand) then
410 opCounts := Items[0].getOperationCounts
411 else
412 IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
413 for i := 0 to Length(opCounts) - 1 do
414 FOperation.Add(IntToStr(opCounts[i].TableID) +'='+IntToStr(opCounts[i].Count));
415 end;
416
417 function TIBDatabaseInfo.GetBackoutCount: TStringList;
418 begin
419 result := GetOperationCounts(isc_info_backout_count,FBackoutCount);
420 end;
421
422 function TIBDatabaseInfo.GetDeleteCount: TStringList;
423 begin
424 result := GetOperationCounts(isc_info_delete_count,FDeleteCount);
425 end;
426
427 function TIBDatabaseInfo.GetExpungeCount: TStringList;
428 begin
429 result := GetOperationCounts(isc_info_expunge_count,FExpungeCount);
430 end;
431
432 function TIBDatabaseInfo.GetInsertCount: TStringList;
433 begin
434 result := GetOperationCounts(isc_info_insert_count,FInsertCount);
435 end;
436
437 function TIBDatabaseInfo.GetPurgeCount: TStringList;
438 begin
439 result := GetOperationCounts(isc_info_purge_count,FPurgeCount);
440 end;
441
442 function TIBDatabaseInfo.GetReadIdxCount: TStringList;
443 begin
444 result := GetOperationCounts(isc_info_read_idx_count,FReadIdxCount);
445 end;
446
447 function TIBDatabaseInfo.GetReadSeqCount: TStringList;
448 begin
449 result := GetOperationCounts(isc_info_read_seq_count,FReadSeqCount);
450 end;
451
452 function TIBDatabaseInfo.GetUpdateCount: TStringList;
453 begin
454 result := GetOperationCounts(isc_info_update_count,FUpdateCount);
455 end;
456
457 function TIBDatabaseInfo.GetReadOnly: Int64;
458 begin
459 result := GetIntDatabaseInfo(isc_info_db_read_only);
460 end;
461
462 function TIBDatabaseInfo.GetLongDatabaseInfo(DatabaseInfoCommand: Integer
463 ): long;
464 begin
465 Result := GetIntDatabaseInfo(DatabaseInfoCommand);
466 end;
467
468 function TIBDatabaseInfo.GetIntDatabaseInfo(DatabaseInfoCommand: Integer
469 ): Int64;
470 begin
471 CheckDatabase;
472 with Database.Attachment.GetDBInformation([DatabaseInfoCommand]) do
473 if (Count > 0) and (Items[0].GetItemType = DatabaseInfoCommand) then
474 Result := Items[0].AsInteger
475 else
476 IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
477 end;
478
479 function TIBDatabaseInfo.GetDatabasePage(PageNo: integer): string;
480 var DBRequest: IDIRB;
481 begin
482 DBRequest := Database.Attachment.AllocateDIRB;
483 DBRequest.Add(fb_info_page_contents).AsInteger := PageNo;
484 with Database.Attachment.GetDBInformation(DBRequest) do
485 if (Count > 0) and (Items[0].GetItemType = fb_info_page_contents) then
486 Result := Items[0].AsString
487 else
488 IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
489 end;
490
491 function TIBDatabaseInfo.GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
492 begin
493 CheckDatabase;
494 with Database.Attachment.GetDBInformation([DatabaseInfoCommand]) do
495 if (Count > 0) and (Items[0].GetItemType = DatabaseInfoCommand) then
496 Result := Items[0].AsString
497 else
498 IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
499 end;
500
501
502 function TIBDatabaseInfo.GetDBSQLDialect: Int64;
503 begin
504 CheckDatabase;
505 with Database.Attachment.GetDBInformation([isc_info_db_SQL_Dialect]) do
506 if (Count > 0) and (Items[0].GetItemType = isc_info_db_SQL_Dialect) then
507 Result := Items[0].AsInteger
508 else
509 Result := 1;
510 end;
511
512
513 end.