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
#	User	Rev	Content
1	tony	33	{************************************************************************}
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	tony	45	SysUtils, Classes, IB, IBExternals, IBDatabase;
40	tony	33
41			type
42
43	tony	80	{ TIBDatabaseInfo }
44
45	tony	33	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	tony	80	procedure CheckDatabase;
58	tony	33	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	tony	83	function GetOperationCounts(DBInfoCommand: Integer; var FOperation: TStringList): TStringList;
88	tony	33	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	tony	45	FBMessages;
134	tony	33
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	tony	80	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	tony	33	inherited Destroy;
163			end;
164
165	tony	80	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	tony	33
173			function TIBDatabaseInfo.GetAllocation: Long;
174			begin
175			result := GetLongDatabaseInfo(isc_info_allocation);
176			end;
177
178			function TIBDatabaseInfo.GetBaseLevel: Long;
179	tony	45	var Response: TByteArray;
180	tony	33	begin
181	tony	80	CheckDatabase;
182	tony	45	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	tony	33	end;
191
192			function TIBDatabaseInfo.GetDBFileName: String;
193			var
194	tony	45	ConnectionType: integer;
195			SiteName: string;
196	tony	33	begin
197	tony	80	CheckDatabase;
198	tony	45	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	tony	33	end;
204
205			function TIBDatabaseInfo.GetDBSiteName: String;
206			var
207	tony	45	ConnectionType: integer;
208			FileName: string;
209	tony	33	begin
210	tony	80	CheckDatabase;
211	tony	45	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	tony	33	end;
217
218			function TIBDatabaseInfo.GetDBImplementationNo: Long;
219	tony	45	var Response: TByteArray;
220	tony	33	begin
221	tony	80	CheckDatabase;
222	tony	45	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	tony	33	end;
231
232			function TIBDatabaseInfo.GetDBImplementationClass: Long;
233	tony	45	var Response: TByteArray;
234	tony	33	begin
235	tony	80	CheckDatabase;
236	tony	45	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	tony	33	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	tony	118	CheckDatabase;
254			Result := Database.Attachment.GetODSMinorVersion;
255	tony	33	end;
256
257			function TIBDatabaseInfo.GetODSMajorVersion: Long;
258			begin
259	tony	118	CheckDatabase;
260			Result := Database.Attachment.GetODSMajorVersion;
261	tony	33	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	tony	45	var Version: byte;
270	tony	33	begin
271	tony	80	CheckDatabase;
272	tony	45	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	tony	33	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	tony	80	CheckDatabase;
307	tony	45	Result := FUserNames;
308	tony	33	FUserNames.Clear;
309	tony	45	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	tony	33	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	tony	83	function TIBDatabaseInfo.GetOperationCounts(DBInfoCommand: Integer;
337			var FOperation: TStringList): TStringList;
338	tony	45	var opCounts: TDBOperationCounts;
339			i: integer;
340	tony	33	begin
341	tony	80	CheckDatabase;
342	tony	33	if FOperation = nil then FOperation := TStringList.Create;
343			result := FOperation;
344	tony	45	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	tony	33	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	tony	80	CheckDatabase;
401	tony	45	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	tony	33	end;
407
408			function TIBDatabaseInfo.GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
409			begin
410	tony	80	CheckDatabase;
411	tony	45	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	tony	33	end;
417
418
419	tony	80	function TIBDatabaseInfo.GetDBSQLDialect: Long;
420	tony	33	begin
421	tony	80	CheckDatabase;
422	tony	45	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	tony	33	end;
428
429
430			end.