{*************************************************************}
{                                                             }
{       Borland Delphi Visual Component Library               }
{       InterBase Express core components                     }
{                                                             }
{       Copyright (c) 1998-2003 Borland Software 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.                }
{                                                             }
{    Additional code created by Jeff Overcash and used        }
{    with permission.                                         }
{*************************************************************}

unit Borland.Vcl.IBDatabaseInfo;

{$A8,R-}

interface

uses
  SysUtils, Classes, IBHeader, IBExternals, IB, IBDatabase, IBIntf;

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;
    FGDSLibrary : IGDSLibrary;

    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
  IBErrorCodes, System.Runtime.InteropServices;

{ TIBDatabaseInfo }

constructor TIBDatabaseInfo.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FGDSLibrary := GetGDSLibrary;
  FIBLoaded := False;
  FGDSLibrary.CheckIBLoaded;
  FIBLoaded := True;
  FUserNames := TStringList.Create;
  FBackoutCount := TStringList.Create;
  FDeleteCount := TStringList.Create;
  FExpungeCount := TStringList.Create;
  FInsertCount := TStringList.Create;
  FPurgeCount := TStringList.Create;
  FReadIdxCount := TStringList.Create;
  FReadSeqCount := TStringList.Create;
  FUpdateCount := TStringList.Create;
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;
  FGDSLibrary := nil;
  inherited Destroy;
end;


function TIBDatabaseInfo.Call(ErrCode: ISC_STATUS;
  RaiseError: Boolean): ISC_STATUS;
begin
  result := ErrCode;
  {Handle when the Error is due to a Database disconnect.  Pass it on to
   FDatabase so it can handle this}
  if CheckStatusVector([isc_lost_db_connection]) then
    FDatabase.Call(ErrCode, RaiseError)
  else
    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: IntPtr;
  DatabaseInfoCommand: IntPtr;
begin
  local_buffer := Marshal.AllocHGlobal(IBLocalBufferLength);
  DatabaseInfoCommand := Marshal.AllocHGlobal(SizeOf(Byte));
  try
    Marshal.WriteByte(DatabaseInfoCommand, isc_info_base_level);
    Call(FGDSLibrary.isc_database_info(StatusVector, FDatabase.Handle, 1,
        DatabaseInfoCommand, IBLocalBufferLength, local_buffer), True);
    result := Marshal.ReadInt32(local_buffer, 4);
  finally
    Marshal.FreeHGlobal(local_buffer);
    Marshal.FreeHGlobal(DatabaseInfoCommand);
  end;
end;

function TIBDatabaseInfo.GetDBFileName: String;
var
  local_buffer: IntPtr;
  DatabaseInfoCommand: IntPtr;
begin
  local_buffer := Marshal.AllocHGlobal(IBLocalBufferLength);
  DatabaseInfoCommand := Marshal.AllocHGlobal(SizeOf(Byte));
  try
    Marshal.WriteByte(DatabaseInfoCommand, isc_info_db_id);
    Call(FGDSLibrary.isc_database_info(StatusVector, FDatabase.Handle, 1, DatabaseInfoCommand,
                           IBLocalBufferLength, local_buffer), True);
    Marshal.WriteByte(IntPtr(Integer(local_buffer) + 5 + Marshal.ReadByte(local_buffer, 4)), 0);
    result := Marshal.PtrToStringAnsi(IntPtr(Integer(local_buffer) + 5));
  finally
    Marshal.FreeHGlobal(local_buffer);
    Marshal.FreeHGlobal(DatabaseInfoCommand);
  end;
end;

function TIBDatabaseInfo.GetDBSiteName: String;
var
  local_buffer: IntPtr;
  DatabaseInfoCommand: IntPtr;
  Length : Integer;
begin
  local_buffer := Marshal.AllocHGlobal(IBLocalBufferLength);
  DatabaseInfoCommand := Marshal.AllocHGlobal(SizeOf(Byte));
  try
    Marshal.WriteByte(DatabaseInfoCommand, isc_info_db_id);
    Call(FGDSLibrary.isc_database_info(StatusVector, FDatabase.Handle, 1, DatabaseInfoCommand,
                           IBLocalBufferLength, local_buffer), True);
    Length := Marshal.ReadByte(IntPtr(Integer(local_buffer) + 5 +
                   Integer(Marshal.ReadByte(local_buffer, 4)))); { DBSiteName Length }
    result := Marshal.PtrToStringAnsi(IntPtr(Integer(local_buffer) + 6 +
                 Marshal.ReadByte(local_buffer, 4)), Length);
  finally
    Marshal.FreeHGlobal(local_buffer);
    Marshal.FreeHGlobal(DatabaseInfoCommand);
  end;
