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.                 }
{    The Original Code was created by InterBase Software Corporation     }
{       and its successors.                                              }
{    Portions created by Inprise Corporation are Copyright (C) Inprise   }
{       Corporation. All Rights Reserved.                                }
{    Contributor(s): Jeff Overcash                                       }
{                                                                        }
{************************************************************************}

unit IBDatabaseInfo;

interface

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