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, IBHeader, IBExternals, IB, IBDatabase;

type

  TIBDatabaseInfo = class(TComponent)
  protected
    FIBLoaded: Boolean;
    FDatabase: TIBDatabase;
    FUserNames   : TStringList;
    FBackoutCount: TStringList;
    FDeleteCount: TStringList;
    FExpungeCount: TStringList;
    FInsertCount: TStringList;
    FPurgeCount: TStringList;
    FReadIdxCount: TStringList;
    FReadSeqCount: TStringList;
    FUpdateCount: TStringList;
    function GetAllocation: Long;
    function GetBaseLevel: Long;
    function GetDBFileName: String;
    function GetDBSiteName: String;
    function GetDBImplementationNo: Long;
    function GetDBImplementationClass: Long;
    function GetNoReserve: Long;
    function GetODSMinorVersion: Long;
    function GetODSMajorVersion: Long;
    function GetPageSize: Long;
    function GetVersion: String;
    function GetCurrentMemory: Long;
    function GetForcedWrites: Long;
    function GetMaxMemory: Long;
    function GetNumBuffers: Long;
    function GetSweepInterval: Long;
    function GetUserNames: TStringList;
    function GetFetches: Long;
    function GetMarks: Long;
    function GetReads: Long;
    function GetWrites: Long;
    function GetBackoutCount: TStringList;
    function GetDeleteCount: TStringList;
    function GetExpungeCount: TStringList;
    function GetInsertCount: TStringList;
    function GetPurgeCount: TStringList;
    function GetReadIdxCount: TStringList;
    function GetReadSeqCount: TStringList;
    function GetUpdateCount: TStringList;
    function GetOperationCounts(DBInfoCommand: Integer; FOperation: TStringList): TStringList;
    function GetReadOnly: Long;
    function GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
    function GetDBSQLDialect: Long;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
    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
  IBIntf;

{ TIBDatabaseInfo }

constructor TIBDatabaseInfo.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIBLoaded := False;
  CheckIBLoaded;
  FIBLoaded := True;
  FUserNames := TStringList.Create;
  FBackoutCount                        := nil;
  FDeleteCount                         := nil;
  FExpungeCount                        := nil;
  FInsertCount                         := nil;
  FPurgeCount                          := nil;
  FReadIdxCount                        := nil;
  FReadSeqCount                        := nil;
  FUpdateCount                         := nil;
end;

destructor TIBDatabaseInfo.Destroy;
begin
  if FIBLoaded then
  begin
    FUserNames.Free;
    FBackoutCount.Free;
    FDeleteCount.Free;
    FExpungeCount.Free;
    FInsertCount.Free;
    FPurgeCount.Free;
    FReadIdxCount.Free;
    FReadSeqCount.Free;
    FUpdateCount.Free;
  end;
  inherited Destroy;
end;


function TIBDatabaseInfo.Call(ErrCode: ISC_STATUS;
  RaiseError: Boolean): ISC_STATUS;
begin
  result := ErrCode;
  if RaiseError and (ErrCode > 0) then
    IBDataBaseError;
end;
function TIBDatabaseInfo.GetAllocation: Long;
begin
  result := GetLongDatabaseInfo(isc_info_allocation);
end;

function TIBDatabaseInfo.GetBaseLevel: Long;
var
  local_buffer: array[0..IBLocalBufferLength - 1] of Char;
  DatabaseInfoCommand: Char;
begin
  DatabaseInfoCommand := Char(isc_info_base_level);
  Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
                         IBLocalBufferLength, local_buffer), True);
  result := isc_vax_integer(@local_buffer[4], 1);
end;

function TIBDatabaseInfo.GetDBFileName: String;
var
  local_buffer: array[0..IBLocalBufferLength - 1] of Char;
  DatabaseInfoCommand: Char;
begin
  DatabaseInfoCommand := Char(isc_info_db_id);
  Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
                         IBLocalBufferLength, local_buffer), True);
  local_buffer[5 + Int(local_buffer[4])] := #0;
  result := String(PChar(@local_buffer[5]));
end;

function TIBDatabaseInfo.GetDBSiteName: String;
var
  local_buffer: array[0..IBBigLocalBufferLength - 1] of Char;
  p: PChar;
  DatabaseInfoCommand: Char;
