ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBDatabaseInfo.pas
Revision: 17
Committed: Sat Dec 28 19:22:24 2013 UTC (6 years, 6 months ago) by tony
File size: 16983 byte(s)
Log Message:
Committing updates for Release R1-0-5
Line File contents
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 }
29 { }
30 {************************************************************************}
31
32 unit IBDatabaseInfo;
33
34 {$Mode Delphi}
35
36 interface
37
38 uses
39 SysUtils, Classes, IBHeader, IBExternals, IB, IBDatabase;
40
41 type
42
43 TIBDatabaseInfo = class(TComponent)
44 protected
45 FIBLoaded: Boolean;
46 FDatabase: TIBDatabase;
47 FUserNames : TStringList;
48 FBackoutCount: TStringList;
49 FDeleteCount: TStringList;
50 FExpungeCount: TStringList;
51 FInsertCount: TStringList;
52 FPurgeCount: TStringList;
53 FReadIdxCount: TStringList;
54 FReadSeqCount: TStringList;
55 FUpdateCount: TStringList;
56 function GetAllocation: Long;
57 function GetBaseLevel: Long;
58 function GetDBFileName: String;
59 function GetDBSiteName: String;
60 function GetDBImplementationNo: Long;
61 function GetDBImplementationClass: Long;
62 function GetNoReserve: Long;
63 function GetODSMinorVersion: Long;
64 function GetODSMajorVersion: Long;
65 function GetPageSize: Long;
66 function GetVersion: String;
67 function GetCurrentMemory: Long;
68 function GetForcedWrites: Long;
69 function GetMaxMemory: Long;
70 function GetNumBuffers: Long;
71 function GetSweepInterval: Long;
72 function GetUserNames: TStringList;
73 function GetFetches: Long;
74 function GetMarks: Long;
75 function GetReads: Long;
76 function GetWrites: Long;
77 function GetBackoutCount: TStringList;
78 function GetDeleteCount: TStringList;
79 function GetExpungeCount: TStringList;
80 function GetInsertCount: TStringList;
81 function GetPurgeCount: TStringList;
82 function GetReadIdxCount: TStringList;
83 function GetReadSeqCount: TStringList;
84 function GetUpdateCount: TStringList;
85 function GetOperationCounts(DBInfoCommand: Integer; FOperation: TStringList): TStringList;
86 function GetReadOnly: Long;
87 function GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
88 function GetDBSQLDialect: Long;
89 public
90 constructor Create(AOwner: TComponent); override;
91 destructor Destroy; override;
92 function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
93 function GetLongDatabaseInfo(DatabaseInfoCommand: Integer): Long;
94 property Allocation: Long read GetAllocation;
95 property BaseLevel: Long read GetBaseLevel;
96 property DBFileName: String read GetDBFileName;
97 property DBSiteName: String read GetDBSiteName;
98 property DBImplementationNo: Long read GetDBImplementationNo;
99 property DBImplementationClass: Long read GetDBImplementationClass;
100 property NoReserve: Long read GetNoReserve;
101 property ODSMinorVersion: Long read GetODSMinorVersion;
102 property ODSMajorVersion: Long read GetODSMajorVersion;
103 property PageSize: Long read GetPageSize;
104 property Version: String read GetVersion;
105 property CurrentMemory: Long read GetCurrentMemory;
106 property ForcedWrites: Long read GetForcedWrites;
107 property MaxMemory: Long read GetMaxMemory;
108 property NumBuffers: Long read GetNumBuffers;
109 property SweepInterval: Long read GetSweepInterval;
110 property UserNames: TStringList read GetUserNames;
111 property Fetches: Long read GetFetches;
112 property Marks: Long read GetMarks;
113 property Reads: Long read GetReads;
114 property Writes: Long read GetWrites;
115 property BackoutCount: TStringList read GetBackoutCount;
116 property DeleteCount: TStringList read GetDeleteCount;
117 property ExpungeCount: TStringList read GetExpungeCount;
118 property InsertCount: TStringList read GetInsertCount;
119 property PurgeCount: TStringList read GetPurgeCount;
120 property ReadIdxCount: TStringList read GetReadIdxCount;
121 property ReadSeqCount: TStringList read GetReadSeqCount;
122 property UpdateCount: TStringList read GetUpdateCount;
123 property DBSQLDialect : Long read GetDBSQLDialect;
124 property ReadOnly: Long read GetReadOnly;
125 published
126 property Database: TIBDatabase read FDatabase write FDatabase;
127 end;
128
129 implementation
130
131 uses
132 IBIntf;
133
134 { TIBDatabaseInfo }
135
136 constructor TIBDatabaseInfo.Create(AOwner: TComponent);
137 begin
138 inherited Create(AOwner);
139 FIBLoaded := False;
140 CheckIBLoaded;
141 FIBLoaded := True;
142 FUserNames := TStringList.Create;
143 FBackoutCount := nil;
144 FDeleteCount := nil;
145 FExpungeCount := nil;
146 FInsertCount := nil;
147 FPurgeCount := nil;
148 FReadIdxCount := nil;
149 FReadSeqCount := nil;
150 FUpdateCount := nil;
151 end;
152
153 destructor TIBDatabaseInfo.Destroy;
154 begin
155 if FIBLoaded then
156 begin
157 FUserNames.Free;
158 FBackoutCount.Free;
159 FDeleteCount.Free;
160 FExpungeCount.Free;
161 FInsertCount.Free;
162 FPurgeCount.Free;
163 FReadIdxCount.Free;
164 FReadSeqCount.Free;
165 FUpdateCount.Free;
166 end;
167 inherited Destroy;
168 end;
169
170
171 function TIBDatabaseInfo.Call(ErrCode: ISC_STATUS;
172 RaiseError: Boolean): ISC_STATUS;
173 begin
174 result := ErrCode;
175 if RaiseError and (ErrCode > 0) then
176 IBDataBaseError;
177 end;
178 function TIBDatabaseInfo.GetAllocation: Long;
179 begin
180 result := GetLongDatabaseInfo(isc_info_allocation);
181 end;
182
183 function TIBDatabaseInfo.GetBaseLevel: Long;
184 var
185 local_buffer: array[0..IBLocalBufferLength - 1] of Char;
186 DatabaseInfoCommand: Char;
187 begin
188 DatabaseInfoCommand := Char(isc_info_base_level);
189 Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
190 IBLocalBufferLength, local_buffer), True);
191 result := isc_vax_integer(@local_buffer[4], 1);
192 end;
193
194 function TIBDatabaseInfo.GetDBFileName: String;
195 var
196 local_buffer: array[0..IBLocalBufferLength - 1] of Char;
197 DatabaseInfoCommand: Char;
198 begin
199 DatabaseInfoCommand := Char(isc_info_db_id);
200 Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
201 IBLocalBufferLength, local_buffer), True);
202 local_buffer[5 + Int(local_buffer[4])] := #0;
203 result := String(PChar(@local_buffer[5]));
204 end;
205
206 function TIBDatabaseInfo.GetDBSiteName: String;
207 var
208 local_buffer: array[0..IBBigLocalBufferLength - 1] of Char;
209 p: PChar;
210 DatabaseInfoCommand: Char;
211 begin
212 DatabaseInfoCommand := Char(isc_info_db_id);
213 Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
214 IBLocalBufferLength, local_buffer), True);
215 p := @local_buffer[5 + Int(local_buffer[4])]; { DBSiteName Length }
216 p := p + Int(p^) + 1; { End of DBSiteName }
217 p^ := #0; { Null it }
218 result := String(PChar(@local_buffer[6 + Int(local_buffer[4])]));
219 end;
220
221 function TIBDatabaseInfo.GetDBImplementationNo: Long;
222 var
223 local_buffer: array[0..IBLocalBufferLength - 1] of Char;
224 DatabaseInfoCommand: Char;
225 begin
226 DatabaseInfoCommand := Char(isc_info_implementation);
227 Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
228 IBLocalBufferLength, local_buffer), True);
229 result := isc_vax_integer(@local_buffer[3], 1);
230 end;
231
232 function TIBDatabaseInfo.GetDBImplementationClass: Long;
233 var
234 local_buffer: array[0..IBLocalBufferLength - 1] of Char;
235 DatabaseInfoCommand: Char;
236 begin
237 DatabaseInfoCommand := Char(isc_info_implementation);
238 Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
239 IBLocalBufferLength, local_buffer), True);
240 result := isc_vax_integer(@local_buffer[4], 1);
241 end;
242
243 function TIBDatabaseInfo.GetNoReserve: Long;
244 begin
245 result := GetLongDatabaseInfo(isc_info_no_reserve);
246 end;
247
248 function TIBDatabaseInfo.GetODSMinorVersion: Long;
249 begin
250 result := GetLongDatabaseInfo(isc_info_ods_minor_version);
251 end;
252
253 function TIBDatabaseInfo.GetODSMajorVersion: Long;
254 begin
255 result := GetLongDatabaseInfo(isc_info_ods_version);
256 end;
257
258 function TIBDatabaseInfo.GetPageSize: Long;
259 begin
260 result := GetLongDatabaseInfo(isc_info_page_size);
261 end;
262
263 function TIBDatabaseInfo.GetVersion: String;
264 var
265 local_buffer: array[0..IBBigLocalBufferLength - 1] of Char;
266 DatabaseInfoCommand: Char;
267 begin
268 DatabaseInfoCommand := Char(isc_info_version);
269 Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
270 IBBigLocalBufferLength, local_buffer), True);
271 local_buffer[5 + Int(local_buffer[4])] := #0;
272 result := String(PChar(@local_buffer[5]));
273 end;
274
275 function TIBDatabaseInfo.GetCurrentMemory: Long;
276 begin
277 result := GetLongDatabaseInfo(isc_info_current_memory);
278 end;
279
280 function TIBDatabaseInfo.GetForcedWrites: Long;
281 begin
282 result := GetLongDatabaseInfo(isc_info_forced_writes);
283 end;
284
285 function TIBDatabaseInfo.GetMaxMemory: Long;
286 begin
287 result := GetLongDatabaseInfo(isc_info_max_memory);
288 end;
289
290 function TIBDatabaseInfo.GetNumBuffers: Long;
291 begin
292 result := GetLongDatabaseInfo(isc_info_num_buffers);
293 end;
294
295 function TIBDatabaseInfo.GetSweepInterval: Long;
296 begin
297 result := GetLongDatabaseInfo(isc_info_sweep_interval);
298 end;
299
300 function TIBDatabaseInfo.GetUserNames: TStringList;
301 var
302 local_buffer: array[0..IBHugeLocalBufferLength - 1] of Char;
303 temp_buffer: array[0..IBLocalBufferLength - 2] of Char;
304 DatabaseInfoCommand: Char;
305 i, user_length: Integer;
306 begin
307 result := FUserNames;
308 DatabaseInfoCommand := Char(isc_info_user_names);
309 Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
310 IBHugeLocalBufferLength, local_buffer), True);
311 FUserNames.Clear;
312 i := 0;
313 while local_buffer[i] = Char(isc_info_user_names) do
314 begin
315 Inc(i, 3); { skip "isc_info_user_names byte" & two unknown bytes of structure (see below) }
316 user_length := Long(local_buffer[i]);
317 Inc(i,1);
318 Move(local_buffer[i], temp_buffer[0], user_length);
319 Inc(i, user_length);
320 temp_buffer[user_length] := #0;
321 FUserNames.Add(String(temp_buffer));
322 end;
323 end;
324
325 function TIBDatabaseInfo.GetFetches: Long;
326 begin
327 result := GetLongDatabaseInfo(isc_info_fetches);
328 end;
329
330 function TIBDatabaseInfo.GetMarks: Long;
331 begin
332 result := GetLongDatabaseInfo(isc_info_marks);
333 end;
334
335 function TIBDatabaseInfo.GetReads: Long;
336 begin
337 result := GetLongDatabaseInfo(isc_info_reads);
338 end;
339
340 function TIBDatabaseInfo.GetWrites: Long;
341 begin
342 result := GetLongDatabaseInfo(isc_info_writes);
343 end;
344
345 function TIBDatabaseInfo.GetOperationCounts(DBInfoCommand: Integer; FOperation: TStringList): TStringList;
346 var
347 local_buffer: array[0..IBHugeLocalBufferLength - 1] of Char;
348 DatabaseInfoCommand: Char;
349 i, qtd_tables, id_table, qtd_operations: Integer;
350 begin
351 if FOperation = nil then FOperation := TStringList.Create;
352 result := FOperation;
353 DatabaseInfoCommand := Char(DBInfoCommand);
354 Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
355 IBHugeLocalBufferLength, local_buffer), True);
356 FOperation.Clear;
357 { 1. 1 byte specifying the item type requested (e.g., isc_info_insert_count).
358 2. 2 bytes telling how many bytes compose the subsequent value pairs.
359 3. A pair of values for each table in the database on wich the requested
360 type of operation has occurred since the database was last attached.
361 Each pair consists of:
362 1. 2 bytes specifying the table ID.
363 2. 4 bytes listing the number of operations (e.g., inserts) done on that table.
364 }
365 qtd_tables := trunc(isc_vax_integer(@local_buffer[1],2)/6);
366 for i := 0 to qtd_tables - 1 do
367 begin
368 id_table := isc_vax_integer(@local_buffer[3+(i*6)],2);
369 qtd_operations := isc_vax_integer(@local_buffer[5+(i*6)],4);
370 FOperation.Add(IntToStr(id_table)+'='+IntToStr(qtd_operations));
371 end;
372 end;
373
374 function TIBDatabaseInfo.GetBackoutCount: TStringList;
375 begin
376 result := GetOperationCounts(isc_info_backout_count,FBackoutCount);
377 end;
378
379 function TIBDatabaseInfo.GetDeleteCount: TStringList;
380 begin
381 result := GetOperationCounts(isc_info_delete_count,FDeleteCount);
382 end;
383
384 function TIBDatabaseInfo.GetExpungeCount: TStringList;
385 begin
386 result := GetOperationCounts(isc_info_expunge_count,FExpungeCount);
387 end;
388
389 function TIBDatabaseInfo.GetInsertCount: TStringList;
390 begin
391 result := GetOperationCounts(isc_info_insert_count,FInsertCount);
392 end;
393
394 function TIBDatabaseInfo.GetPurgeCount: TStringList;
395 begin
396 result := GetOperationCounts(isc_info_purge_count,FPurgeCount);
397 end;
398
399 function TIBDatabaseInfo.GetReadIdxCount: TStringList;
400 begin
401 result := GetOperationCounts(isc_info_read_idx_count,FReadIdxCount);
402 end;
403
404 function TIBDatabaseInfo.GetReadSeqCount: TStringList;
405 begin
406 result := GetOperationCounts(isc_info_read_seq_count,FReadSeqCount);
407 end;
408
409 function TIBDatabaseInfo.GetUpdateCount: TStringList;
410 begin
411 result := GetOperationCounts(isc_info_update_count,FUpdateCount);
412 end;
413
414 function TIBDatabaseInfo.GetReadOnly: Long;
415 begin
416 result := GetLongDatabaseInfo(isc_info_db_read_only);
417 end;
418
419 function TIBDatabaseInfo.GetLongDatabaseInfo(DatabaseInfoCommand: Integer): Long;
420 var
421 local_buffer: array[0..IBLocalBufferLength - 1] of Char;
422 length: Integer;
423 _DatabaseInfoCommand: Char;
424 begin
425 _DatabaseInfoCommand := Char(DatabaseInfoCommand);
426 Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @_DatabaseInfoCommand,
427 IBLocalBufferLength, local_buffer), True);
428 length := isc_vax_integer(@local_buffer[1], 2);
429 result := isc_vax_integer(@local_buffer[3], length);
430 end;
431
432 function TIBDatabaseInfo.GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
433 var
434 local_buffer: array[0..IBBigLocalBufferLength - 1] of Char;
435 _DatabaseInfoCommand: Char;
436 begin
437 _DatabaseInfoCommand := Char(DatabaseInfoCommand);
438 Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @_DatabaseInfoCommand,
439 IBBigLocalBufferLength, local_buffer), True);
440 local_buffer[4 + Int(local_buffer[3])] := #0;
441 result := String(PChar(@local_buffer[4]));
442 end;
443
444
445 function TIBDatabaseInfo.GetDBSQLDialect: Integer;
446 var
447 local_buffer: array[0..IBLocalBufferLength - 1] of Char;
448 length: Integer;
449 DatabaseInfoCommand: Char;
450 begin
451 DatabaseInfoCommand := Char(isc_info_db_SQL_Dialect);
452 Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
453 IBLocalBufferLength, local_buffer), True);
454 if (local_buffer[0] <> Char(isc_info_db_SQL_dialect)) then
455 result := 1
456 else begin
457 length := isc_vax_integer(@local_buffer[1], 2);
458 result := isc_vax_integer(@local_buffer[3], length);
459 end;
460 end;
461
462
463 end.