Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 6

Chapter 15 - Project IbxMon

Project Structure

IbxMon.dpr
program IbxMon;

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

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
MonForm.pas
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.
MonForm.dfm
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