Delphi World - Искусство управления ошибками. Часть 2
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Искусство управления ошибками. Часть 2

Оформил: DeeCo

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

Введение

Любая программа содержит ошибки и мастерство разработчика не только в минимизации числа этих ошибок, но и в умении управлять ими, если таковые возникли. Посмотрим, что же в плане управления программными ошибками предлагают такие системы как Delphi и Windows 95/Windows NT. Поставим задачу следующим образом : все ошибки в программах собственной разработки, независимо от места их возникновения на клиентских ПК предприятия, должны собираться и регистрироваться в одном единственном месте, а разработчик должен получать сообщение об этом событии, содержащее полный текст ошибки.
Предложим следующую схему управления ошибками. На каком-либо ПК запускается программа-монитор и ждет сообщений об ошибках от клиентских программ , при приходе которых, регистрирует их. Клиентские программы при возникновении ошибки перехватывают ее, предварительно обрабатывают и отсылают монитору по локальной вычислительной сети.
Решение задачи разобьем на 2 этапа - разработка сервера-монитора слежения за ошибками и подпрограммы-ловушки ошибок в прикладной клиентской программе. При разработке систем подобного класса неизбежно встает вопрос о протоколе межмашинного взаимодействия клиента и сервера. Из множества вариантов, предлагаемых Windows, мы остановим свой выбор на каналах передачи данных Mailslot, как наиболее простом, доступном и универсальном. Немного о Mailslot : каналы Mailslot позволяют выполнять одностороннюю передачу данных от одного или нескольких клиентов к одному или нескольким серверам, причем работают на уровне датаграмм и в широковещательном режиме.
Монитор слежения за ошибками
Монитор слежения за ошибками - это отдельное приложение, запускаемое либо на вашем ПК, либо на сервере (как Вам удобно). Его предназначение - ловить сообщения об ошибках, приходящие от клиентских программ и отображать текст ошибки в окне программы. Монитор должен запускаться до запуска любой клиентской программы. Окно монитора
Текст монитора приведен ниже :
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.
В следующей статье будет показано как превратить монитор ошибок в сервис Windows NT.

Получить исходные тексты (13 Кб)
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования