ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBDatabaseInfo.pas
Revision: 45
Committed: Tue Dec 6 10:33:46 2016 UTC (7 years, 11 months ago) by tony
Content type: text/x-pascal
File size: 13811 byte(s)
Log Message:
Committing updates for Release R2-0-0

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 tony 45 SysUtils, Classes, IB, IBExternals, IBDatabase;
40 tony 33
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 GetLongDatabaseInfo(DatabaseInfoCommand: Integer): Long;
93     property Allocation: Long read GetAllocation;
94     property BaseLevel: Long read GetBaseLevel;
95     property DBFileName: String read GetDBFileName;
96     property DBSiteName: String read GetDBSiteName;
97     property DBImplementationNo: Long read GetDBImplementationNo;
98     property DBImplementationClass: Long read GetDBImplementationClass;
99     property NoReserve: Long read GetNoReserve;
100     property ODSMinorVersion: Long read GetODSMinorVersion;
101     property ODSMajorVersion: Long read GetODSMajorVersion;
102     property PageSize: Long read GetPageSize;
103     property Version: String read GetVersion;
104     property CurrentMemory: Long read GetCurrentMemory;
105     property ForcedWrites: Long read GetForcedWrites;
106     property MaxMemory: Long read GetMaxMemory;
107     property NumBuffers: Long read GetNumBuffers;
108     property SweepInterval: Long read GetSweepInterval;
109     property UserNames: TStringList read GetUserNames;
110     property Fetches: Long read GetFetches;
111     property Marks: Long read GetMarks;
112     property Reads: Long read GetReads;
113     property Writes: Long read GetWrites;
114     property BackoutCount: TStringList read GetBackoutCount;
115     property DeleteCount: TStringList read GetDeleteCount;
116     property ExpungeCount: TStringList read GetExpungeCount;
117     property InsertCount: TStringList read GetInsertCount;
118     property PurgeCount: TStringList read GetPurgeCount;
119     property ReadIdxCount: TStringList read GetReadIdxCount;
120     property ReadSeqCount: TStringList read GetReadSeqCount;
121     property UpdateCount: TStringList read GetUpdateCount;
122     property DBSQLDialect : Long read GetDBSQLDialect;
123     property ReadOnly: Long read GetReadOnly;
124     published
125     property Database: TIBDatabase read FDatabase write FDatabase;
126     end;
127    
128     implementation
129    
130     uses
131 tony 45 FBMessages;
132 tony 33
133     { TIBDatabaseInfo }
134    
135     constructor TIBDatabaseInfo.Create(AOwner: TComponent);
136     begin
137     inherited Create(AOwner);
138     FIBLoaded := False;
139     CheckIBLoaded;
140     FIBLoaded := True;
141     FUserNames := TStringList.Create;
142     FBackoutCount := nil;
143     FDeleteCount := nil;
144     FExpungeCount := nil;
145     FInsertCount := nil;
146     FPurgeCount := nil;
147     FReadIdxCount := nil;
148     FReadSeqCount := nil;
149     FUpdateCount := nil;
150     end;
151    
152     destructor TIBDatabaseInfo.Destroy;
153     begin
154     if FIBLoaded then
155     begin
156     FUserNames.Free;
157     FBackoutCount.Free;
158     FDeleteCount.Free;
159     FExpungeCount.Free;
160     FInsertCount.Free;
161     FPurgeCount.Free;
162     FReadIdxCount.Free;
163     FReadSeqCount.Free;
164     FUpdateCount.Free;
165     end;
166     inherited Destroy;
167     end;
168    
169    
170     function TIBDatabaseInfo.GetAllocation: Long;
171     begin
172     result := GetLongDatabaseInfo(isc_info_allocation);
173     end;
174    
175     function TIBDatabaseInfo.GetBaseLevel: Long;
176 tony 45 var Response: TByteArray;
177 tony 33 begin
178 tony 45 with Database.Attachment.GetDBInformation([isc_info_base_level]) do
179     if (Count > 0) and (Items[0].GetItemType = isc_info_base_level) then
180     begin
181     Response := Items[0].GetAsBytes;
182     Result := Response[1];
183     end
184     else
185     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
186 tony 33 end;
187    
188     function TIBDatabaseInfo.GetDBFileName: String;
189     var
190 tony 45 ConnectionType: integer;
191     SiteName: string;
192 tony 33 begin
193 tony 45 with Database.Attachment.GetDBInformation([isc_info_db_id]) do
194     if (Count > 0) and (Items[0].GetItemType = isc_info_db_id) then
195     Items[0].DecodeIDCluster(ConnectionType,Result,SiteName)
196     else
197     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
198 tony 33 end;
199    
200     function TIBDatabaseInfo.GetDBSiteName: String;
201     var
202 tony 45 ConnectionType: integer;
203     FileName: string;
204 tony 33 begin
205 tony 45 with Database.Attachment.GetDBInformation([isc_info_db_id]) do
206     if (Count > 0) and (Items[0].GetItemType = isc_info_db_id) then
207     Items[0].DecodeIDCluster(ConnectionType,FileName,Result)
208     else
209     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
210 tony 33 end;
211    
212     function TIBDatabaseInfo.GetDBImplementationNo: Long;
213 tony 45 var Response: TByteArray;
214 tony 33 begin
215 tony 45 with Database.Attachment.GetDBInformation([isc_info_implementation]) do
216     if (Count > 0) and (Items[0].GetItemType = isc_info_implementation) then
217     begin
218     Response := Items[0].GetAsBytes;
219     Result := Response[1];
220     end
221     else
222     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
223 tony 33 end;
224    
225     function TIBDatabaseInfo.GetDBImplementationClass: Long;
226 tony 45 var Response: TByteArray;
227 tony 33 begin
228 tony 45 with Database.Attachment.GetDBInformation([isc_info_implementation]) do
229     if (Count > 0) and (Items[0].GetItemType = isc_info_implementation) then
230     begin
231     Response := Items[0].GetAsBytes;
232     Result := Response[2];
233     end
234     else
235     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
236 tony 33 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 tony 45 var Version: byte;
260 tony 33 begin
261 tony 45 with Database.Attachment.GetDBInformation([isc_info_version]) do
262     if (Count > 0) and (Items[0].GetItemType = isc_info_version) then
263     Items[0].DecodeVersionString(Version,Result)
264     else
265     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
266 tony 33 end;
267    
268     function TIBDatabaseInfo.GetCurrentMemory: Long;
269     begin
270     result := GetLongDatabaseInfo(isc_info_current_memory);
271     end;
272    
273     function TIBDatabaseInfo.GetForcedWrites: Long;
274     begin
275     result := GetLongDatabaseInfo(isc_info_forced_writes);
276     end;
277    
278     function TIBDatabaseInfo.GetMaxMemory: Long;
279     begin
280     result := GetLongDatabaseInfo(isc_info_max_memory);
281     end;
282    
283     function TIBDatabaseInfo.GetNumBuffers: Long;
284     begin
285     result := GetLongDatabaseInfo(isc_info_num_buffers);
286     end;
287    
288     function TIBDatabaseInfo.GetSweepInterval: Long;
289     begin
290     result := GetLongDatabaseInfo(isc_info_sweep_interval);
291     end;
292    
293     function TIBDatabaseInfo.GetUserNames: TStringList;
294     begin
295 tony 45 Result := FUserNames;
296 tony 33 FUserNames.Clear;
297 tony 45 with Database.Attachment.GetDBInformation([isc_info_user_names]) do
298     if (Count > 0) and (Items[0].GetItemType = isc_info_user_names) then
299     Items[0].DecodeUserNames(Result)
300     else
301     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
302 tony 33 end;
303    
304     function TIBDatabaseInfo.GetFetches: Long;
305     begin
306     result := GetLongDatabaseInfo(isc_info_fetches);
307     end;
308    
309     function TIBDatabaseInfo.GetMarks: Long;
310     begin
311     result := GetLongDatabaseInfo(isc_info_marks);
312     end;
313    
314     function TIBDatabaseInfo.GetReads: Long;
315     begin
316     result := GetLongDatabaseInfo(isc_info_reads);
317     end;
318    
319     function TIBDatabaseInfo.GetWrites: Long;
320     begin
321     result := GetLongDatabaseInfo(isc_info_writes);
322     end;
323    
324     function TIBDatabaseInfo.GetOperationCounts(DBInfoCommand: Integer; FOperation: TStringList): TStringList;
325 tony 45 var opCounts: TDBOperationCounts;
326     i: integer;
327 tony 33 begin
328     if FOperation = nil then FOperation := TStringList.Create;
329     result := FOperation;
330 tony 45 with Database.Attachment.GetDBInformation([DBInfoCommand]) do
331     if (Count > 0) and (Items[0].GetItemType = DBInfoCommand) then
332     opCounts := Items[0].getOperationCounts
333     else
334     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
335     for i := 0 to Length(opCounts) - 1 do
336     FOperation.Add(IntToStr(opCounts[i].TableID) +'='+IntToStr(opCounts[i].Count));
337 tony 33 end;
338    
339     function TIBDatabaseInfo.GetBackoutCount: TStringList;
340     begin
341     result := GetOperationCounts(isc_info_backout_count,FBackoutCount);
342     end;
343    
344     function TIBDatabaseInfo.GetDeleteCount: TStringList;
345     begin
346     result := GetOperationCounts(isc_info_delete_count,FDeleteCount);
347     end;
348    
349     function TIBDatabaseInfo.GetExpungeCount: TStringList;
350     begin
351     result := GetOperationCounts(isc_info_expunge_count,FExpungeCount);
352     end;
353    
354     function TIBDatabaseInfo.GetInsertCount: TStringList;
355     begin
356     result := GetOperationCounts(isc_info_insert_count,FInsertCount);
357     end;
358    
359     function TIBDatabaseInfo.GetPurgeCount: TStringList;
360     begin
361     result := GetOperationCounts(isc_info_purge_count,FPurgeCount);
362     end;
363    
364     function TIBDatabaseInfo.GetReadIdxCount: TStringList;
365     begin
366     result := GetOperationCounts(isc_info_read_idx_count,FReadIdxCount);
367     end;
368    
369     function TIBDatabaseInfo.GetReadSeqCount: TStringList;
370     begin
371     result := GetOperationCounts(isc_info_read_seq_count,FReadSeqCount);
372     end;
373    
374     function TIBDatabaseInfo.GetUpdateCount: TStringList;
375     begin
376     result := GetOperationCounts(isc_info_update_count,FUpdateCount);
377     end;
378    
379     function TIBDatabaseInfo.GetReadOnly: Long;
380     begin
381     result := GetLongDatabaseInfo(isc_info_db_read_only);
382     end;
383    
384     function TIBDatabaseInfo.GetLongDatabaseInfo(DatabaseInfoCommand: Integer): Long;
385     begin
386 tony 45 with Database.Attachment.GetDBInformation([DatabaseInfoCommand]) do
387     if (Count > 0) and (Items[0].GetItemType = DatabaseInfoCommand) then
388     Result := Items[0].AsInteger
389     else
390     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
391 tony 33 end;
392    
393     function TIBDatabaseInfo.GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
394     begin
395 tony 45 with Database.Attachment.GetDBInformation([DatabaseInfoCommand]) do
396     if (Count > 0) and (Items[0].GetItemType = DatabaseInfoCommand) then
397     Result := Items[0].AsString
398     else
399     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
400 tony 33 end;
401    
402    
403     function TIBDatabaseInfo.GetDBSQLDialect: Integer;
404     begin
405 tony 45 with Database.Attachment.GetDBInformation([isc_info_db_SQL_Dialect]) do
406     if (Count > 0) and (Items[0].GetItemType = isc_info_db_SQL_Dialect) then
407     Result := Items[0].AsInteger
408     else
409     Result := 1;
410 tony 33 end;
411    
412    
413     end.