end;

function TIBDatabaseInfo.GetDBImplementationNo: Long;
var
  local_buffer: IntPtr;
  DatabaseInfoCommand: IntPtr;
begin
  local_buffer := Marshal.AllocHGlobal(IBLocalBufferLength);
  DatabaseInfoCommand := Marshal.AllocHGlobal(SizeOf(Byte));
  try
    Marshal.WriteByte(DatabaseInfoCommand, isc_info_implementation);
    Call(FGDSLibrary.isc_database_info(StatusVector, FDatabase.Handle, 1,DatabaseInfoCommand,
                          IBLocalBufferLength, local_buffer), True);
    result := Marshal.ReadByte(local_buffer, 3);
  finally
    Marshal.FreeHGlobal(local_buffer);
    Marshal.FreeHGlobal(DatabaseInfoCommand);
  end;
end;

function TIBDatabaseInfo.GetDBImplementationClass: Long;
var
  local_buffer: IntPtr;
  DatabaseInfoCommand: IntPtr;
begin
  local_buffer := Marshal.AllocHGlobal(IBLocalBufferLength);
  DatabaseInfoCommand := Marshal.AllocHGlobal(SizeOf(Byte));
  try
    Marshal.WriteByte(DatabaseInfoCommand, isc_info_implementation);
    Call(FGDSLibrary.isc_database_info(StatusVector, FDatabase.Handle, 1,DatabaseInfoCommand,
                          IBLocalBufferLength, local_buffer), True);
    result := Marshal.ReadByte(local_buffer, 4);
  finally
    Marshal.FreeHGlobal(local_buffer);
    Marshal.FreeHGlobal(DatabaseInfoCommand);
  end;
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: IntPtr;
  DatabaseInfoCommand: IntPtr;
begin
  local_buffer := Marshal.AllocHGlobal(IBLocalBufferLength);
  DatabaseInfoCommand := Marshal.AllocHGlobal(SizeOf(Byte));
  try
    Marshal.WriteByte(DatabaseInfoCommand, isc_info_version);
    Call(FGDSLibrary.isc_database_info(StatusVector, FDatabase.Handle, 1, DatabaseInfoCommand,
                          IBBigLocalBufferLength, local_buffer), True);
    result := Marshal.PtrToStringAnsi(IntPtr(Integer(local_buffer) + 5),
                  Marshal.ReadByte(IntPtr(Integer(local_buffer) + 5 +
                                   Marshal.ReadByte(local_buffer, 4))));
  finally
    Marshal.FreeHGlobal(local_buffer);
    Marshal.FreeHGlobal(DatabaseInfoCommand);
  end;
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: IntPtr;
  DatabaseInfoCommand: IntPtr;
  i, user_length: Integer;
begin
  local_buffer := Marshal.AllocHGlobal(IBHugeLocalBufferLength);
  DatabaseInfoCommand := Marshal.AllocHGlobal(SizeOf(Byte));
  try
    Marshal.WriteByte(DatabaseInfoCommand, isc_info_user_names);
    result := FUserNames;
    Call(FGDSLibrary.isc_database_info(StatusVector, FDatabase.Handle, 1, DatabaseInfoCommand,
                        IBHugeLocalBufferLength, local_buffer), True);
    FUserNames.Clear;
    i := 0;
    while Marshal.ReadByte(local_buffer, i) = isc_info_user_names do
    begin
      Inc(i, 3); { skip "isc_info_user_names byte" & two unknown bytes of structure (see below) }
      user_length := Marshal.ReadByte(local_buffer, i);
      Inc(i,1);
      FUserNames.Add(Marshal.PtrToStringAnsi(IntPtr(Integer(local_buffer) + i), user_length));
      Inc(i, user_length);
    end;
  finally
    Marshal.FreeHGlobal(local_buffer);
    Marshal.FreeHGlobal(DatabaseInfoCommand);
  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: IntPtr;
  DatabaseInfoCommand: IntPtr;
  i, qtd_tables, id_table, qtd_operations: Integer;
