Статьи Королевства Дельфи


Текст монитора приведен ниже


Подпрограмма ловушки ошибок встраивается в каждую прикладную программу. Ниже приведен примерный шаблон такой ловушки и пример ее использования. Вы вправе настроить шаблон под особенности своей предметной области. 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. Даутов Ильдар, 06 декабря 1999




Начало  Назад  Вперед



Книжный магазин