ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBDatabaseInfo.pas
Revision: 33
Committed: Sat Jul 18 12:30:52 2015 UTC (8 years, 8 months ago) by tony
Content type: text/x-pascal
File size: 16520 byte(s)
Log Message:
Committing updates for Release R1-3-1

File Contents

# User Rev Content
1 tony 33 {************************************************************************}
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.