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 (2 years, 7 months ago) by tony
File size: 14390 byte(s)
Log Message:
IBDatabaseInfo: Remove memory leak when accessing database operation counts
Line File contents
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, IB, IBExternals, IBDatabase;
40
41 type
42
43 { TIBDatabaseInfo }
44
45 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 procedure CheckDatabase;
58 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 function GetOperationCounts(DBInfoCommand: Integer; var FOperation: TStringList): TStringList;
88 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 FBMessages;
134
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 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 inherited Destroy;
163 end;
164
165 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
173 function TIBDatabaseInfo.GetAllocation: Long;
174 begin
175 result := GetLongDatabaseInfo(isc_info_allocation);
176 end;
177
178 function TIBDatabaseInfo.GetBaseLevel: Long;
179 var Response: TByteArray;
180 begin
181 CheckDatabase;
182 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 end;
191
192 function TIBDatabaseInfo.GetDBFileName: String;
193 var
194 ConnectionType: integer;
195 SiteName: string;
196 begin
197 CheckDatabase;
198 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 end;
204
205 function TIBDatabaseInfo.GetDBSiteName: String;
206 var
207 ConnectionType: integer;
208 FileName: string;
209 begin
210 CheckDatabase;
211 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 end;
217
218 function TIBDatabaseInfo.GetDBImplementationNo: Long;
219 var Response: TByteArray;
220 begin
221 CheckDatabase;
222 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 end;
231
232 function TIBDatabaseInfo.GetDBImplementationClass: Long;
233 var Response: TByteArray;
234 begin
235 CheckDatabase;
236 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 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 var Version: byte;
268 begin
269 CheckDatabase;
270 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 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 CheckDatabase;
305 Result := FUserNames;
306 FUserNames.Clear;
307 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 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 function TIBDatabaseInfo.GetOperationCounts(DBInfoCommand: Integer;
335 var FOperation: TStringList): TStringList;
336 var opCounts: TDBOperationCounts;
337 i: integer;
338 begin
339 CheckDatabase;
340 if FOperation = nil then FOperation := TStringList.Create;
341 result := FOperation;
342 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 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 CheckDatabase;
399 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 end;
405
406 function TIBDatabaseInfo.GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
407 begin
408 CheckDatabase;
409 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 end;
415
416
417 function TIBDatabaseInfo.GetDBSQLDialect: Long;
418 begin
419 CheckDatabase;
420 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 end;
426
427
428 end.