runtime/nongui/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 - 2018                                               }
{                                                                        }
{************************************************************************}

unit IBDatabaseInfo;

{$Mode Delphi}

interface

uses
  SysUtils, Classes, IB, IBExternals, IBDatabase;

type

  { TIBDatabaseInfo }

  TIBDatabaseInfo = class(TComponent)
  private
    function GetDateDBCreated: TDateTime;
    function GetEncrypted: boolean;
    function GetEncryptionKeyName: string;
    function GetPagesFree: int64;
    function GetPagesUsed: int64;
    function GetTransactionCount: int64;
  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: int64;
    function GetBaseLevel: byte;
    function GetDBFileName: String;
    function GetDBSiteName: String;
    function GetDBImplementationNo: byte;
    function GetDBImplementationClass: byte;
    function GetNoReserve: int64;
    function GetODSMinorVersion: integer;
    function GetODSMajorVersion: integer;
    function GetPageSize: int64;
    function GetVersion: String;
    function GetCurrentMemory: Int64;
    function GetForcedWrites: Int64;
    function GetMaxMemory: Int64;
    function GetNumBuffers: Int64;
    function GetSweepInterval: Int64;
    function GetUserNames: TStringList;
    function GetFetches: Int64;
    function GetMarks: Int64;
    function GetReads: Int64;
    function GetWrites: Int64;
    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: Int64;
    function GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
    function GetDBSQLDialect: Int64;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetLongDatabaseInfo(DatabaseInfoCommand: Integer): long;  deprecated 'Use GetIntDatabaseInfo instead';
    function GetIntDatabaseInfo(DatabaseInfoCommand: Integer): Int64;
    function GetDatabasePage(PageNo: integer): string;
    property Allocation: Int64 read GetAllocation;
    property BaseLevel: byte read GetBaseLevel;
    property DateDBCreated: TDateTime read GetDateDBCreated;
    property DBFileName: String read GetDBFileName;
    property DBSiteName: String read GetDBSiteName;
    property DBImplementationNo: byte read GetDBImplementationNo;
    property DBImplementationClass: byte read GetDBImplementationClass;
    property Encrypted: boolean read GetEncrypted;
    property EncryptionKeyName: string read GetEncryptionKeyName;
    property NoReserve: Int64 read GetNoReserve;
    property ODSMinorVersion: integer read GetODSMinorVersion;
    property ODSMajorVersion: integer read GetODSMajorVersion;
    property PageSize: Int64 read GetPageSize;
    property Version: String read GetVersion;
    property CurrentMemory: Int64 read GetCurrentMemory;
    property ForcedWrites: Int64 read GetForcedWrites;
    property MaxMemory: Int64 read GetMaxMemory;
    property NumBuffers: Int64 read GetNumBuffers;
    property SweepInterval: Int64 read GetSweepInterval;
    property UserNames: TStringList read GetUserNames;
    property Fetches: Int64 read GetFetches;
    property Marks: Int64 read GetMarks;
    property Reads: Int64 read GetReads;
    property Writes: Int64 read GetWrites;
    property TransactionCount: Int64 read GetTransactionCount;
    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 : Int64 read GetDBSQLDialect;
    property PagesUsed: Int64 read GetPagesUsed;
    property PagesFree: Int64 read GetPagesFree;
    property ReadOnly: Int64 read GetReadOnly;
  published
    property Database: TIBDatabase read FDatabase write FDatabase;
  end;

implementation

uses
  IBMessages;

