ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBDatabaseInfo.pas
Revision: 83
Committed: Mon Jan 1 11:31:15 2018 UTC (6 years, 2 months ago) by tony
Content type: text/x-pascal
File size: 14390 byte(s)
Log Message:
IBDatabaseInfo: Remove memory leak when accessing database operation counts

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     result := GetLongDatabaseInfo(isc_info_ods_minor_version);
254     end;
255    
256     function TIBDatabaseInfo.GetODSMajorVersion: Long;
257     begin
258     result := GetLongDatabaseInfo(isc_info_ods_version);
259     end;
260    
261     function TIBDatabaseInfo.GetPageSize: Long;
262     begin
263     result := GetLongDatabaseInfo(isc_info_page_size);
264     end;
265    
266     function TIBDatabaseInfo.GetVersion: String;
267 tony 45 var Version: byte;
268 tony 33 begin
269 tony 80 CheckDatabase;
270 tony 45 with Database.Attachment.GetDBInformation([isc_info_version]) do
271     if (Count > 0) and (Items[0].GetItemType = isc_info_version) then
272     Items[0].DecodeVersionString(Version,Result)
273     else
274     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
275 tony 33 end;
276    
277     function TIBDatabaseInfo.GetCurrentMemory: Long;
278     begin
279     result := GetLongDatabaseInfo(isc_info_current_memory);
280     end;
281    
282     function TIBDatabaseInfo.GetForcedWrites: Long;
283     begin
284     result := GetLongDatabaseInfo(isc_info_forced_writes);
285     end;
286    
287     function TIBDatabaseInfo.GetMaxMemory: Long;
288     begin
289     result := GetLongDatabaseInfo(isc_info_max_memory);
290     end;
291    
292     function TIBDatabaseInfo.GetNumBuffers: Long;
293     begin
294     result := GetLongDatabaseInfo(isc_info_num_buffers);
295     end;
296    
297     function TIBDatabaseInfo.GetSweepInterval: Long;
298     begin
299     result := GetLongDatabaseInfo(isc_info_sweep_interval);
300     end;
301    
302     function TIBDatabaseInfo.GetUserNames: TStringList;
303     begin
304 tony 80 CheckDatabase;
305 tony 45 Result := FUserNames;
306 tony 33 FUserNames.Clear;
307 tony 45 with Database.Attachment.GetDBInformation([isc_info_user_names]) do
308     if (Count > 0) and (Items[0].GetItemType = isc_info_user_names) then
309     Items[0].DecodeUserNames(Result)
310     else
311     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
312 tony 33 end;
313    
314     function TIBDatabaseInfo.GetFetches: Long;
315     begin
316     result := GetLongDatabaseInfo(isc_info_fetches);
317     end;
318    
319     function TIBDatabaseInfo.GetMarks: Long;
320     begin
321     result := GetLongDatabaseInfo(isc_info_marks);
322     end;
323    
324     function TIBDatabaseInfo.GetReads: Long;
325     begin
326     result := GetLongDatabaseInfo(isc_info_reads);
327     end;
328    
329     function TIBDatabaseInfo.GetWrites: Long;
330     begin
331     result := GetLongDatabaseInfo(isc_info_writes);
332     end;
333    
334 tony 83 function TIBDatabaseInfo.GetOperationCounts(DBInfoCommand: Integer;
335     var FOperation: TStringList): TStringList;
336 tony 45 var opCounts: TDBOperationCounts;
337     i: integer;
338 tony 33 begin
339 tony 80 CheckDatabase;
340 tony 33 if FOperation = nil then FOperation := TStringList.Create;
341     result := FOperation;
342 tony 45 with Database.Attachment.GetDBInformation([DBInfoCommand]) do
343     if (Count > 0) and (Items[0].GetItemType = DBInfoCommand) then
344     opCounts := Items[0].getOperationCounts
345     else
346     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
347     for i := 0 to Length(opCounts) - 1 do
348     FOperation.Add(IntToStr(opCounts[i].TableID) +'='+IntToStr(opCounts[i].Count));
349 tony 33 end;
350    
351     function TIBDatabaseInfo.GetBackoutCount: TStringList;
352     begin
353     result := GetOperationCounts(isc_info_backout_count,FBackoutCount);
354     end;
355    
356     function TIBDatabaseInfo.GetDeleteCount: TStringList;
357     begin
358     result := GetOperationCounts(isc_info_delete_count,FDeleteCount);
359     end;
360    
361     function TIBDatabaseInfo.GetExpungeCount: TStringList;
362     begin
363     result := GetOperationCounts(isc_info_expunge_count,FExpungeCount);
364     end;
365    
366     function TIBDatabaseInfo.GetInsertCount: TStringList;
367     begin
368     result := GetOperationCounts(isc_info_insert_count,FInsertCount);
369     end;
370    
371     function TIBDatabaseInfo.GetPurgeCount: TStringList;
372     begin
373     result := GetOperationCounts(isc_info_purge_count,FPurgeCount);
374     end;
375    
376     function TIBDatabaseInfo.GetReadIdxCount: TStringList;
377     begin
378     result := GetOperationCounts(isc_info_read_idx_count,FReadIdxCount);
379     end;
380    
381     function TIBDatabaseInfo.GetReadSeqCount: TStringList;
382     begin
383     result := GetOperationCounts(isc_info_read_seq_count,FReadSeqCount);
384     end;
385    
386     function TIBDatabaseInfo.GetUpdateCount: TStringList;
387     begin
388     result := GetOperationCounts(isc_info_update_count,FUpdateCount);
389     end;
390    
391     function TIBDatabaseInfo.GetReadOnly: Long;
392     begin
393     result := GetLongDatabaseInfo(isc_info_db_read_only);
394     end;
395    
396     function TIBDatabaseInfo.GetLongDatabaseInfo(DatabaseInfoCommand: Integer): Long;
397     begin
398 tony 80 CheckDatabase;
399 tony 45 with Database.Attachment.GetDBInformation([DatabaseInfoCommand]) do
400     if (Count > 0) and (Items[0].GetItemType = DatabaseInfoCommand) then
401     Result := Items[0].AsInteger
402     else
403     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
404 tony 33 end;
405    
406     function TIBDatabaseInfo.GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
407     begin
408 tony 80 CheckDatabase;
409 tony 45 with Database.Attachment.GetDBInformation([DatabaseInfoCommand]) do
410     if (Count > 0) and (Items[0].GetItemType = DatabaseInfoCommand) then
411     Result := Items[0].AsString
412     else
413     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
414 tony 33 end;
415    
416    
417 tony 80 function TIBDatabaseInfo.GetDBSQLDialect: Long;
418 tony 33 begin
419 tony 80 CheckDatabase;
420 tony 45 with Database.Attachment.GetDBInformation([isc_info_db_SQL_Dialect]) do
421     if (Count > 0) and (Items[0].GetItemType = isc_info_db_SQL_Dialect) then
422     Result := Items[0].AsInteger
423     else
424     Result := 1;
425 tony 33 end;
426    
427    
428     end.