trunk/runtime/IBDatabaseInfo.pas

{************************************************************************}
{                                                                        }
{       Borland Delphi Visual Component Library                          }
{       InterBase Express core components                                }
{                                                                        }
{       Copyright (c) 1998-2000 Inprise Corporation                      }
{                                                                        }
{    InterBase Express is based in part on the product                   }
{    Free IB Components, written by Gregory H. Deatz for                 }
{    Hoagland, Longo, Moran, Dunst & Doukas Company.                     }
{    Free IB Components is used under license.                           }
{                                                                        }
{    The contents of this file are subject to the InterBase              }
{    Public License Version 1.0 (the "License"); you may not             }
{    use this file except in compliance with the License. You            }
{    may obtain a copy of the License at http://www.Inprise.com/IPL.html }
{    Software distributed under the License is distributed on            }
{    an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either              }
{    express or implied. See the License for the specific language       }
{    governing rights and limitations under the License.                 }
{    Portions created by Inprise Corporation are Copyright (C) Inprise   }
{       Corporation. All Rights Reserved.                                }
{    Contributor(s): Jeff Overcash                                       }
{                                                                        }
{    IBX For Lazarus (Firebird Express)                                  }
{    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
{    Portions created by MWA Software are copyright McCallum Whyman      }
{    Associates Ltd 2011                                                 }
{                                                                        }
{************************************************************************}

unit IBDatabaseInfo;

{$Mode Delphi}

interface

uses
  SysUtils, Classes, IB, IBExternals, IBDatabase;

type

  { TIBDatabaseInfo }

  TIBDatabaseInfo = class(TComponent)
  protected
    FDatabase: TIBDatabase;
    FUserNames   : TStringList;
    FBackoutCount: TStringList;
    FDeleteCount: TStringList;
    FExpungeCount: TStringList;
    FInsertCount: TStringList;
    FPurgeCount: TStringList;
    FReadIdxCount: TStringList;
    FReadSeqCount: TStringList;
    FUpdateCount: TStringList;
    procedure CheckDatabase;
    function GetAllocation: Long;
    function GetBaseLevel: Long;
    function GetDBFileName: String;
    function GetDBSiteName: String;
    function GetDBImplementationNo: Long;
    function GetDBImplementationClass: Long;
    function GetNoReserve: Long;
    function GetODSMinorVersion: Long;
    function GetODSMajorVersion: Long;
    function GetPageSize: Long;
    function GetVersion: String;
    function GetCurrentMemory: Long;
    function GetForcedWrites: Long;
    function GetMaxMemory: Long;
    function GetNumBuffers: Long;
    function GetSweepInterval: Long;
    function GetUserNames: TStringList;
    function GetFetches: Long;
    function GetMarks: Long;
    function GetReads: Long;
    function GetWrites: Long;
    function GetBackoutCount: TStringList;
    function GetDeleteCount: TStringList;
    function GetExpungeCount: TStringList;
    function GetInsertCount: TStringList;
    function GetPurgeCount: TStringList;
    function GetReadIdxCount: TStringList;
    function GetReadSeqCount: TStringList;
    function GetUpdateCount: TStringList;
    function GetOperationCounts(DBInfoCommand: Integer; var FOperation: TStringList): TStringList;
    function GetReadOnly: Long;
    function GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
    function GetDBSQLDialect: Long;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetLongDatabaseInfo(DatabaseInfoCommand: Integer): Long;
    property Allocation: Long read GetAllocation;
    property BaseLevel: Long read GetBaseLevel;
    property DBFileName: String read GetDBFileName;
    property DBSiteName: String read GetDBSiteName;
    property DBImplementationNo: Long read GetDBImplementationNo;
    property DBImplementationClass: Long read GetDBImplementationClass;
    property NoReserve: Long read GetNoReserve;
    property ODSMinorVersion: Long read GetODSMinorVersion;
    property ODSMajorVersion: Long read GetODSMajorVersion;
    property PageSize: Long read GetPageSize;
    property Version: String read GetVersion;
    property CurrentMemory: Long read GetCurrentMemory;
    property ForcedWrites: Long read GetForcedWrites;
    property MaxMemory: Long read GetMaxMemory;
    property NumBuffers: Long read GetNumBuffers;
    property SweepInterval: Long read GetSweepInterval;
    property UserNames: TStringList read GetUserNames;
    property Fetches: Long read GetFetches;
    property Marks: Long read GetMarks;
    property Reads: Long read GetReads;
    property Writes: Long read GetWrites;
    property BackoutCount: TStringList read GetBackoutCount;
    property DeleteCount: TStringList read GetDeleteCount;
    property ExpungeCount: TStringList read GetExpungeCount;
    property InsertCount: TStringList read GetInsertCount;
    property PurgeCount: TStringList read GetPurgeCount;
    property ReadIdxCount: TStringList read GetReadIdxCount;
    property ReadSeqCount: TStringList read GetReadSeqCount;
    property UpdateCount: TStringList read GetUpdateCount;
    property DBSQLDialect : Long read GetDBSQLDialect;
    property ReadOnly: Long read GetReadOnly;
  published
    property Database: TIBDatabase read FDatabase write FDatabase;
  end;

implementation

uses
  FBMessages;

{ TIBDatabaseInfo }

constructor TIBDatabaseInfo.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FUserNames := TStringList.Create;
  FBackoutCount                        := nil;
  FDeleteCount                         := nil;
  FExpungeCount                        := nil;
  FInsertCount                         := nil;
  FPurgeCount                          := nil;
  FReadIdxCount                        := nil;
  FReadSeqCount                        := nil;
  FUpdateCount                         := nil;
end;

destructor TIBDatabaseInfo.Destroy;
begin
  if assigned(FUserNames) then FUserNames.Free;
  if assigned(FBackoutCount) then FBackoutCount.Free;
  if assigned(FDeleteCount) then FDeleteCount.Free;
  if assigned(FExpungeCount) then FExpungeCount.Free;
  if assigned(FInsertCount) then FInsertCount.Free;
  if assigned(FPurgeCount) then FPurgeCount.Free;
  if assigned(FReadIdxCount) then FReadIdxCount.Free;
  if assigned(FReadSeqCount) then FReadSeqCount.Free;
  if assigned(FUpdateCount) then FUpdateCount.Free;
  inherited Destroy;
end;

procedure TIBDatabaseInfo.CheckDatabase;
begin
  if Database = nil then
    IBError(ibxeDatabaseNotAssigned,[]);
  if Database.Attachment = nil then
    IBError(ibxeDatabaseClosed,[]);
end;

function TIBDatabaseInfo.GetAllocation: Long;
begin
  result := GetLongDatabaseInfo(isc_info_allocation);
end;

function TIBDatabaseInfo.GetBaseLevel: Long;
var Response: TByteArray;
begin
  CheckDatabase;
  with Database.Attachment.GetDBInformation([isc_info_base_level]) do
    if (Count > 0) and (Items[0].GetItemType = isc_info_base_level) then
    begin
      Response := Items[0].GetAsBytes;
      Result := Response[1];
    end
  else
     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
end;

function TIBDatabaseInfo.GetDBFileName: String;
var
  ConnectionType: integer;
  SiteName: string;
begin
  CheckDatabase;
  with Database.Attachment.GetDBInformation([isc_info_db_id]) do
    if (Count > 0) and (Items[0].GetItemType = isc_info_db_id) then
      Items[0].DecodeIDCluster(ConnectionType,Result,SiteName)
    else
       IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
end;

function TIBDatabaseInfo.GetDBSiteName: String;
var
  ConnectionType: integer;
  FileName: string;
begin
  CheckDatabase;
  with Database.Attachment.GetDBInformation([isc_info_db_id]) do
    if (Count > 0) and (Items[0].GetItemType = isc_info_db_id) then
      Items[0].DecodeIDCluster(ConnectionType,FileName,Result)
    else
       IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
end;

function TIBDatabaseInfo.GetDBImplementationNo: Long;
var Response: TByteArray;
begin
  CheckDatabase;
  with Database.Attachment.GetDBInformation([isc_info_implementation]) do
    if (Count > 0) and (Items[0].GetItemType = isc_info_implementation) then
    begin
      Response := Items[0].GetAsBytes;
      Result := Response[1];
    end
  else
     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
end;

function TIBDatabaseInfo.GetDBImplementationClass: Long;
var Response: TByteArray;
begin
  CheckDatabase;
  with Database.Attachment.GetDBInformation([isc_info_implementation]) do
    if (Count > 0) and (Items[0].GetItemType = isc_info_implementation) then
    begin
      Response := Items[0].GetAsBytes;
      Result := Response[2];
    end
  else
     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
end;

function TIBDatabaseInfo.GetNoReserve: Long;
begin
  result := GetLongDatabaseInfo(isc_info_no_reserve);
end;

function TIBDatabaseInfo.GetODSMinorVersion: Long;
begin
  result := GetLongDatabaseInfo(isc_info_ods_minor_version);
end;

function TIBDatabaseInfo.GetODSMajorVersion: Long;
begin
  result := GetLongDatabaseInfo(isc_info_ods_version);
end;

function TIBDatabaseInfo.GetPageSize: Long;
begin
  result := GetLongDatabaseInfo(isc_info_page_size);
end;

function TIBDatabaseInfo.GetVersion: String;
var Version: byte;
begin
  CheckDatabase;
  with Database.Attachment.GetDBInformation([isc_info_version]) do
    if (Count > 0) and (Items[0].GetItemType = isc_info_version) then
      Items[0].DecodeVersionString(Version,Result)
  else
     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
end;

function TIBDatabaseInfo.GetCurrentMemory: Long;
begin
  result := GetLongDatabaseInfo(isc_info_current_memory);
end;

function TIBDatabaseInfo.GetForcedWrites: Long;
begin
  result := GetLongDatabaseInfo(isc_info_forced_writes);
end;

function TIBDatabaseInfo.GetMaxMemory: Long;
begin
  result := GetLongDatabaseInfo(isc_info_max_memory);
end;

function TIBDatabaseInfo.GetNumBuffers: Long;
begin
  result := GetLongDatabaseInfo(isc_info_num_buffers);
end;

function TIBDatabaseInfo.GetSweepInterval: Long; 
begin
  result := GetLongDatabaseInfo(isc_info_sweep_interval);
end;

function TIBDatabaseInfo.GetUserNames: TStringList;
begin
  CheckDatabase;
  Result := FUserNames;
  FUserNames.Clear;
  with Database.Attachment.GetDBInformation([isc_info_user_names]) do
    if (Count > 0) and (Items[0].GetItemType = isc_info_user_names) then
      Items[0].DecodeUserNames(Result)
  else
     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
end;

function TIBDatabaseInfo.GetFetches: Long;
begin
  result := GetLongDatabaseInfo(isc_info_fetches);
end;

function TIBDatabaseInfo.GetMarks: Long;
begin
  result := GetLongDatabaseInfo(isc_info_marks);
end;

function TIBDatabaseInfo.GetReads: Long;
begin
  result := GetLongDatabaseInfo(isc_info_reads);
end;

function TIBDatabaseInfo.GetWrites: Long;
begin
  result := GetLongDatabaseInfo(isc_info_writes);
end;

function TIBDatabaseInfo.GetOperationCounts(DBInfoCommand: Integer;
  var FOperation: TStringList): TStringList;
var opCounts: TDBOperationCounts;
    i: integer;
begin
  CheckDatabase;
  if FOperation = nil then FOperation := TStringList.Create;
  result := FOperation;
  with Database.Attachment.GetDBInformation([DBInfoCommand]) do
    if (Count > 0) and (Items[0].GetItemType = DBInfoCommand) then
      opCounts := Items[0].getOperationCounts
  else
     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
  for i := 0 to Length(opCounts) - 1 do
    FOperation.Add(IntToStr(opCounts[i].TableID) +'='+IntToStr(opCounts[i].Count));
end;

function TIBDatabaseInfo.GetBackoutCount: TStringList;
begin
  result := GetOperationCounts(isc_info_backout_count,FBackoutCount);
end;

function TIBDatabaseInfo.GetDeleteCount: TStringList;
begin
  result := GetOperationCounts(isc_info_delete_count,FDeleteCount);
end;

function TIBDatabaseInfo.GetExpungeCount: TStringList;
begin
  result := GetOperationCounts(isc_info_expunge_count,FExpungeCount);
end;

function TIBDatabaseInfo.GetInsertCount: TStringList;
begin
  result := GetOperationCounts(isc_info_insert_count,FInsertCount);
end;

function TIBDatabaseInfo.GetPurgeCount: TStringList;
begin
  result := GetOperationCounts(isc_info_purge_count,FPurgeCount);
end;

function TIBDatabaseInfo.GetReadIdxCount: TStringList;
begin
  result := GetOperationCounts(isc_info_read_idx_count,FReadIdxCount);
end;

function TIBDatabaseInfo.GetReadSeqCount: TStringList;
begin
  result := GetOperationCounts(isc_info_read_seq_count,FReadSeqCount);
end;

function TIBDatabaseInfo.GetUpdateCount: TStringList;
begin
  result := GetOperationCounts(isc_info_update_count,FUpdateCount);
end;

function TIBDatabaseInfo.GetReadOnly: Long;
begin
  result := GetLongDatabaseInfo(isc_info_db_read_only);
end;

function TIBDatabaseInfo.GetLongDatabaseInfo(DatabaseInfoCommand: Integer): Long;
begin
  CheckDatabase;
  with Database.Attachment.GetDBInformation([DatabaseInfoCommand]) do
    if (Count > 0) and (Items[0].GetItemType = DatabaseInfoCommand) then
      Result := Items[0].AsInteger
    else
      IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
end;

function TIBDatabaseInfo.GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
begin
  CheckDatabase;
  with Database.Attachment.GetDBInformation([DatabaseInfoCommand]) do
    if (Count > 0) and (Items[0].GetItemType = DatabaseInfoCommand) then
      Result := Items[0].AsString
    else
      IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
end;


function TIBDatabaseInfo.GetDBSQLDialect: Long;
begin
  CheckDatabase;
  with Database.Attachment.GetDBInformation([isc_info_db_SQL_Dialect]) do
    if (Count > 0) and (Items[0].GetItemType = isc_info_db_SQL_Dialect) then
      Result := Items[0].AsInteger
    else
      Result := 1;
end;


end.
Revision:	83
Committed:	Mon Jan 1 11:31:15 2018 UTC (6 years, 10 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
#	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 }
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.