Искусство управления ошибками. Часть 2

Delphi , Синтаксис , Ошибки и Исключения

Оформил: DeeCo

Автор: Даутов Ильдар

Введение

unit fErrorMonitor;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

type
  TfmErrorMonitor = class(TForm)
    // компонент для протоколирования ошибок
    meErrorText: TMemo;
    // компонент для активизации опроса канала
    // интервал опроса устанавливается свойством Interval
    Timer: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
  public
  end;

var
  fmErrorMonitor: TfmErrorMonitor;
var
  h: THandle;
  str: string[250];
  MsgNumber, MsgNext, Read: DWORD;

implementation
{$R *.DFM}

procedure TfmErrorMonitor.FormCreate(Sender: TObject);
begin
  // создание канала с именем EMon - по этому имени к нему
  // будут обращаться клиенты
  h := CreateMailSlot('\\.\mailslot\EMon', 0, MAILSLOT_WAIT_FOREVER, nil);
  if h = INVALID_HANDLE_VALUE then
  begin
    ShowMessage('Ошибка создания канала !');
    Halt;
  end;
  // таймер первоначально был выключен
  Timer.Enabled := True;
end;

procedure TfmErrorMonitor.TimerTimer(Sender: TObject);
begin
  Timer.Enabled := False;
  // определение наличия сообщения в канале
  if not GetMailSlotInfo(h, nil, DWORD(MsgNext), @MsgNumber, nil) then
  begin
    ShowMessage('Ошибка сбора информации !');
    Close;
  end;
  if MsgNext <> MAILSLOT_NO_MESSAGE then
  begin
    beep;
    // чтение сообщения из канала и добавление в текст протокола
    if ReadFile(h, str, 200, DWORD(Read), nil) then
      meErrorText.Lines.Add(str)
    else
      ShowMessage('Ошибка чтения сообщения !');
  end;
  Timer.Enabled := True;
end;

procedure TfmErrorMonitor.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  // закрытие канала
  CloseHandle(h);
end;
end.

unit fErrorClient;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

type
  TfmTest = class(TForm)
    Button1: TButton;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
  public
  end;

implementation
{$R *.DFM}

type
  Error = class
    class procedure ErrorCatch(Sender: TObject; Exc: Exception);
  end;

  // для простоты ловушка ошибок описана в этом модуле
  // в реальных приложениях ее нужно вынести в отдельный unit

class procedure Error.ErrorCatch(Sender: TObject; Exc: Exception);
var
  strMess: string[250];
  UserName: array[0..99] of char;
  h: THandle;
  i: integer;
begin
  // здесь можно проанализировать Exception, воспользовавшись его свойствами,
  // и предпринять конкретные действия в зависимости  от типа ошибки
  beep;
  // получение имени пользователя
  i := SizeOf(UserName);
  GetUserName(UserName, DWORD(i));
  // формирование текста сообщения об ошибке
  strMess := '/' + UserName + '/' + FormatDateTime('hh:mm', Time) + '/' +
    Exc.Message;
  // открытие канала : MyServer - имя сервера, на котором работает
  // монитор ошибок (\\.\\mailslot\EMon - монитор работает на этом же ПК)
  // EMon - имя канала
  h := CreateFile(PChar('\\MyServer\mailslot\EMon'), GENERIC_WRITE,
    FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
  if h <> INVALID_HANDLE_VALUE then
  begin
    // передача текста ошибки (запись в канал и закрытие канала)
    WriteFile(h, strMess, Length(strMess) + 1, DWORD(i), nil);
    CloseHandle(h);
  end;
  // вывод сообщения об ошибке пользователю
  ShowMessage('У Вас возникла ошибка (не волнуйтесь-все под контролем)' +
    chr(13) + strMess);
end;

procedure TfmTest.FormCreate(Sender: TObject);
begin
  // при создании главной формы приложения устанавливаем
  // глобальный обработчик исключений
  Application.OnException := Error.ErrorCatch;
end;

procedure TfmTest.Button1Click(Sender: TObject);
var
  i: integer;
begin
  // тестирование ловушки ошибок
  i := 1 - 1;
  i := 100 div i;
end;
end.

Искусство управления ошибками: как минимизировать и отслеживать ошибки в программе на примере Delphi и Windows 95/NT.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Ошибки и Исключения ::