unit fmMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, IdStackWindows,
  Dialogs, IdBaseComponent, IdComponent, DB, FIBDataSet,
  pFIBDataSet, FIBDatabase, pFIBDatabase, cxGraphics, cxControls, cxLookAndFeelPainters, cxContainer,
  cxEdit, cxMaskEdit, cxDropDownEdit, cxMRUEdit, cxTextEdit, cxLabel, cxGroupBox, ExtCtrls, StdCtrls,
  IdMessage, IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase, IdMessageClient,
  IdSMTPBase, IdSMTP, cxLookAndFeels;

type
  TfMain = class(TForm)
    cxGroupBox1: TcxGroupBox;
    lblLogin: TcxLabel;
    edLoginA: TcxTextEdit;
    lblPassword: TcxLabel;
    edPasswordA: TcxTextEdit;
    lbServer: TcxLabel;
    edServerNameA: TcxMRUEdit;
    lbDataBase: TcxLabel;
    edDBPathA: TcxMRUEdit;
    Timer1: TTimer;
    Button1: TButton;
    DBArch: TpFIBDatabase;
    pFIBTransaction1: TpFIBTransaction;
    ds: TpFIBDataSet;
    SMTP: TIdSMTP;
    IdMsgSend: TIdMessage;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    LastSize: Int64;
    procedure SendMail(AIsTest: Boolean);
    procedure Send;
    function CheckSize(AIsTest: Boolean): Boolean;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fMain: TfMain;

implementation

{$R *.dfm}

procedure TfMain.Send;
var
  i: Integer;
begin
  IdMsgSend.From.Text := 'user@mail.ua';
  IdMsgSend.Recipients.EMailAddresses := 'my@mail.ua';
  IdMsgSend.Priority := TIdMessagePriority(2);
  IdMsgSend.Subject := FloatToStrF(LastSize / 1000000000, ffNumber, 4, 2) + 'GB - DB BIG SIZE!';
  IdMsgSend.Body.Text := 'SQLs:';
  for i := 0 to ds.RecordCountFromSrv - 1 do
  begin
    IdMsgSend.Body.Add('USER: ' + ds.Fields[0].AsString);
    IdMsgSend.Body.Add('Statement: ' + ds.Fields[1].AsString);
    IdMsgSend.Body.Add('Attachment: ' + ds.Fields[2].AsString);
    IdMsgSend.Body.Add('Transaction: ' + ds.Fields[3].AsString);
    IdMsgSend.Body.Add('Started: ' + ds.Fields[4].AsString);
    IdMsgSend.Body.Add('SQL: ' + ds.Fields[5].AsString);
    IdMsgSend.Body.Add('Non-indexed R: ' + ds.Fields[6].AsString);
    IdMsgSend.Body.Add('Indexed R: ' + ds.Fields[7].AsString);
    IdMsgSend.Body.Add('Records Ins: ' + ds.Fields[8].AsString);
    IdMsgSend.Body.Add('Records Upd: ' + ds.Fields[9].AsString);
    IdMsgSend.Body.Add('Records Del: ' + ds.Fields[10].AsString);
    IdMsgSend.Body.Add('Records B/O: ' + ds.Fields[11].AsString);
    IdMsgSend.Body.Add('Records Pur: ' + ds.Fields[12].AsString);
    IdMsgSend.Body.Add('Records Exp: ' + ds.Fields[13].AsString);
    IdMsgSend.Body.Add('Page R: ' + ds.Fields[14].AsString);
    IdMsgSend.Body.Add('Page W: ' + ds.Fields[15].AsString);
    IdMsgSend.Body.Add('Page F: ' + ds.Fields[16].AsString);
    IdMsgSend.Body.Add('Page M: ' + ds.Fields[17].AsString);
    IdMsgSend.Body.Add('-------------------');
    IdMsgSend.Body.Add('-------------------');
    IdMsgSend.Body.Add('-------------------');

    ds.Next;
  end;
  IdMsgSend.ContentType := 'text/plain';
  SMTP.Host := 'smtp.mail.ua';
  SMTP.Port := 25;

  SMTP.Connect;
  try
    SMTP.Send(IdMsgSend);
    SMTP.Disconnect;
  except
    on e : exception do
    begin
      Application.MessageBox(PChar('Неможливо надіслати лист: ' + e.Message), PChar(Application.Title), MB_OK or MB_ICONWARNING);
      SMTP.Disconnect;
    end;
  end;
end;

procedure TfMain.SendMail(AIsTest: Boolean);
begin
  try
    DBArch.Connected := False;
    DBArch.DBName := edServerNameA.Text + ':' + edDBPathA.Text;
    DBArch.ConnectParams.UserName := edLoginA.Text;
    DBArch.ConnectParams.Password := edPasswordA.Text;
    DBArch.Connected := True;

    ds.Open;
    if CheckSize(AIsTest) then
      Send;
    ds.Close;

    DBArch.Connected := False;
  except
    on e : exception do
    begin
      Application.MessageBox(PChar('Неможливо з`єднатись з базою: '+e.Message),
                             PChar(Application.Title),
                             MB_OK or MB_ICONWARNING);
       DBArch.Connected := False;
      if edDBPathA.CanFocus then
        edDBPathA.SetFocus;
    end;
  end;
end;

procedure TfMain.Button2Click(Sender: TObject);
begin
  Timer1.Enabled := False;
  LastSize := 0;
  Timer1.Enabled := True;
end;

function TfMain.CheckSize(AIsTest: Boolean): Boolean;
var
  SearchRec: TSearchRec;