{ 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;

function TIBDatabaseInfo.GetDateDBCreated: TDateTime;
begin
  CheckDatabase;
  with Database.Attachment.GetDBInformation([isc_info_creation_date]) do
    if (Count > 0) and (Items[0].GetItemType = isc_info_creation_date) then
      Result := Items[0].GetAsDateTime
    else
      IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
end;

function TIBDatabaseInfo.GetEncrypted: boolean;
var ConnFlags: Int64;
begin
  Result := ODSMajorVersion >= 12;
  if Result then
  try
    ConnFlags := GetIntDatabaseInfo(fb_info_conn_flags);
    Result := (ConnFlags and fb_info_crypt_encrypted) <> 0;
  except
    Result := false; {Introduced in Firebird 3.0.3}
  end;
end;

function TIBDatabaseInfo.GetEncryptionKeyName: string;
begin
  CheckDatabase;
  {Introduced in Firebird 3.0.3}
  with Database.Attachment.GetDBInformation([fb_info_crypt_key]) do
    if (Count > 0) and (Items[0].GetItemType = fb_info_crypt_key) then
      Result := Items[0].AsString
    else
     IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
end;

function TIBDatabaseInfo.GetPagesFree: int64;
begin
  result := GetIntDatabaseInfo(fb_info_pages_used);
end;

function TIBDatabaseInfo.GetPagesUsed: int64;
begin
  result := GetIntDatabaseInfo(fb_info_pages_free);
end;

function TIBDatabaseInfo.GetTransactionCount: int64;
begin
  result := GetIntDatabaseInfo(isc_info_active_tran_count);
end;

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

function TIBDatabaseInfo.GetAllocation: int64;
begin
  result := GetIntDatabaseInfo(isc_info_allocation);
end;

function TIBDatabaseInfo.GetBaseLevel: byte;
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: byte;
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: byte;
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: int64;
begin
  result := GetIntDatabaseInfo(isc_info_no_reserve);
end;

function TIBDatabaseInfo.GetODSMinorVersion: integer;
begin
  CheckDatabase;
  Result := Database.Attachment.GetODSMinorVersion;
end;

function TIBDatabaseInfo.GetODSMajorVersion: integer;
begin
  CheckDatabase;
  Result := Database.Attachment.GetODSMajorVersion;
end;

function TIBDatabaseInfo.GetPageSize: int64;
begin
  result := GetIntDatabaseInfo(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: Int64;
begin
  result := GetIntDatabaseInfo(isc_info_current_memory);
end;

function TIBDatabaseInfo.GetForcedWrites: Int64;
begin
  result := GetIntDatabaseInfo(isc_info_forced_writes);
end;

function TIBDatabaseInfo.GetMaxMemory: Int64;
begin
  result := GetIntDatabaseInfo(isc_info_max_memory);
end;

function TIBDatabaseInfo.GetNumBuffers: Int64;
begin
  result := GetIntDatabaseInfo(isc_info_num_buffers);
end;

function TIBDatabaseInfo.GetSweepInterval: Int64; 
begin
  result := GetIntDatabaseInfo(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: Int64;
begin
  result := GetIntDatabaseInfo(isc_info_fetches);
end;

function TIBDatabaseInfo.GetMarks: Int64;
begin
  result := GetIntDatabaseInfo(isc_info_marks);
end;

function TIBDatabaseInfo.GetReads: Int64;
begin
  result := GetIntDatabaseInfo(isc_info_reads);
end;

function TIBDatabaseInfo.GetWrites: Int64;
begin
  result := GetIntDatabaseInfo(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: Int64;
begin
  result := GetIntDatabaseInfo(isc_info_db_read_only);
end;

function TIBDatabaseInfo.GetLongDatabaseInfo(DatabaseInfoCommand: Integer
  ): long;
begin
  Result := GetIntDatabaseInfo(DatabaseInfoCommand);
end;

function TIBDatabaseInfo.GetIntDatabaseInfo(DatabaseInfoCommand: Integer
  ): Int64;
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.GetDatabasePage(PageNo: integer): string;
var DBRequest: IDIRB;
begin
  DBRequest := Database.Attachment.AllocateDIRB;
  DBRequest.Add(fb_info_page_contents).AsInteger := PageNo;
  with Database.Attachment.GetDBInformation(DBRequest) do
    if (Count > 0) and (Items[0].GetItemType = fb_info_page_contents) then
      Result := Items[0].AsString
    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: Int64;
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:	345
Committed:	Mon Aug 23 14:22:29 2021 UTC (2 years, 8 months ago) by tony
Content type:	text/x-pascal
File size:	17160 byte(s)
Log Message:	Merged into public release
#	User	Rev	Content
1	tony	209	{************************************************************************}
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 - 2018 }
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			private
47			function GetDateDBCreated: TDateTime;
48			function GetEncrypted: boolean;
49			function GetEncryptionKeyName: string;
50	tony	345	function GetPagesFree: int64;
51			function GetPagesUsed: int64;
52			function GetTransactionCount: int64;
53	tony	209	protected
54			FDatabase: TIBDatabase;
55			FUserNames : TStringList;
56			FBackoutCount: TStringList;
57			FDeleteCount: TStringList;
58			FExpungeCount: TStringList;
59			FInsertCount: TStringList;
60			FPurgeCount: TStringList;
61			FReadIdxCount: TStringList;
62			FReadSeqCount: TStringList;
63			FUpdateCount: TStringList;
64			procedure CheckDatabase;
65	tony	345	function GetAllocation: int64;
66			function GetBaseLevel: byte;
67	tony	209	function GetDBFileName: String;
68			function GetDBSiteName: String;
69	tony	345	function GetDBImplementationNo: byte;
70			function GetDBImplementationClass: byte;
71			function GetNoReserve: int64;
72			function GetODSMinorVersion: integer;
73			function GetODSMajorVersion: integer;
74			function GetPageSize: int64;
75	tony	209	function GetVersion: String;
76	tony	345	function GetCurrentMemory: Int64;
77			function GetForcedWrites: Int64;
78			function GetMaxMemory: Int64;
79			function GetNumBuffers: Int64;
80			function GetSweepInterval: Int64;
81	tony	209	function GetUserNames: TStringList;
82	tony	345	function GetFetches: Int64;
83			function GetMarks: Int64;
84			function GetReads: Int64;
85			function GetWrites: Int64;
86	tony	209	function GetBackoutCount: TStringList;
87			function GetDeleteCount: TStringList;
88			function GetExpungeCount: TStringList;
89			function GetInsertCount: TStringList;
90			function GetPurgeCount: TStringList;
91			function GetReadIdxCount: TStringList;
92			function GetReadSeqCount: TStringList;
93			function GetUpdateCount: TStringList;
94			function GetOperationCounts(DBInfoCommand: Integer; var FOperation: TStringList): TStringList;
95	tony	345	function GetReadOnly: Int64;
96	tony	209	function GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
97	tony	345	function GetDBSQLDialect: Int64;
98	tony	209	public
99			constructor Create(AOwner: TComponent); override;
100			destructor Destroy; override;
101	tony	345	function GetLongDatabaseInfo(DatabaseInfoCommand: Integer): long; deprecated 'Use GetIntDatabaseInfo instead';
102			function GetIntDatabaseInfo(DatabaseInfoCommand: Integer): Int64;
103	tony	209	function GetDatabasePage(PageNo: integer): string;
104	tony	345	property Allocation: Int64 read GetAllocation;
105			property BaseLevel: byte read GetBaseLevel;
106	tony	209	property DateDBCreated: TDateTime read GetDateDBCreated;
107			property DBFileName: String read GetDBFileName;
108			property DBSiteName: String read GetDBSiteName;
109	tony	345	property DBImplementationNo: byte read GetDBImplementationNo;
110			property DBImplementationClass: byte read GetDBImplementationClass;
111	tony	209	property Encrypted: boolean read GetEncrypted;
112			property EncryptionKeyName: string read GetEncryptionKeyName;
113	tony	345	property NoReserve: Int64 read GetNoReserve;
114			property ODSMinorVersion: integer read GetODSMinorVersion;
115			property ODSMajorVersion: integer read GetODSMajorVersion;
116			property PageSize: Int64 read GetPageSize;
117	tony	209	property Version: String read GetVersion;
118	tony	345	property CurrentMemory: Int64 read GetCurrentMemory;
119			property ForcedWrites: Int64 read GetForcedWrites;
120			property MaxMemory: Int64 read GetMaxMemory;
121			property NumBuffers: Int64 read GetNumBuffers;
122			property SweepInterval: Int64 read GetSweepInterval;
123	tony	209	property UserNames: TStringList read GetUserNames;
124	tony	345	property Fetches: Int64 read GetFetches;
125			property Marks: Int64 read GetMarks;
126			property Reads: Int64 read GetReads;
127			property Writes: Int64 read GetWrites;
128			property TransactionCount: Int64 read GetTransactionCount;
129	tony	209	property BackoutCount: TStringList read GetBackoutCount;
130			property DeleteCount: TStringList read GetDeleteCount;
131			property ExpungeCount: TStringList read GetExpungeCount;
132			property InsertCount: TStringList read GetInsertCount;
133			property PurgeCount: TStringList read GetPurgeCount;
134			property ReadIdxCount: TStringList read GetReadIdxCount;
135			property ReadSeqCount: TStringList read GetReadSeqCount;
136			property UpdateCount: TStringList read GetUpdateCount;
137	tony	345	property DBSQLDialect : Int64 read GetDBSQLDialect;
138			property PagesUsed: Int64 read GetPagesUsed;
139			property PagesFree: Int64 read GetPagesFree;
140			property ReadOnly: Int64 read GetReadOnly;
141	tony	209	published
142			property Database: TIBDatabase read FDatabase write FDatabase;
143			end;
144
145			implementation
146
147			uses
148	tony	291	IBMessages;
149	tony	209
150			{ TIBDatabaseInfo }
151
152			constructor TIBDatabaseInfo.Create(AOwner: TComponent);
153			begin
154			inherited Create(AOwner);
155			FUserNames := TStringList.Create;
156			FBackoutCount := nil;
157			FDeleteCount := nil;
158			FExpungeCount := nil;
159			FInsertCount := nil;
160			FPurgeCount := nil;
161			FReadIdxCount := nil;
162			FReadSeqCount := nil;
163			FUpdateCount := nil;
164			end;
165
166			destructor TIBDatabaseInfo.Destroy;
167			begin
168			if assigned(FUserNames) then FUserNames.Free;
169			if assigned(FBackoutCount) then FBackoutCount.Free;
170			if assigned(FDeleteCount) then FDeleteCount.Free;
171			if assigned(FExpungeCount) then FExpungeCount.Free;
172			if assigned(FInsertCount) then FInsertCount.Free;
173			if assigned(FPurgeCount) then FPurgeCount.Free;
174			if assigned(FReadIdxCount) then FReadIdxCount.Free;
175			if assigned(FReadSeqCount) then FReadSeqCount.Free;
176			if assigned(FUpdateCount) then FUpdateCount.Free;
177			inherited Destroy;
178			end;
179
180			function TIBDatabaseInfo.GetDateDBCreated: TDateTime;
181			begin
182			CheckDatabase;
183			with Database.Attachment.GetDBInformation([isc_info_creation_date]) do
184			if (Count > 0) and (Items[0].GetItemType = isc_info_creation_date) then
185			Result := Items[0].GetAsDateTime
186			else
187			IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
188			end;
189
190			function TIBDatabaseInfo.GetEncrypted: boolean;
191	tony	345	var ConnFlags: Int64;
192	tony	209	begin
193			Result := ODSMajorVersion >= 12;
194			if Result then
195			try
196	tony	345	ConnFlags := GetIntDatabaseInfo(fb_info_conn_flags);
197	tony	209	Result := (ConnFlags and fb_info_crypt_encrypted) <> 0;
198			except
199			Result := false; {Introduced in Firebird 3.0.3}
200			end;
201			end;
202
203			function TIBDatabaseInfo.GetEncryptionKeyName: string;
204			begin
205			CheckDatabase;
206			{Introduced in Firebird 3.0.3}
207			with Database.Attachment.GetDBInformation([fb_info_crypt_key]) do
208			if (Count > 0) and (Items[0].GetItemType = fb_info_crypt_key) then
209			Result := Items[0].AsString
210			else
211			IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
212			end;
213
214	tony	345	function TIBDatabaseInfo.GetPagesFree: int64;
215	tony	209	begin
216	tony	345	result := GetIntDatabaseInfo(fb_info_pages_used);
217	tony	209	end;
218
219	tony	345	function TIBDatabaseInfo.GetPagesUsed: int64;
220	tony	209	begin
221	tony	345	result := GetIntDatabaseInfo(fb_info_pages_free);
222	tony	209	end;
223
224	tony	345	function TIBDatabaseInfo.GetTransactionCount: int64;
225	tony	209	begin
226	tony	345	result := GetIntDatabaseInfo(isc_info_active_tran_count);
227	tony	209	end;
228
229			procedure TIBDatabaseInfo.CheckDatabase;
230			begin
231			if Database = nil then
232			IBError(ibxeDatabaseNotAssigned,[]);
233			if Database.Attachment = nil then
234			IBError(ibxeDatabaseClosed,[]);
235			end;
236
237	tony	345	function TIBDatabaseInfo.GetAllocation: int64;
238	tony	209	begin
239	tony	345	result := GetIntDatabaseInfo(isc_info_allocation);
240	tony	209	end;
241
242	tony	345	function TIBDatabaseInfo.GetBaseLevel: byte;
243	tony	209	var Response: TByteArray;
244			begin
245			CheckDatabase;
246			with Database.Attachment.GetDBInformation([isc_info_base_level]) do
247			if (Count > 0) and (Items[0].GetItemType = isc_info_base_level) then
248			begin
249			Response := Items[0].GetAsBytes;
250			Result := Response[1];
251			end
252			else
253			IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
254			end;
255
256			function TIBDatabaseInfo.GetDBFileName: String;
257			var
258			ConnectionType: integer;
259			SiteName: string;
260			begin
261			CheckDatabase;
262			with Database.Attachment.GetDBInformation([isc_info_db_id]) do
263			if (Count > 0) and (Items[0].GetItemType = isc_info_db_id) then
264			Items[0].DecodeIDCluster(ConnectionType,Result,SiteName)
265			else
266			IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
267			end;
268
269			function TIBDatabaseInfo.GetDBSiteName: String;
270			var
271			ConnectionType: integer;
272			FileName: string;
273			begin
274			CheckDatabase;
275			with Database.Attachment.GetDBInformation([isc_info_db_id]) do
276			if (Count > 0) and (Items[0].GetItemType = isc_info_db_id) then
277			Items[0].DecodeIDCluster(ConnectionType,FileName,Result)
278			else
279			IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
280			end;
281
282	tony	345	function TIBDatabaseInfo.GetDBImplementationNo: byte;
283	tony	209	var Response: TByteArray;
284			begin
285			CheckDatabase;
286			with Database.Attachment.GetDBInformation([isc_info_implementation]) do
287			if (Count > 0) and (Items[0].GetItemType = isc_info_implementation) then
288			begin
289			Response := Items[0].GetAsBytes;
290			Result := Response[1];
291			end
292			else
293			IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
294			end;
295
296	tony	345	function TIBDatabaseInfo.GetDBImplementationClass: byte;
297	tony	209	var Response: TByteArray;
298			begin
299			CheckDatabase;
300			with Database.Attachment.GetDBInformation([isc_info_implementation]) do
301			if (Count > 0) and (Items[0].GetItemType = isc_info_implementation) then
302			begin
303			Response := Items[0].GetAsBytes;
304			Result := Response[2];
305			end
306			else
307			IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
308			end;
309
310	tony	345	function TIBDatabaseInfo.GetNoReserve: int64;
311	tony	209	begin
312	tony	345	result := GetIntDatabaseInfo(isc_info_no_reserve);
313	tony	209	end;
314
315	tony	345	function TIBDatabaseInfo.GetODSMinorVersion: integer;
316	tony	209	begin
317			CheckDatabase;
318			Result := Database.Attachment.GetODSMinorVersion;
319			end;
320
321	tony	345	function TIBDatabaseInfo.GetODSMajorVersion: integer;
322	tony	209	begin
323			CheckDatabase;
324			Result := Database.Attachment.GetODSMajorVersion;
325			end;
326
327	tony	345	function TIBDatabaseInfo.GetPageSize: int64;
328	tony	209	begin
329	tony	345	result := GetIntDatabaseInfo(isc_info_page_size);
330	tony	209	end;
331
332			function TIBDatabaseInfo.GetVersion: String;
333			var Version: byte;
334			begin
335			CheckDatabase;
336			with Database.Attachment.GetDBInformation([isc_info_version]) do
337			if (Count > 0) and (Items[0].GetItemType = isc_info_version) then
338			Items[0].DecodeVersionString(Version,Result)
339			else
340			IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
341			end;
342
343	tony	345	function TIBDatabaseInfo.GetCurrentMemory: Int64;
344	tony	209	begin
345	tony	345	result := GetIntDatabaseInfo(isc_info_current_memory);
346	tony	209	end;
347
348	tony	345	function TIBDatabaseInfo.GetForcedWrites: Int64;
349	tony	209	begin
350	tony	345	result := GetIntDatabaseInfo(isc_info_forced_writes);
351	tony	209	end;
352
353	tony	345	function TIBDatabaseInfo.GetMaxMemory: Int64;
354	tony	209	begin
355	tony	345	result := GetIntDatabaseInfo(isc_info_max_memory);
356	tony	209	end;
357
358	tony	345	function TIBDatabaseInfo.GetNumBuffers: Int64;
359	tony	209	begin
360	tony	345	result := GetIntDatabaseInfo(isc_info_num_buffers);
361	tony	209	end;
362
363	tony	345	function TIBDatabaseInfo.GetSweepInterval: Int64;
364	tony	209	begin
365	tony	345	result := GetIntDatabaseInfo(isc_info_sweep_interval);
366	tony	209	end;
367
368			function TIBDatabaseInfo.GetUserNames: TStringList;
369			begin
370			CheckDatabase;
371			Result := FUserNames;
372			FUserNames.Clear;
373			with Database.Attachment.GetDBInformation([isc_info_user_names]) do
374			if (Count > 0) and (Items[0].GetItemType = isc_info_user_names) then
375			Items[0].DecodeUserNames(Result)
376			else
377			IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
378			end;
379
380	tony	345	function TIBDatabaseInfo.GetFetches: Int64;
381	tony	209	begin
382	tony	345	result := GetIntDatabaseInfo(isc_info_fetches);
383	tony	209	end;
384
385	tony	345	function TIBDatabaseInfo.GetMarks: Int64;
386	tony	209	begin
387	tony	345	result := GetIntDatabaseInfo(isc_info_marks);
388	tony	209	end;
389
390	tony	345	function TIBDatabaseInfo.GetReads: Int64;
391	tony	209	begin
392	tony	345	result := GetIntDatabaseInfo(isc_info_reads);
393	tony	209	end;
394
395	tony	345	function TIBDatabaseInfo.GetWrites: Int64;
396	tony	209	begin
397	tony	345	result := GetIntDatabaseInfo(isc_info_writes);
398	tony	209	end;
399
400			function TIBDatabaseInfo.GetOperationCounts(DBInfoCommand: Integer;
401			var FOperation: TStringList): TStringList;
402			var opCounts: TDBOperationCounts;
403			i: integer;
404			begin
405			CheckDatabase;
406			if FOperation = nil then FOperation := TStringList.Create;
407			result := FOperation;
408			with Database.Attachment.GetDBInformation([DBInfoCommand]) do
409			if (Count > 0) and (Items[0].GetItemType = DBInfoCommand) then
410			opCounts := Items[0].getOperationCounts
411			else
412			IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
413			for i := 0 to Length(opCounts) - 1 do
414			FOperation.Add(IntToStr(opCounts[i].TableID) +'='+IntToStr(opCounts[i].Count));
415			end;
416
417			function TIBDatabaseInfo.GetBackoutCount: TStringList;
418			begin
419			result := GetOperationCounts(isc_info_backout_count,FBackoutCount);
420			end;
421
422			function TIBDatabaseInfo.GetDeleteCount: TStringList;
423			begin
424			result := GetOperationCounts(isc_info_delete_count,FDeleteCount);
425			end;
426
427			function TIBDatabaseInfo.GetExpungeCount: TStringList;
428			begin
429			result := GetOperationCounts(isc_info_expunge_count,FExpungeCount);
430			end;
431
432			function TIBDatabaseInfo.GetInsertCount: TStringList;
433			begin
434			result := GetOperationCounts(isc_info_insert_count,FInsertCount);
435			end;
436
437			function TIBDatabaseInfo.GetPurgeCount: TStringList;
438			begin
439			result := GetOperationCounts(isc_info_purge_count,FPurgeCount);
440			end;
441
442			function TIBDatabaseInfo.GetReadIdxCount: TStringList;
443			begin
444			result := GetOperationCounts(isc_info_read_idx_count,FReadIdxCount);
445			end;
446
447			function TIBDatabaseInfo.GetReadSeqCount: TStringList;
448			begin
449			result := GetOperationCounts(isc_info_read_seq_count,FReadSeqCount);
450			end;
451
452			function TIBDatabaseInfo.GetUpdateCount: TStringList;
453			begin
454			result := GetOperationCounts(isc_info_update_count,FUpdateCount);
455			end;
456
457	tony	345	function TIBDatabaseInfo.GetReadOnly: Int64;
458	tony	209	begin
459	tony	345	result := GetIntDatabaseInfo(isc_info_db_read_only);
460	tony	209	end;
461
462	tony	345	function TIBDatabaseInfo.GetLongDatabaseInfo(DatabaseInfoCommand: Integer
463			): long;
464	tony	209	begin
465	tony	345	Result := GetIntDatabaseInfo(DatabaseInfoCommand);
466			end;
467
468			function TIBDatabaseInfo.GetIntDatabaseInfo(DatabaseInfoCommand: Integer
469			): Int64;
470			begin
471	tony	209	CheckDatabase;
472			with Database.Attachment.GetDBInformation([DatabaseInfoCommand]) do
473			if (Count > 0) and (Items[0].GetItemType = DatabaseInfoCommand) then
474			Result := Items[0].AsInteger
475			else
476			IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
477			end;
478
479			function TIBDatabaseInfo.GetDatabasePage(PageNo: integer): string;
480			var DBRequest: IDIRB;
481			begin
482			DBRequest := Database.Attachment.AllocateDIRB;
483			DBRequest.Add(fb_info_page_contents).AsInteger := PageNo;
484			with Database.Attachment.GetDBInformation(DBRequest) do
485			if (Count > 0) and (Items[0].GetItemType = fb_info_page_contents) then
486			Result := Items[0].AsString
487			else
488			IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
489			end;
490
491			function TIBDatabaseInfo.GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
492			begin
493			CheckDatabase;
494			with Database.Attachment.GetDBInformation([DatabaseInfoCommand]) do
495			if (Count > 0) and (Items[0].GetItemType = DatabaseInfoCommand) then
496			Result := Items[0].AsString
497			else
498			IBError(ibxeUnexpectedDatabaseInfoResp,[nil]);
499			end;
500
501
502	tony	345	function TIBDatabaseInfo.GetDBSQLDialect: Int64;
503	tony	209	begin
504			CheckDatabase;
505			with Database.Attachment.GetDBInformation([isc_info_db_SQL_Dialect]) do
506			if (Count > 0) and (Items[0].GetItemType = isc_info_db_SQL_Dialect) then
507			Result := Items[0].AsInteger
508			else
509			Result := 1;
510			end;
511
512
513			end.