ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBDatabaseInfo.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBDatabaseInfo.pas (file contents):
Revision 7 by tony, Sun Aug 5 18:28:19 2012 UTC vs.
Revision 17 by tony, Sat Dec 28 19:22:24 2013 UTC

# Line 1 | Line 1
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.
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.

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines