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