ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBDatabaseInfo.pas
Revision: 118
Committed: Mon Jan 22 13:58:14 2018 UTC (6 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 14412 byte(s)
Log Message:
Fixes Merged

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