Project Structure

• IbxMon.dpr
• MonForm.pas
• MonForm.dfm

program IbxMon;

uses
  Forms,
  MonForm in 'MonForm.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

unit MonForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  IBSQLMonitor, StdCtrls, ComCtrls, ExtCtrls, IBServices, ToolWin;

type
  TForm1 = class(TForm)
    IBSQLMonitor1: TIBSQLMonitor;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    RichEdit1: TRichEdit;
    IBStatisticalService1: TIBStatisticalService;
    IBServerProperties1: TIBServerProperties;
    RichEdit2: TRichEdit;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolBar2: TToolBar;
    ToolButton2: TToolButton;
    RichEdit3: TRichEdit;
    RichEdit4: TRichEdit;
    ToolBar3: TToolBar;
    ToolButton3: TToolButton;
    IBSecurityService1: TIBSecurityService;
    procedure IBSQLMonitor1SQL(EventText: String; EventTime: TDateTime);
    procedure ToolButton1Click(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.IBSQLMonitor1SQL(EventText: String;
  EventTime: TDateTime);
begin
  if Assigned (RichEdit1) then
    RichEdit1.Lines.Add (TimeToStr (EventTime) + ': ' + EventText);
end;

procedure TForm1.ToolButton1Click(Sender: TObject);
begin
  RichEdit2.Clear;
  RichEdit2.Lines.Add ('Statistical Service -- ' + TimeToStr (Now));
  IBStatisticalService1.ServiceStart;
  while not IBStatisticalService1.EOF do
    RichEdit2.Lines.Add (IBStatisticalService1.GetNextChunk);
end;

procedure TForm1.ToolButton2Click(Sender: TObject);
var
  i, n: Integer;
begin
  RichEdit3.Clear;
  RichEdit3.Lines.Add ('Server Properties -- ' + TimeToStr (Now));
  RichEdit3.Lines.Add ('');

  IBServerProperties1.FetchDatabaseInfo;
  n := IBServerProperties1.DatabaseInfo.NoOfDatabases;
  RichEdit3.Lines.Add ('Databases: ' + IntToStr (n));
  for i := 0 to n-1 do
    RichEdit3.Lines.Add ('- ' + IBServerProperties1.DatabaseInfo.DbName[i]);
  RichEdit3.Lines.Add ('');

  IBServerProperties1.FetchConfigParams;
  RichEdit3.Lines.Add ('Base Location: ' +
    IBServerProperties1.ConfigParams.BaseLocation);
  RichEdit3.Lines.Add ('');

  IBServerProperties1.FetchVersionInfo;
  with IBServerProperties1.VersionInfo do
  begin
    RichEdit3.Lines.Add ('Version: ' + ServerVersion);
    RichEdit3.Lines.Add ('Implementation: ' + ServerImplementation);
    RichEdit3.Lines.Add ('Service Version: ' + IntToStr (ServiceVersion));
  end;
end;

procedure TForm1.ToolButton3Click(Sender: TObject);
var
  i: Integer;
begin
  RichEdit4.Clear;
  // grab the users data
  IBSecurityService1.DisplayUsers;
  // display the name of each user
  for i := 0 to IBSecurityService1.UserInfoCount - 1 do
    with IBSecurityService1.UserInfo[i] do
      RichEdit4.Lines.Add (Format (
        'User: %s, Full Name: %s, Id: %d',
        [UserName, FirstName + ' ' + LastName, UserId]));
end;

end.

object Form1: TForm1
  Left = 249
  Top = 144
  Width = 601
  Height = 419
  Caption = 'IBX Monitor'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object PageControl1: TPageControl
    Left = 0
    Top = 0
    Width = 593
    Height = 392
    ActivePage = TabSheet1
    Align = alClient
    TabIndex = 0
    TabOrder = 0
    object TabSheet1: TTabSheet
      Caption = 'Monitor'
      object RichEdit1: TRichEdit
        Left = 0
        Top = 0
        Width = 585
        Height = 364
        Align = alClient
        ScrollBars = ssVertical
        TabOrder = 0
      end
    end
    object TabSheet2: TTabSheet
      Caption = 'Statistics'
      ImageIndex = 1
      object RichEdit2: TRichEdit
        Left = 0
        Top = 29
        Width = 585
        Height = 335
        Align = alClient
        TabOrder = 0
      end
      object ToolBar1: TToolBar
        Left = 0
        Top = 0
        Width = 585
        Height = 29
        ButtonHeight = 21
        ButtonWidth = 92
        Caption = 'ToolBar1'
        ShowCaptions = True
        TabOrder = 1
        object ToolButton1: TToolButton
          Left = 0
          Top = 2
          Caption = 'Refresh Statistics '
          ImageIndex = 0
          OnClick = ToolButton1Click
        end
      end
    end
    object TabSheet3: TTabSheet
      Caption = 'Server Properties'
      ImageIndex = 2
      object ToolBar2: TToolBar
        Left = 0
        Top = 0
        Width = 585
        Height = 29
        ButtonHeight = 21
        ButtonWidth = 94
        Caption = 'ToolBar2'
        ShowCaptions = True
        TabOrder = 0
        object ToolButton2: TToolButton
          Left = 0
          Top = 2
          Caption = 'Refresh Properties'
          ImageIndex = 0
          OnClick = ToolButton2Click
        end
      end
      object RichEdit3: TRichEdit
        Left = 0
        Top = 29
        Width = 585
        Height = 335
        Align = alClient
        TabOrder = 1
      end
    end
    object TabSheet4: TTabSheet
      Caption = 'Users'
      ImageIndex = 3
      object RichEdit4: TRichEdit
        Left = 0
        Top = 29
        Width = 585
        Height = 335
        Align = alClient
        TabOrder = 0
      end
      object ToolBar3: TToolBar
        Left = 0
        Top = 0
        Width = 585
        Height = 29
        ButtonHeight = 21
        ButtonWidth = 74
        Caption = 'ToolBar3'
        ShowCaptions = True
        TabOrder = 1
        object ToolButton3: TToolButton
          Left = 0
          Top = 2
          Caption = 'Refresh Users'
          ImageIndex = 0
          OnClick = ToolButton3Click
        end
      end
    end
  end
  object IBSQLMonitor1: TIBSQLMonitor
    OnSQL = IBSQLMonitor1SQL
    TraceFlags = [tfQPrepare, tfQExecute, tfQFetch, tfError, tfStmt, tfConnect, tfTransact, tfBlob, tfService, tfMisc]
    Left = 88
    Top = 96
  end
  object IBStatisticalService1: TIBStatisticalService
    Active = True
    Params.Strings = (
      'user_name=SYSDBA'
      'password=masterkey')
    LoginPrompt = False
    TraceFlags = []
    DatabaseName =
       'C:\Program Files\InterBase Corp\InterBase6\examples\Database\emp' +
      'loyee.gdb'
    Options = []
    Left = 88
    Top = 144
  end
  object IBServerProperties1: TIBServerProperties
    Active = True
    Params.Strings = (
      'user_name=SYSDBA'
      'password=masterkey')
    LoginPrompt = False
    TraceFlags = []
    Options = [Database, License, LicenseMask, ConfigParameters, Version]
    Left = 88
    Top = 192
  end
  object IBSecurityService1: TIBSecurityService
    Active = True
    Params.Strings = (
      'user_name=SYSDBA'
      'password=masterkey')
    LoginPrompt = False
    TraceFlags = []
    SecurityAction = ActionAddUser
    UserID = 0
    GroupID = 0
    Left = 88
    Top = 240
  end
end