begin
  DatabaseInfoCommand := Char(isc_info_db_id);
  Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
                        IBLocalBufferLength, local_buffer), True);
  p := @local_buffer[5 + Int(local_buffer[4])]; { DBSiteName Length }
  p := p + Int(p^) + 1;                         { End of DBSiteName }
  p^ := #0;                                     { Null it }
  result := String(PChar(@local_buffer[6 + Int(local_buffer[4])]));
end;

function TIBDatabaseInfo.GetDBImplementationNo: Long;
var
  local_buffer: array[0..IBLocalBufferLength - 1] of Char;
  DatabaseInfoCommand: Char;
begin
  DatabaseInfoCommand := Char(isc_info_implementation);
  Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
                        IBLocalBufferLength, local_buffer), True);
  result := isc_vax_integer(@local_buffer[3], 1);
end;

function TIBDatabaseInfo.GetDBImplementationClass: Long;
var
  local_buffer: array[0..IBLocalBufferLength - 1] of Char;
  DatabaseInfoCommand: Char;
begin
  DatabaseInfoCommand := Char(isc_info_implementation);
  Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
                         IBLocalBufferLength, local_buffer), True);
  result := isc_vax_integer(@local_buffer[4], 1);
end;

function TIBDatabaseInfo.GetNoReserve: Long;
begin
  result := GetLongDatabaseInfo(isc_info_no_reserve);
end;

function TIBDatabaseInfo.GetODSMinorVersion: Long;
begin
  result := GetLongDatabaseInfo(isc_info_ods_minor_version);
end;

function TIBDatabaseInfo.GetODSMajorVersion: Long;
begin
  result := GetLongDatabaseInfo(isc_info_ods_version);
end;

function TIBDatabaseInfo.GetPageSize: Long;
begin
  result := GetLongDatabaseInfo(isc_info_page_size);
end;

function TIBDatabaseInfo.GetVersion: String;
var
  local_buffer: array[0..IBBigLocalBufferLength - 1] of Char;
  DatabaseInfoCommand: Char;
begin
  DatabaseInfoCommand := Char(isc_info_version);
  Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
                        IBBigLocalBufferLength, local_buffer), True);
  local_buffer[5 + Int(local_buffer[4])] := #0;
  result := String(PChar(@local_buffer[5]));
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;
var
  local_buffer: array[0..IBHugeLocalBufferLength - 1] of Char;
  temp_buffer: array[0..IBLocalBufferLength - 2] of Char;
  DatabaseInfoCommand: Char;
  i, user_length: Integer;
begin
  result := FUserNames;
  DatabaseInfoCommand := Char(isc_info_user_names);
  Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
                        IBHugeLocalBufferLength, local_buffer), True);
  FUserNames.Clear;
  i := 0;
  while local_buffer[i] = Char(isc_info_user_names) do
  begin
    Inc(i, 3); { skip "isc_info_user_names byte" & two unknown bytes of structure (see below) }
    user_length := Long(local_buffer[i]);
    Inc(i,1);
    Move(local_buffer[i], temp_buffer[0], user_length);
    Inc(i, user_length);
    temp_buffer[user_length] := #0;
    FUserNames.Add(String(temp_buffer));
  end;
end;

function TIBDatabaseInfo.GetFetches: Long;
begin
  result := GetLongDatabaseInfo(isc_info_fetches);
end;

function TIBDatabaseInfo.GetMarks: Long;
begin
  result := GetLongDatabaseInfo(isc_info_marks);
end;

function TIBDatabaseInfo.GetReads: Long;
begin
  result := GetLongDatabaseInfo(isc_info_reads);
end;

function TIBDatabaseInfo.GetWrites: Long;
begin
  result := GetLongDatabaseInfo(isc_info_writes);
end;

function TIBDatabaseInfo.GetOperationCounts(DBInfoCommand: Integer; FOperation: TStringList): TStringList;
var
  local_buffer: array[0..IBHugeLocalBufferLength - 1] of Char;
  DatabaseInfoCommand: Char;
  i, qtd_tables, id_table, qtd_operations: Integer;