begin
  local_buffer := Marshal.AllocHGlobal(IBHugeLocalBufferLength);
  DatabaseInfoCommand := Marshal.AllocHGlobal(SizeOf(Byte));
  try
    Marshal.WriteByte(DatabaseInfoCommand, DBInfoCommand);
    if FOperation = nil then
      FOperation := TStringList.Create;
    result := FOperation;
    Call(FGDSLibrary.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 := Marshal.ReadInt16(local_buffer, 1) div 6;
    for i := 0 to qtd_tables - 1 do
    begin
      id_table := Marshal.ReadInt16(local_buffer, 3+(i*6));
      qtd_operations := Marshal.ReadInt16(local_buffer, 5+(i*6));
      FOperation.Add(IntToStr(id_table)+'='+IntToStr(qtd_operations));
    end;
  finally
    Marshal.FreeHGlobal(local_buffer);
    Marshal.FreeHGlobal(DatabaseInfoCommand);
  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: IntPtr;
  _DatabaseInfoCommand : IntPtr;
  length: Integer;
begin
  local_buffer := Marshal.AllocHGlobal(IBLocalBufferLength);
  _DatabaseInfoCommand := Marshal.AllocHGlobal(SizeOf(Byte));
  try
    Marshal.WriteByte(_DatabaseInfoCommand, DatabaseInfoCommand);
    Call(FGDSLibrary.isc_database_info(StatusVector, FDatabase.Handle, 1, _DatabaseInfoCommand,
                           IBLocalBufferLength, local_buffer), True);
    length := Marshal.ReadInt16(local_buffer, 1);
    case length of
      1 : Result := Marshal.ReadByte(local_buffer, 3);
      2 : Result := Marshal.ReadInt16(local_buffer, 3);
      4 : Result := Marshal.ReadInt32(local_buffer, 3);
      else
        Result := -1;
    end;
  finally
    Marshal.FreeHGlobal(local_buffer);
    Marshal.FreeHGlobal(_DatabaseInfoCommand);
  end;
end;

function TIBDatabaseInfo.GetStringDatabaseInfo(DatabaseInfoCommand: Integer): String;
var
  local_buffer: IntPtr;
  _DatabaseInfoCommand : IntPtr;
begin
  local_buffer := Marshal.AllocHGlobal(IBLocalBufferLength);
  _DatabaseInfoCommand := Marshal.AllocHGlobal(SizeOf(Byte));
  try
    Marshal.WriteByte(_DatabaseInfoCommand, DatabaseInfoCommand);
    Call(FGDSLibrary.isc_database_info(StatusVector, FDatabase.Handle, 1, _DatabaseInfoCommand,
                           IBBigLocalBufferLength, local_buffer), True);
    result := Marshal.PtrToStringAnsi(IntPtr(Integer(local_buffer) + 4),
                 Marshal.ReadByte(IntPtr(Integer(local_buffer) + 4 +
                 Marshal.ReadByte(IntPtr(Integer(Local_Buffer) + 3)))));
  finally
    Marshal.FreeHGlobal(local_buffer);
    Marshal.FreeHGlobal(_DatabaseInfoCommand);
  end;
end;


function TIBDatabaseInfo.GetDBSQLDialect: Integer;
var
  local_buffer: IntPtr;
  DatabaseInfoCommand : IntPtr;
  length: Integer;
begin
  local_buffer := Marshal.AllocHGlobal(IBLocalBufferLength);
  DatabaseInfoCommand := Marshal.AllocHGlobal(SizeOf(Byte));
  try
    Marshal.WriteByte(DatabaseInfoCommand, isc_info_db_SQL_Dialect);
    Call(FGDSLibrary.isc_database_info(StatusVector, FDatabase.Handle, 1, DatabaseInfoCommand,
                         IBLocalBufferLength, local_buffer), True);
    if (Marshal.ReadByte(local_buffer) <> isc_info_db_SQL_dialect) then
      result := 1
    else
    begin
      length := Marshal.ReadInt16(local_buffer, 1);
      case length of
        1 : Result := Marshal.ReadByte(local_buffer, 3);
        2 : Result := Marshal.ReadInt16(local_buffer, 3);
        4 : Result := Marshal.ReadInt32(local_buffer, 3);
        else
          Result := -1;
      end;
    end;
  finally
    Marshal.FreeHGlobal(local_buffer);
    Marshal.FreeHGlobal(DatabaseInfoCommand);
  end;
end;

end.
