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                                       }
{                                                                        }
{************************************************************************}

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