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