Оформил: DeeCo

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

• программа-монитор ошибок должна работать как системный сервис Windows NT
• журнал ошибок должен сохраняться на диске и постоянно пополняться
• список текущих ошибок и полный журнал ошибок должны быть доступны для просмотра на любом компьютере локальной сети предприятия

• ошибка, возникшая в клиентской программе, передается по сети монитору-сервису Windows NT. Для передачи используем механизм каналов Mailslot
• монитор сохраняет текст ошибки на диске. Для хранения используем текстовый файл
• монитор пересылает по сети текст ошибки программе просмотра ошибок. Для передачи используем механизм каналов Mailslot
• программа просмотра принимает текст ошибки и отображает его на экране
• программа просмотра может запросить полный журнал ошибок. Для получения полного журнала используем механизм разделяемых сетевых файловых ресурсов

Монитор ошибок

• создаем новое приложение File | New... | New | Service Application. Создается приложение с глобальной переменной Application типа TServiceApplication и объектом типа TService, который и реализует всю функциональность сервиса
• устанавливаем требуемые свойства объекта TService
  • имя сервиса
  • параметры запуска сервиса
  • имя и пароль пользователя, от имени которого стартует сервис
• переписываем событие OnExecute объекта TService, в котором реализуем требуемую функциональность сервиса
• компилируем проект
• регистрируем созданный сервис на сервере Windows NT и запускаем

• журнал ведется в текстовом файле в определенном каталоге 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.

Окно просмотра ошибок

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

type
  TfmErrorMonitorMessage = class(TForm)
    // протокол текущих ошибок
    meErrorTextNow: TMemo;
    meJournals: TMemo;
    // таймер для опроса канала
    Timer: TTimer;
    paJournals: TPanel;
    buJournals: TButton;
    lbJournals: TListBox;
    laJournals: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure buJournalsClick(Sender: TObject);
  private
  public
  end;

  // сетевой разделяемый ресурс, где сохраняются журналы
  // (укажите здесь имя своего ресурса и обеспечьте права для доступа)
const
  LogDir = '\\MyServer\C$\Log\';

var
  fmErrorMonitorMessage: TfmErrorMonitorMessage;
  h: THandle; // handle Mailslot-канала
  str: string[250]; // буфер обмена
  MsgNumber, MsgNext, Read: DWORD;

implementation
{$R *.DFM}

procedure TfmErrorMonitorMessage.FormCreate(Sender: TObject);
var
  sr: TSearchRec;
  i: integer;
begin
  // создание Mailslot-канала с именем EMonMess
  // по этому каналу будем получать сообщения об ошибках от сервиса NT
  h := CreateMailSlot('\\.\mailslot\EMonMess', 0, MAILSLOT_WAIT_FOREVER, nil);
  if h = INVALID_HANDLE_VALUE then
  begin
    ShowMessage('Ошибка создания канала !');
    Halt;
  end;
  // интервал опроса канала Mailslot - 3 секунды
  Timer.Interval := 3000;
  // таймер первоначально был выключен
  Timer.Enabled := True;
  // заполнение списка доступных журналов
  i := FindFirst(LogDir + '*.log', faAnyFile, sr);
  while i = 0 do
  begin
    lbJournals.Items.Add(sr.Name);
    i := FindNext(sr);
  end;
  lbJournals.ItemIndex := lbJournals.Items.Count - 1;
  FindClose(sr);
end;

procedure TfmErrorMonitorMessage.TimerTimer(Sender: TObject);
var
  str: string[250];
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
      meErrorTextNow.Lines.Add(str)
    else
      ShowMessage('Ошибка чтения сообщения !');
  end;
  Timer.Enabled := True;
end;

procedure TfmErrorMonitorMessage.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  CloseHandle(h);
end;

procedure TfmErrorMonitorMessage.buJournalsClick(Sender: TObject);
var
  Journal: TFileStream;
  s: string;
begin
  // получение журнала ошибок за дату
  meJournals.Lines.Clear;
  meJournals.Lines.Add('Файл журнала ' +
    lbJournals.Items[lbJournals.ItemIndex]);
  Journal := TFileStream.Create(LogDir + lbJournals.Items[lbJournals.ItemIndex],
    fmOpenRead or fmShareDenyNone);
  SetLength(s, Journal.Size);
  Journal.Read(PChar(s)^, Journal.Size);
  meJournals.Lines.Add(s);
  Journal.Free;
end;

end.