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 = class(TComponent)
  protected
    FIBLoaded: Boolean;
    FDatabase: TIBDatabase;
    FUserNames   : TStringList;
    FBackoutCount: TStringList;
    FDeleteCount: TStringList;
    FExpungeCount: TStringList;
    FInsertCount: TStringList;
    FPurgeCount: TStringList;
    FReadIdxCount: TStringList;
    FReadSeqCount: TStringList;
    FUpdateCount: TStringList;
    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; 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);
  FIBLoaded := False;
  CheckIBLoaded;
  FIBLoaded := True;
  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 FIBLoaded then
  begin
    FUserNames.Free;
    FBackoutCount.Free;
    FDeleteCount.Free;
    FExpungeCount.Free;
    FInsertCount.Free;
    FPurgeCount.Free;
    FReadIdxCount.Free;
    FReadSeqCount.Free;
    FUpdateCount.Free;
  end;
  inherited Destroy;
end;


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

function TIBDatabaseInfo.GetBaseLevel: Long;
var Response: TByteArray;
begin
  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
  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
  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
  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
  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
  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
  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; FOperation: TStringList): TStringList;
var opCounts: TDBOperationCounts;
    i: integer;
begin
  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
  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
  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: Integer;
begin
  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:	45
Committed:	Tue Dec 6 10:33:46 2016 UTC (7 years, 11 months ago) by tony
Content type:	text/x-pascal
File size:	13811 byte(s)
Log Message:	Committing updates for Release R2-0-0
#	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.