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
  CheckDatabase;
  Result := Database.Attachment.GetODSMinorVersion;
end;

function TIBDatabaseInfo.GetODSMajorVersion: Long;
begin
  CheckDatabase;
  Result := Database.Attachment.GetODSMajorVersion;
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:	118
Committed:	Mon Jan 22 13:58:14 2018 UTC (6 years, 10 months ago) by tony
Content type:	text/x-pascal
File size:	14412 byte(s)
Log Message:	Fixes Merged
#	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	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.