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 - 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: Long;
    function GetPagesUsed: Long;
    function GetTransactionCount: Long;
  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;
    function GetDatabasePage(PageNo: integer): string;
    property Allocation: Long read GetAllocation;
    property BaseLevel: Long read GetBaseLevel;
    property DateDBCreated: TDateTime read GetDateDBCreated;
    property DBFileName: String read GetDBFileName;
    property DBSiteName: String read GetDBSiteName;
    property DBImplementationNo: Long read GetDBImplementationNo;
    property DBImplementationClass: Long read GetDBImplementationClass;
    property Encrypted: boolean read GetEncrypted;
    property EncryptionKeyName: string read GetEncryptionKeyName;
    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 TransactionCount: Long 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 : Long read GetDBSQLDialect;
    property PagesUsed: Long read GetPagesUsed;
    property PagesFree: Long read GetPagesFree;
    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;

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: Long;
begin
  Result := ODSMajorVersion >= 12;
  if Result then
  try
    ConnFlags := GetLongDatabaseInfo(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: Long;
begin
  result := GetLongDatabaseInfo(fb_info_pages_used);
end;

function TIBDatabaseInfo.GetPagesUsed: Long;
begin
  result := GetLongDatabaseInfo(fb_info_pages_free);
end;

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