Автор: Даутов Ильдар, дата публикации 05 января 2000
Часть II
Продолжая тему "Управление ошибками в Delphi", поставим следующие задачи :
программа- монитор ошибок должна работать как системный сервис Windows NT
журнал ошибок должен сохраняться на диске и постоянно пополняться
список текущих ошибок и полный журнал ошибок должны быть доступны для просмотра на любом компьютере локальной сети предприятия
Реализуем следующую схему взаимодействия программ при возникновении ошибки :
ошибка, возникшая в клиентской программе, передается по сети монитору-сервису Windows NT. Для передачи используем механизм каналов Mailslot
монитор сохраняет текст ошибки на диске. Для хранения используем текстовый файл
монитор пересылает по сети текст ошибки программе просмотра ошибок. Для передачи используем механизм каналов Mailslot
программа просмотра принимает текст ошибки и отображает его на экране
программа просмотра может запросить полный журнал ошибок. Для получения полного журнала используем механизм разделяемых сетевых файловых ресурсов
В статье представлены 2 проекта : монитор ошибок и окно просмотра ошибок. Клиентская программа, имитирующая ошибку, была представлена в , и здесь не рассматривается.
Монитор ошибок
Оформить программу как сервис Windows NT (Win32 service) не составляет большого труда :
создаем новое приложение File | New... | New | Service Application. Создается приложение с глобальной переменной Application типа TServiceApplication и объектом типа TService, который и реализует всю функциональность сервиса
устанавливаем требуемые свойства объекта TService
имя сервиса
параметры запуска сервиса
имя и пароль пользователя, от имени которого стартует сервис
переписываем событие OnExecute объекта TService, в котором реализуем требуемую функциональность сервиса
компилируем проект
регистрируем созданный сервис на сервере Windows NT и запускаем
Регистрация сервиса выполняется из командной строки следующим образом : ErrorMonitorService.exe /install Удаление сервиса : ErrorMonitorService.exe /uninstall Запуск сервиса выполняется из командной строки следующим образом : net start ErrorMonitor Останов сервиса : net stop ErrorMonitor
Оформив эту последовательность команд как BAT-файл, можно значительно облегчить себе жизнь при отладке сервиса.
Достаточно подробную информацию о сервисах Windows NT можно найти в книге : А.В.Фролов, Г.В.Фролов 'Программирование для Windows NT (часть вторая)', Москва, ДИАЛОГ-МИФИ, 1997
Для сохранения протокола (журнала) пользовательских ошибок используем следующую схему :
журнал ведется в текстовом файле в определенном каталоге Windows NT
журнал имеет имя yyyy-mm-dd.log, соответствующее календарной дате запуска сервера
при каждом запуске монитор проверяет наличие файла, имя которого соответствует текущей дате. При отсутствии - файл создается, иначе происходит дозапись в конец файла
сохраняются только последние 7 файлов журнала
Текст программы монитора ошибок приведен ниже : unit uErrorMonitorService; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, ScktComp; type TErrorMonitor = class(TService) procedure Service1Execute(Sender: TService); procedure ServiceEMCreate(Sender: TObject); private public function GetServiceController: PServiceController; override; procedure SendError; function InitLog : boolean; end; var ErrorMonitor: TErrorMonitor; implementation uses Dialogs; {$R *.DFM} const LogDir='C:\Log\'; // каталог, где сохраняются журналы var LogFile : TextFile; // файл текущего журнала LogName : string; // имя файла текущего журнала h : THandle; // handle канала Mailslot str : string[250]; // буфер для передачи информации MsgNumber,MsgNext,Read : DWORD; procedure ServiceController(CtrlCode: DWord); stdcall; begin ErrorMonitor.Controller(CtrlCode); end; function TErrorMonitor.GetServiceController: PServiceController; begin Result := @ServiceController; end; // Передача текста ошибки от сервиса программе просмотра procedure TErrorMonitor.SendError; var h : THandle; i : integer; begin // открытие MailSlot-канала, по которому будет передаваться протокол // используется широковещательная передача в домене h:=CreateFile(PChar('\\*\mailslot\EMonMess'),GENERIC_WRITE,FILE_SHARE_READ,nil, OPEN_EXISTING,0,0); if h <> INVALID_HANDLE_VALUE then begin // запись в канал и закрытие канала WriteFile(h,str,Length(str)+1,DWORD(i),nil); CloseHandle(h); end; end; // инициализация файла журнала // журналы ведутся в отдельных файлах по каждой дате function TErrorMonitor.InitLog : boolean; var sr : TSearchRec; i : integer; begin Result:=True; // удаление старых файлов журнала //(сохраняются только последние 7 журналов) with TStringList.Create do begin Sorted:=True; i:=FindFirst(LogDir+'*.log',faAnyFile,sr); while i = 0 do begin Add(sr.Name); i:=FindNext(sr); end; FindClose(sr); if Count > 7 then for i:=0 to Count-8 do DeleteFile(LogDir+Strings[i]); Free; end; // текущий файл журнала LogName:=LogDir+FormatDateTime('yyyy-mm-dd',Date)+'.log'; AssignFile(LogFile,LogName); try if FileExists(LogName) then Append(LogFile) else Rewrite(LogFile); except str:='Ошибка создания файла журнала : '+LogName; Status:=csStopped; LogMessage(str); ShowMessage(str); Result:=False; end; end; // основная логика сервиса procedure TErrorMonitor.Service1Execute(Sender: TService); begin // создание MailSlot-канала с именем EMon - по этому имени к нему // будут обращаться клиенты, у которых возникли ошибки h:=CreateMailSlot('\\.\mailslot\EMon',0,MAILSLOT_WAIT_FOREVER,nil); if h=INVALID_HANDLE_VALUE then begin Status:=csStopped; // запись в журнал событий NT str:='Ошибка создания канала EMon !'; LogMessage(str); ShowMessage(str); Exit; end; // создание файла журнала if not InitLog then Exit; try while not Terminated do begin // определение наличия сообщения в канале if not GetMailSlotInfo(h,nil,DWORD(MsgNext),@MsgNumber,nil) then begin Status:=csStopped; str:='Ошибка сбора информации канала EMon !'; LogMessage(str); ShowMessage(str); Break; end; if MsgNext <> MAILSLOT_NO_MESSAGE then begin beep; // чтение сообщения из канала и добавление в текст протокола if ReadFile(h,str,200,DWORD(Read),nil) then begin // запись в журнал Writeln(LogFile,str); // посылка сообщения для показа SendError; end else begin str:='Ошибка чтения сообщения !'; Writeln(LogFile,str); SendError; end; Flush(LogFile); end; sleep(500); ServiceThread.ProcessRequests(False); end; finally CloseHandle(h); CloseFile(LogFile); end; end; procedure TErrorMonitor.ServiceEMCreate(Sender: TObject); begin // под таким именем наш сервис будет виден в Service Control Manager DisplayName:='ErrorMonitor'; // необходимо при использовании ShowMessage InterActive:=True; end; end.
