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:	17
Committed:	Sat Dec 28 19:22:24 2013 UTC (10 years, 11 months ago) by tony
Content type:	text/x-pascal
File size:	16983 byte(s)
Log Message:	Committing updates for Release R1-0-5
#	User	Rev	Content
1	tony	17	{************************************************************************}
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.