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, 3 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

# Content
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 = 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 FBMessages;
132
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 var Response: TByteArray;
177 begin
178 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 end;
187
188 function TIBDatabaseInfo.GetDBFileName: String;
189 var
190 ConnectionType: integer;
191 SiteName: string;
192 begin
193 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 end;
199
200 function TIBDatabaseInfo.GetDBSiteName: String;
201 var
202 ConnectionType: integer;
203 FileName: string;
204 begin
205 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 end;
211
212 function TIBDatabaseInfo.GetDBImplementationNo: Long;
213 var Response: TByteArray;
214 begin
215 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 end;
224
225 function TIBDatabaseInfo.GetDBImplementationClass: Long;
226 var Response: TByteArray;
227 begin
228 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 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 var Version: byte;
260 begin
261 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 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 Result := FUserNames;
296 FUserNames.Clear;
297 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 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 var opCounts: TDBOperationCounts;
326 i: integer;
327 begin
328 if FOperation = nil then FOperation := TStringList.Create;
329 result := FOperation;
330 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 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 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 end;
392
393 function TIBDatabaseInfo.GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
394 begin
395 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 end;
401
402
403 function TIBDatabaseInfo.GetDBSQLDialect: Integer;
404 begin
405 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 end;
411
412
413 end.