begin
  if FOperation = nil then FOperation := TStringList.Create;
  result := FOperation;
  DatabaseInfoCommand := Char(DBInfoCommand);
  Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
                         IBHugeLocalBufferLength, local_buffer), True);
  FOperation.Clear;
  { 1. 1 byte specifying the item type requested (e.g., isc_info_insert_count).
    2. 2 bytes telling how many bytes compose the subsequent value pairs.
    3. A pair of values for each table in the database on wich the requested
      type of operation has occurred since the database was last attached.
    Each pair consists of:
    1. 2 bytes specifying the table ID.
    2. 4 bytes listing the number of operations (e.g., inserts) done on that table.
  }
  qtd_tables := trunc(isc_vax_integer(@local_buffer[1],2)/6);
  for i := 0 to qtd_tables - 1 do
  begin
    id_table := isc_vax_integer(@local_buffer[3+(i*6)],2);
    qtd_operations := isc_vax_integer(@local_buffer[5+(i*6)],4);
    FOperation.Add(IntToStr(id_table)+'='+IntToStr(qtd_operations));
  end;
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;
var
  local_buffer: array[0..IBLocalBufferLength - 1] of Char;
  length: Integer;
  _DatabaseInfoCommand: Char;
begin
  _DatabaseInfoCommand := Char(DatabaseInfoCommand);
  Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @_DatabaseInfoCommand,
                         IBLocalBufferLength, local_buffer), True);
  length := isc_vax_integer(@local_buffer[1], 2);
  result := isc_vax_integer(@local_buffer[3], length);
end;

function TIBDatabaseInfo.GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
var
  local_buffer: array[0..IBBigLocalBufferLength - 1] of Char;
  _DatabaseInfoCommand: Char;
begin
  _DatabaseInfoCommand := Char(DatabaseInfoCommand);
  Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @_DatabaseInfoCommand,
                         IBBigLocalBufferLength, local_buffer), True);
  local_buffer[4 + Int(local_buffer[3])] := #0;
  result := String(PChar(@local_buffer[4]));
end;


function TIBDatabaseInfo.GetDBSQLDialect: Integer;
var
  local_buffer: array[0..IBLocalBufferLength - 1] of Char;
  length: Integer;
  DatabaseInfoCommand: Char;
begin
  DatabaseInfoCommand := Char(isc_info_db_SQL_Dialect);
  Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
                       IBLocalBufferLength, local_buffer), True);
  if (local_buffer[0] <> Char(isc_info_db_SQL_dialect)) then
    result := 1
  else begin
    length := isc_vax_integer(@local_buffer[1], 2);
    result := isc_vax_integer(@local_buffer[3], length);
  end;
end;


