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 (2 years, 1 month ago) by tony
File size: 14412 byte(s)
Log Message:
Fixes Merged
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 CheckDatabase;
254 Result := Database.Attachment.GetODSMinorVersion;
255 end;
256
257 function TIBDatabaseInfo.GetODSMajorVersion: Long;
258 begin
259 CheckDatabase;
260 Result := Database.Attachment.GetODSMajorVersion;
261 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 var Version: byte;
270 begin
271 CheckDatabase;
272 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 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 CheckDatabase;
307 Result := FUserNames;
308 FUserNames.Clear;
309 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 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 function TIBDatabaseInfo.GetOperationCounts(DBInfoCommand: Integer;
337 var FOperation: TStringList): TStringList;
338 var opCounts: TDBOperationCounts;
339 i: integer;
340 begin
341 CheckDatabase;
342 if FOperation = nil then FOperation := TStringList.Create;
343 result := FOperation;
344 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 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 CheckDatabase;
401 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 end;
407
408 function TIBDatabaseInfo.GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
409 begin
410 CheckDatabase;
411 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 end;
417
418
419 function TIBDatabaseInfo.GetDBSQLDialect: Long;
420 begin
421 CheckDatabase;
422 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 end;
428
429
430 end.