begin
  if FindFirst(ExpandFileName(DBArch.DBFileName), faAnyFile, SearchRec) = 0 then
  begin
    Result := SearchRec.Size - LastSize > 100000000;
    LastSize := SearchRec.Size;
  end
  else
    Result := False;
  Result := Result or AIsTest;
  FindClose(SearchRec);
end;

procedure TfMain.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled := False;
  SendMail(False);
  Timer1.Enabled := True;
end;

procedure TfMain.Button1Click(Sender: TObject);
begin
  SendMail(True);
end;

end.

object fMain: TfMain
  Left = 0
  Top = 0
  Caption = 'fMain'
  ClientHeight = 176
  ClientWidth = 341
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object cxGroupBox1: TcxGroupBox
    Left = 20
    Top = 12
    Caption = #1041#1044
    TabOrder = 0
    Transparent = True
    Height = 121
    Width = 313
    object lblLogin: TcxLabel
      Left = 14
      Top = 17
      Caption = #1051#1086#1075#1110#1085
      FocusControl = edLoginA
    end
    object edLoginA: TcxTextEdit
      Left = 60
      Top = 16
      Properties.CharCase = ecUpperCase
      TabOrder = 1
      Text = 'SYSDBA'
      Width = 241
    end
    object lblPassword: TcxLabel
      Left = 14
      Top = 40
      Caption = #1055#1072#1088#1086#1083#1100
      FocusControl = edPasswordA
    end
    object edPasswordA: TcxTextEdit
      Left = 60
      Top = 39
      Properties.EchoMode = eemPassword
      Properties.PasswordChar = '*'
      TabOrder = 3
      Text = 'masterkey'
      Width = 241
    end
    object lbServer: TcxLabel
      Left = 14
      Top = 63
      Caption = #1057#1077#1088#1074#1077#1088
      FocusControl = edServerNameA
    end
    object edServerNameA: TcxMRUEdit
      Left = 60
      Top = 62
      Properties.ShowEllipsis = False
      TabOrder = 5
      Text = 'localhost'
      Width = 241
    end
    object lbDataBase: TcxLabel
      Left = 14
      Top = 86
      Caption = #1041#1044
      FocusControl = edDBPathA
    end
    object edDBPathA: TcxMRUEdit
      Left = 60
      Top = 85
      Properties.ShowEllipsis = False
      TabOrder = 7
      Text = 'c:\db.fdb'
      Width = 241
    end
  end
  object Button1: TButton
    Left = 258
    Top = 143
    Width = 75
    Height = 25
    Caption = 'TEST'
    TabOrder = 1
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 20
    Top = 143
    Width = 75
    Height = 25
    Caption = 'Start'
    TabOrder = 2
    OnClick = Button2Click
  end
  object Timer1: TTimer
    Enabled = False
    Interval = 30000
    OnTimer = Timer1Timer
    Left = 18
    Top = 20
  end
  object DBArch: TpFIBDatabase
    DefaultTransaction = pFIBTransaction1
    SQLDialect = 3
    Timeout = 0
    WaitForRestoreConnect = 0
    Left = 24
    Top = 136
  end
  object pFIBTransaction1: TpFIBTransaction
    DefaultDatabase = DBArch
    TimeoutAction = TARollback
    Left = 98
    Top = 138
  end
  object ds: TpFIBDataSet
    SelectSQL.Strings = (
      
        'select A.MON$USER, ST.MON$STATEMENT_ID, ST.MON$ATTACHMENT_ID, ST' +
        '.MON$TRANSACTION_ID, ST.MON$TIMESTAMP, ST.MON$SQL_TEXT,'
      
        '       R.MON$RECORD_SEQ_READS, R.MON$RECORD_IDX_READS, R.MON$REC' +
        'ORD_INSERTS, R.MON$RECORD_UPDATES, R.MON$RECORD_DELETES,'
      
        '       R.MON$RECORD_BACKOUTS, R.MON$RECORD_PURGES, R.MON$RECORD_' +
        'EXPUNGES, IO.MON$PAGE_READS, IO.MON$PAGE_WRITES,'
      '       IO.MON$PAGE_FETCHES, IO.MON$PAGE_MARKS'
      '  from MON$STATEMENTS ST'
      
        '  left join MON$RECORD_STATS R on (ST.MON$STAT_ID = R.MON$STAT_I' +
        'D)'
      '  left join MON$IO_STATS IO on (ST.MON$STAT_ID = IO.MON$STAT_ID)'
      
        '  left join MON$ATTACHMENTS A on A.MON$ATTACHMENT_ID = ST.MON$AT' +
        'TACHMENT_ID'
      '  where ST.MON$STATE = 1'
      '  order by ST.MON$TIMESTAMP  ')
    Transaction = pFIBTransaction1
    Database = DBArch
    Left = 178
    Top = 140
  end
  object SMTP: TIdSMTP
    Host = 'smtp.mail.ua'
    SASLMechanisms = <>
    Left = 220
    Top = 19
  end
  object IdMsgSend: TIdMessage
    AttachmentEncoding = 'UUE'
    BccList = <>
    CharSet = 'windows-1251'
    CCList = <>
    ContentType = 'text/plain'
    Encoding = meDefault
    FromList = <
      item
      end>
    Recipients = <>
    ReplyTo = <>
    ConvertPreamble = True
    Left = 248
    Top = 32
  end
end

for select...
begin
  SOME_PAR = '';
  for select...
  begin
    SOME_PAR = SOME_PAR || 'some data1';
    SOME_PAR = SOME_PAR || 'some data1';
    SOME_PAR = SOME_PAR || 'some data1';
    ...
    и так 15 раз...
  end
  suspend;
end