end.
Revision:	33
Committed:	Sat Jul 18 12:30:52 2015 UTC (9 years, 4 months ago) by tony
Content type:	text/x-pascal
File size:	16520 byte(s)
Log Message:	Committing updates for Release R1-3-1
#	Content
1	{************************************************************************}
2	{ }
3	{ Borland Delphi Visual Component Library }
4	{ InterBase Express core components }
5	{ }
6	{ Copyright (c) 1998-2000 Inprise Corporation }
7	{ }
8	{ InterBase Express is based in part on the product }
9	{ Free IB Components, written by Gregory H. Deatz for }
10	{ Hoagland, Longo, Moran, Dunst & Doukas Company. }
11	{ Free IB Components is used under license. }
12	{ }
13	{ The contents of this file are subject to the InterBase }
14	{ Public License Version 1.0 (the "License"); you may not }
15	{ use this file except in compliance with the License. You }
16	{ may obtain a copy of the License at http://www.Inprise.com/IPL.html }
17	{ Software distributed under the License is distributed on }
18	{ an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either }
19	{ express or implied. See the License for the specific language }
20	{ governing rights and limitations under the License. }
21	{ Portions created by Inprise Corporation are Copyright (C) Inprise }
22	{ Corporation. All Rights Reserved. }
23	{ Contributor(s): Jeff Overcash }
24	{ }
25	{ IBX For Lazarus (Firebird Express) }
26	{ Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
27	{ Portions created by MWA Software are copyright McCallum Whyman }
28	{ Associates Ltd 2011 }
29	{ }
30	{************************************************************************}
31
32	unit IBDatabaseInfo;
33
34	{$Mode Delphi}
35
36	interface
37
38	uses
39	SysUtils, Classes, IBHeader, IBExternals, IB, IBDatabase;
40
41	type
42
43	TIBDatabaseInfo = class(TComponent)
44	protected
45	FIBLoaded: Boolean;
46	FDatabase: TIBDatabase;
47	FUserNames : TStringList;
48	FBackoutCount: TStringList;
49	FDeleteCount: TStringList;
50	FExpungeCount: TStringList;
51	FInsertCount: TStringList;
52	FPurgeCount: TStringList;
53	FReadIdxCount: TStringList;
54	FReadSeqCount: TStringList;
55	FUpdateCount: TStringList;
56	function GetAllocation: Long;
57	function GetBaseLevel: Long;
58	function GetDBFileName: String;
59	function GetDBSiteName: String;
60	function GetDBImplementationNo: Long;
61	function GetDBImplementationClass: Long;
62	function GetNoReserve: Long;
63	function GetODSMinorVersion: Long;
64	function GetODSMajorVersion: Long;
65	function GetPageSize: Long;
66	function GetVersion: String;
67	function GetCurrentMemory: Long;
68	function GetForcedWrites: Long;
69	function GetMaxMemory: Long;
70	function GetNumBuffers: Long;
71	function GetSweepInterval: Long;
72	function GetUserNames: TStringList;
73	function GetFetches: Long;
74	function GetMarks: Long;
75	function GetReads: Long;
76	function GetWrites: Long;
77	function GetBackoutCount: TStringList;
78	function GetDeleteCount: TStringList;
79	function GetExpungeCount: TStringList;
80	function GetInsertCount: TStringList;
81	function GetPurgeCount: TStringList;
82	function GetReadIdxCount: TStringList;
83	function GetReadSeqCount: TStringList;
84	function GetUpdateCount: TStringList;
85	function GetOperationCounts(DBInfoCommand: Integer; FOperation: TStringList): TStringList;
86	function GetReadOnly: Long;
87	function GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
88	function GetDBSQLDialect: Long;
89	public
90	constructor Create(AOwner: TComponent); override;
91	destructor Destroy; override;
92	function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS;
93	function GetLongDatabaseInfo(DatabaseInfoCommand: Integer): Long;
94	property Allocation: Long read GetAllocation;
95	property BaseLevel: Long read GetBaseLevel;
96	property DBFileName: String read GetDBFileName;
97	property DBSiteName: String read GetDBSiteName;
98	property DBImplementationNo: Long read GetDBImplementationNo;
99	property DBImplementationClass: Long read GetDBImplementationClass;
100	property NoReserve: Long read GetNoReserve;
101	property ODSMinorVersion: Long read GetODSMinorVersion;
102	property ODSMajorVersion: Long read GetODSMajorVersion;
103	property PageSize: Long read GetPageSize;
104	property Version: String read GetVersion;
105	property CurrentMemory: Long read GetCurrentMemory;
106	property ForcedWrites: Long read GetForcedWrites;
107	property MaxMemory: Long read GetMaxMemory;
108	property NumBuffers: Long read GetNumBuffers;
109	property SweepInterval: Long read GetSweepInterval;
110	property UserNames: TStringList read GetUserNames;
111	property Fetches: Long read GetFetches;
112	property Marks: Long read GetMarks;
113	property Reads: Long read GetReads;
114	property Writes: Long read GetWrites;
115	property BackoutCount: TStringList read GetBackoutCount;
116	property DeleteCount: TStringList read GetDeleteCount;
117	property ExpungeCount: TStringList read GetExpungeCount;
118	property InsertCount: TStringList read GetInsertCount;
119	property PurgeCount: TStringList read GetPurgeCount;
120	property ReadIdxCount: TStringList read GetReadIdxCount;
121	property ReadSeqCount: TStringList read GetReadSeqCount;
122	property UpdateCount: TStringList read GetUpdateCount;
123	property DBSQLDialect : Long read GetDBSQLDialect;
124	property ReadOnly: Long read GetReadOnly;
125	published
126	property Database: TIBDatabase read FDatabase write FDatabase;
127	end;
128
129	implementation
130
131	uses
132	IBIntf;
133
134	{ TIBDatabaseInfo }
135
136	constructor TIBDatabaseInfo.Create(AOwner: TComponent);
137	begin
138	inherited Create(AOwner);
139	FIBLoaded := False;
140	CheckIBLoaded;
141	FIBLoaded := True;
142	FUserNames := TStringList.Create;
143	FBackoutCount := nil;
144	FDeleteCount := nil;
145	FExpungeCount := nil;
146	FInsertCount := nil;
147	FPurgeCount := nil;
148	FReadIdxCount := nil;
149	FReadSeqCount := nil;
150	FUpdateCount := nil;
151	end;
152
153	destructor TIBDatabaseInfo.Destroy;
154	begin
155	if FIBLoaded then
156	begin
157	FUserNames.Free;
158	FBackoutCount.Free;
159	FDeleteCount.Free;
160	FExpungeCount.Free;
161	FInsertCount.Free;
162	FPurgeCount.Free;
163	FReadIdxCount.Free;
164	FReadSeqCount.Free;
165	FUpdateCount.Free;
166	end;
167	inherited Destroy;
168	end;
169
170
171	function TIBDatabaseInfo.Call(ErrCode: ISC_STATUS;
172	RaiseError: Boolean): ISC_STATUS;
173	begin
174	result := ErrCode;
175	if RaiseError and (ErrCode > 0) then
176	IBDataBaseError;
177	end;
178	function TIBDatabaseInfo.GetAllocation: Long;
179	begin
180	result := GetLongDatabaseInfo(isc_info_allocation);
181	end;
182
183	function TIBDatabaseInfo.GetBaseLevel: Long;
184	var
185	local_buffer: array[0..IBLocalBufferLength - 1] of Char;
186	DatabaseInfoCommand: Char;
187	begin
188	DatabaseInfoCommand := Char(isc_info_base_level);
189	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
190	IBLocalBufferLength, local_buffer), True);
191	result := isc_vax_integer(@local_buffer[4], 1);
192	end;
193
194	function TIBDatabaseInfo.GetDBFileName: String;
195	var
196	local_buffer: array[0..IBLocalBufferLength - 1] of Char;
197	DatabaseInfoCommand: Char;
198	begin
199	DatabaseInfoCommand := Char(isc_info_db_id);
200	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
201	IBLocalBufferLength, local_buffer), True);
202	local_buffer[5 + Int(local_buffer[4])] := #0;
203	result := String(PChar(@local_buffer[5]));
204	end;
205
206	function TIBDatabaseInfo.GetDBSiteName: String;
207	var
208	local_buffer: array[0..IBBigLocalBufferLength - 1] of Char;
209	p: PChar;
210	DatabaseInfoCommand: Char;
211	begin
212	DatabaseInfoCommand := Char(isc_info_db_id);
213	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
214	IBLocalBufferLength, local_buffer), True);
215	p := @local_buffer[5 + Int(local_buffer[4])]; { DBSiteName Length }
216	p := p + Int(p^) + 1; { End of DBSiteName }
217	p^ := #0; { Null it }
218	result := String(PChar(@local_buffer[6 + Int(local_buffer[4])]));
219	end;
220
221	function TIBDatabaseInfo.GetDBImplementationNo: Long;
222	var
223	local_buffer: array[0..IBLocalBufferLength - 1] of Char;
224	DatabaseInfoCommand: Char;
225	begin
226	DatabaseInfoCommand := Char(isc_info_implementation);
227	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
228	IBLocalBufferLength, local_buffer), True);
229	result := isc_vax_integer(@local_buffer[3], 1);
230	end;
231
232	function TIBDatabaseInfo.GetDBImplementationClass: Long;
233	var
234	local_buffer: array[0..IBLocalBufferLength - 1] of Char;
235	DatabaseInfoCommand: Char;
236	begin
237	DatabaseInfoCommand := Char(isc_info_implementation);
238	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
239	IBLocalBufferLength, local_buffer), True);
240	result := isc_vax_integer(@local_buffer[4], 1);
241	end;
242
243	function TIBDatabaseInfo.GetNoReserve: Long;
244	begin
245	result := GetLongDatabaseInfo(isc_info_no_reserve);
246	end;
247
248	function TIBDatabaseInfo.GetODSMinorVersion: Long;
249	begin
250	result := GetLongDatabaseInfo(isc_info_ods_minor_version);
251	end;
252
253	function TIBDatabaseInfo.GetODSMajorVersion: Long;
254	begin
255	result := GetLongDatabaseInfo(isc_info_ods_version);
256	end;
257
258	function TIBDatabaseInfo.GetPageSize: Long;
259	begin
260	result := GetLongDatabaseInfo(isc_info_page_size);
261	end;
262
263	function TIBDatabaseInfo.GetVersion: String;
264	var
265	local_buffer: array[0..IBBigLocalBufferLength - 1] of Char;
266	DatabaseInfoCommand: Char;
267	begin
268	DatabaseInfoCommand := Char(isc_info_version);
269	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
270	IBBigLocalBufferLength, local_buffer), True);
271	local_buffer[5 + Int(local_buffer[4])] := #0;
272	result := String(PChar(@local_buffer[5]));
273	end;
274
275	function TIBDatabaseInfo.GetCurrentMemory: Long;
276	begin
277	result := GetLongDatabaseInfo(isc_info_current_memory);
278	end;
279
280	function TIBDatabaseInfo.GetForcedWrites: Long;
281	begin
282	result := GetLongDatabaseInfo(isc_info_forced_writes);
283	end;
284
285	function TIBDatabaseInfo.GetMaxMemory: Long;
286	begin
287	result := GetLongDatabaseInfo(isc_info_max_memory);
288	end;
289
290	function TIBDatabaseInfo.GetNumBuffers: Long;
291	begin
292	result := GetLongDatabaseInfo(isc_info_num_buffers);
293	end;
294
295	function TIBDatabaseInfo.GetSweepInterval: Long;
296	begin
297	result := GetLongDatabaseInfo(isc_info_sweep_interval);
298	end;
299
300	function TIBDatabaseInfo.GetUserNames: TStringList;
301	var
302	local_buffer: array[0..IBHugeLocalBufferLength - 1] of Char;
303	temp_buffer: array[0..IBLocalBufferLength - 2] of Char;
304	DatabaseInfoCommand: Char;
305	i, user_length: Integer;
306	begin
307	result := FUserNames;
308	DatabaseInfoCommand := Char(isc_info_user_names);
309	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
310	IBHugeLocalBufferLength, local_buffer), True);
311	FUserNames.Clear;
312	i := 0;
313	while local_buffer[i] = Char(isc_info_user_names) do
314	begin
315	Inc(i, 3); { skip "isc_info_user_names byte" & two unknown bytes of structure (see below) }
316	user_length := Long(local_buffer[i]);
317	Inc(i,1);
318	Move(local_buffer[i], temp_buffer[0], user_length);
319	Inc(i, user_length);
320	temp_buffer[user_length] := #0;
321	FUserNames.Add(String(temp_buffer));
322	end;
323	end;
324
325	function TIBDatabaseInfo.GetFetches: Long;
326	begin
327	result := GetLongDatabaseInfo(isc_info_fetches);
328	end;
329
330	function TIBDatabaseInfo.GetMarks: Long;
331	begin
332	result := GetLongDatabaseInfo(isc_info_marks);
333	end;
334
335	function TIBDatabaseInfo.GetReads: Long;
336	begin
337	result := GetLongDatabaseInfo(isc_info_reads);
338	end;
339
340	function TIBDatabaseInfo.GetWrites: Long;
341	begin
342	result := GetLongDatabaseInfo(isc_info_writes);
343	end;
344
345	function TIBDatabaseInfo.GetOperationCounts(DBInfoCommand: Integer; FOperation: TStringList): TStringList;
346	var
347	local_buffer: array[0..IBHugeLocalBufferLength - 1] of Char;
348	DatabaseInfoCommand: Char;
349	i, qtd_tables, id_table, qtd_operations: Integer;
350	begin
351	if FOperation = nil then FOperation := TStringList.Create;
352	result := FOperation;
353	DatabaseInfoCommand := Char(DBInfoCommand);
354	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
355	IBHugeLocalBufferLength, local_buffer), True);
356	FOperation.Clear;
357	{ 1. 1 byte specifying the item type requested (e.g., isc_info_insert_count).
358	2. 2 bytes telling how many bytes compose the subsequent value pairs.
359	3. A pair of values for each table in the database on wich the requested
360	type of operation has occurred since the database was last attached.
361	Each pair consists of:
362	1. 2 bytes specifying the table ID.
363	2. 4 bytes listing the number of operations (e.g., inserts) done on that table.
364	}
365	qtd_tables := trunc(isc_vax_integer(@local_buffer[1],2)/6);
366	for i := 0 to qtd_tables - 1 do
367	begin
368	id_table := isc_vax_integer(@local_buffer[3+(i*6)],2);
369	qtd_operations := isc_vax_integer(@local_buffer[5+(i*6)],4);
370	FOperation.Add(IntToStr(id_table)+'='+IntToStr(qtd_operations));
371	end;
372	end;
373
374	function TIBDatabaseInfo.GetBackoutCount: TStringList;
375	begin
376	result := GetOperationCounts(isc_info_backout_count,FBackoutCount);
377	end;
378
379	function TIBDatabaseInfo.GetDeleteCount: TStringList;
380	begin
381	result := GetOperationCounts(isc_info_delete_count,FDeleteCount);
382	end;
383
384	function TIBDatabaseInfo.GetExpungeCount: TStringList;
385	begin
386	result := GetOperationCounts(isc_info_expunge_count,FExpungeCount);
387	end;
388
389	function TIBDatabaseInfo.GetInsertCount: TStringList;
390	begin
391	result := GetOperationCounts(isc_info_insert_count,FInsertCount);
392	end;
393
394	function TIBDatabaseInfo.GetPurgeCount: TStringList;
395	begin
396	result := GetOperationCounts(isc_info_purge_count,FPurgeCount);
397	end;
398
399	function TIBDatabaseInfo.GetReadIdxCount: TStringList;
400	begin
401	result := GetOperationCounts(isc_info_read_idx_count,FReadIdxCount);
402	end;
403
404	function TIBDatabaseInfo.GetReadSeqCount: TStringList;
405	begin
406	result := GetOperationCounts(isc_info_read_seq_count,FReadSeqCount);
407	end;
408
409	function TIBDatabaseInfo.GetUpdateCount: TStringList;
410	begin
411	result := GetOperationCounts(isc_info_update_count,FUpdateCount);
412	end;
413
414	function TIBDatabaseInfo.GetReadOnly: Long;
415	begin
416	result := GetLongDatabaseInfo(isc_info_db_read_only);
417	end;
418
419	function TIBDatabaseInfo.GetLongDatabaseInfo(DatabaseInfoCommand: Integer): Long;
420	var
421	local_buffer: array[0..IBLocalBufferLength - 1] of Char;
422	length: Integer;
423	_DatabaseInfoCommand: Char;
424	begin
425	_DatabaseInfoCommand := Char(DatabaseInfoCommand);
426	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @_DatabaseInfoCommand,
427	IBLocalBufferLength, local_buffer), True);
428	length := isc_vax_integer(@local_buffer[1], 2);
429	result := isc_vax_integer(@local_buffer[3], length);
430	end;
431
432	function TIBDatabaseInfo.GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
433	var
434	local_buffer: array[0..IBBigLocalBufferLength - 1] of Char;
435	_DatabaseInfoCommand: Char;
436	begin
437	_DatabaseInfoCommand := Char(DatabaseInfoCommand);
438	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @_DatabaseInfoCommand,
439	IBBigLocalBufferLength, local_buffer), True);
440	local_buffer[4 + Int(local_buffer[3])] := #0;
441	result := String(PChar(@local_buffer[4]));
442	end;
443
444
445	function TIBDatabaseInfo.GetDBSQLDialect: Integer;
446	var
447	local_buffer: array[0..IBLocalBufferLength - 1] of Char;
448	length: Integer;
449	DatabaseInfoCommand: Char;
450	begin
451	DatabaseInfoCommand := Char(isc_info_db_SQL_Dialect);
452	Call(isc_database_info(StatusVector, @FDatabase.Handle, 1, @DatabaseInfoCommand,
453	IBLocalBufferLength, local_buffer), True);
454	if (local_buffer[0] <> Char(isc_info_db_SQL_dialect)) then
455	result := 1
456	else begin
457	length := isc_vax_integer(@local_buffer[1], 2);
458	result := isc_vax_integer(@local_buffer[3], length);
459	end;
460	end;
461
462
463	end.