Вопрос по TService и отправка по почте.

[Sti.k]

Не пойму в чем может быть проблема. Написал службу, которая по событию в журнале отправляет по почте письмо с содержанием события. Но работает не понятно как, некоторые события отправляет, а некоторые игнорирует. Причем если код перенести на обычную форму то все работает нормально, как надо.

PS: Используется FWEventLog.pas с сайта http://rouse.drkb.ru/

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
  idSMTP, idMessage, ActiveX, FWEventLog;

const
  max_Task = 100;
  iniFile = 'eventmail.ini';

type
  Teventmail = class(TService)
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure ServiceExecute(Sender: TService);
  private
    { Private declarations }
  public
    function GetServiceController: TServiceController; override;
    function CreateEventLog(EventLog: TFWEventLog; Source: string; CurrData: integer): boolean;
    procedure OnEventReadApp(Sender: TObject; EventRecord: TFWEventLogRecord);
    procedure OnEventReadSec(Sender: TObject; EventRecord: TFWEventLogRecord);
    procedure OnEventReadSys(Sender: TObject; EventRecord: TFWEventLogRecord);
    { Public declarations }
  end;

type
  TEvent = record
    Success, Error, Warning, Information, AuditSuccess, AuditFailed: boolean;
  end;

type
  TFileTask = record
    EventJ: string;
    fname: string;
    Success, Error, Warning, Information, AuditSuccess, AuditFailed: boolean;
  end;

var
  eventmail: Teventmail;
  EventLogApp: TFWEventLog;
  EventLogSec: TFWEventLog;
  EventLogSys: TFWEventLog;
  fTask: array [0..max_Task] of TFileTask;
  fini: TextFile;
  port: integer = 25;
  strIP: string = 'xxx';
  strRecipient: string = 'xx@x.xx';
  strFrom: string = 'x@x.xx';
  appE, secE, sysE: TEvent;
  appJ, secJ, sysJ: boolean;
  fT: integer;

implementation

{$R *.DFM}

procedure FileLog(fileReport, Msg: string);
var
  hFile: THandle;
  BitesWriten: DWORD;
begin
  Msg := DateTimeToStr(Now) + #9 + Msg;
  hFile := CreateFile(PChar(fileReport), GENERIC_WRITE, FILE_SHARE_WRITE, nil, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  if hFile = INVALID_HANDLE_VALUE then Exit;
  SetFilePointer(hFile, 0, nil, FILE_END);
  Msg := Msg + #13#10;
  WriteFile(hFile, Msg[1], Length(Msg), BitesWriten, nil);
  CloseHandle(hFile);
end;

function mail(server: string; port: integer; from, recipient, subject, atfile, body: string): string;
var
  t: TidSMTP;
  m: TidMessage;
  res: string;
begin
  res := '';
  try
    if server='' then res := 'invalid server name, ';
    if port<=0 then port := 25;
    if from='' then res := res + 'invalid sender name, ';
    if recipient='' then res := res + 'invalid recipient name, ';
    if res <> '' then exit;
    m := TidMessage.Create(nil);
    t := TidSMTP.Create(nil);
    t.Host := server;
    t.Port := port;
    t.Connect();
    m.ContentType := 'text/plain';
    m.CharSet := 'windows-1251';
    m.From.Address := from;
    m.Recipients.Add.Address := recipient;
    m.Subject := subject;
    if atfile <> '' then TidAttachment.Create(m.MessageParts,atfile);
    if body <> '' then
      if FileExists(body)=false then m.Body.Insert(0,body)
                                else m.Body.LoadFromFile(body);
    t.Send(m);
    t.Free;
    m.Free;
    except FileLog('c:\1.txt', '---- MAIL ' + res);
  end;
end;

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  eventmail.Controller(CtrlCode);
end;

function Teventmail.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure Teventmail.ServiceStart(Sender: TService; var Started: Boolean);
var
  str, str1: string;
  i: integer;
begin
  AssignFile(fini, iniFile);
  if not FileExists(iniFile) then begin
    Rewrite(fini);
    Writeln(fini, strIP);
    Writeln(fini, IntToStr(port));
    Writeln(fini, strRecipient);
    Writeln(fini, strFrom);
    Writeln(fini, 'EventLogApp=0');
    Writeln(fini, 'EventLogSec=0');
    Writeln(fini, 'EventLogSys=0');
    Writeln(fini, '000000');
    Writeln(fini, '000000');
    Writeln(fini, '000000');
    CloseFile(fini);
  end;

Продолжение...

[Sti.k]

Reset(fini);
  Readln(fini, strIP);
  Readln(fini, str);
  port := StrToInt(str);
  Readln(fini, strRecipient);
  Readln(fini, strFrom);
  Readln(fini, str);
  if str = 'EventLogApp=1' then appJ := CreateEventLog(EventLogApp, 'EventApp', 1);
  Readln(fini, str);
  if str = 'EventLogSec=1' then secJ := CreateEventLog(EventLogSec, 'EventSec', 2);
  Readln(fini, str);
  if str = 'EventLogSys=1' then sysJ := CreateEventLog(EventLogSys, 'EventSys', 3);
  Readln(fini, str);
  if Copy(str, 1, 1) = '1' then appE.Success := true else appE.Success := false;
  if Copy(str, 2, 1) = '1' then appE.Error := true else appE.Error := false;
  if Copy(str, 3, 1) = '1' then appE.Warning := true else appE.Warning := false;
  if Copy(str, 4, 1) = '1' then appE.Information := true else appE.Information := false;
  if Copy(str, 5, 1) = '1' then appE.AuditSuccess := true else appE.AuditSuccess := false;
  if Copy(str, 6, 1) = '1' then appE.AuditFailed := true else appE.AuditFailed := false;
  Readln(fini, str);
  if Copy(str, 1, 1) = '1' then secE.Success := true else secE.Success := false;
  if Copy(str, 2, 1) = '1' then secE.Error := true else secE.Error := false;
  if Copy(str, 3, 1) = '1' then secE.Warning := true else secE.Warning := false;
  if Copy(str, 4, 1) = '1' then secE.Information := true else secE.Information := false;
  if Copy(str, 5, 1) = '1' then secE.AuditSuccess := true else secE.AuditSuccess := false;
  if Copy(str, 6, 1) = '1' then secE.AuditFailed := true else secE.AuditFailed := false;
  Readln(fini, str);
  if Copy(str, 1, 1) = '1' then sysE.Success := true else sysE.Success := false;
  if Copy(str, 2, 1) = '1' then sysE.Error := true else sysE.Error := false;
  if Copy(str, 3, 1) = '1' then sysE.Warning := true else sysE.Warning := false;
  if Copy(str, 4, 1) = '1' then sysE.Information := true else sysE.Information := false;
  if Copy(str, 5, 1) = '1' then sysE.AuditSuccess := true else sysE.AuditSuccess := false;
  if Copy(str, 6, 1) = '1' then sysE.AuditFailed := true else sysE.AuditFailed := false;
  for i := 0 to max_Task do fTask[i].EventJ := '';
  fT := 0;
  while not eof(fini) do begin
    Readln(fini, str);
    if str <> '' then begin
      fTask[fT].EventJ := Copy(str, 1, Pos('|', str) - 1);
      str1 := Copy(str, Pos('|', str) + 1, Length(str) - Pos('|', str));
      fTask[fT].fname := Copy(str1, 1, Pos('|', str1) - 1);
      str := Copy(str1, Pos('|', str1) + 1, Length(str1) - Pos('|', str1));
      if Copy(str, 1, 1) = '1' then fTask[fT].Success := true else fTask[fT].Success := false;
      if Copy(str, 2, 1) = '1' then fTask[fT].Error := true else fTask[fT].Error := false;
      if Copy(str, 3, 1) = '1' then fTask[fT].Warning := true else fTask[fT].Warning := false;
      if Copy(str, 4, 1) = '1' then fTask[fT].Information := true else fTask[fT].Information := false;
      if Copy(str, 5, 1) = '1' then fTask[fT].AuditSuccess := true else fTask[fT].AuditSuccess := false;
      if Copy(str, 6, 1) = '1' then fTask[fT].AuditFailed := true else fTask[fT].AuditFailed := false;
      fT := fT + 1;
    end;
  end;
  CloseFile(fini);
  Started := true;
end;

procedure Teventmail.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  EventLogApp.Free;
  EventLogSec.Free;
  EventLogSys.Free;
  Stopped := true;
end;

function Teventmail.CreateEventLog(EventLog: TFWEventLog; Source: string; CurrData: integer): boolean;
begin
  EventLog := TFWEventLog.Create(Source);
  EventLog.Open(TFWLocalEventSources(CurrData), osRead);
  case CurrData of
    1: if not EventLog.RegisterChangeNotify(OnEventReadApp) then
        Result := false else Result := true;
    2: if not EventLog.RegisterChangeNotify(OnEventReadSec) then
        Result := false else Result := true;
    3: if not EventLog.RegisterChangeNotify(OnEventReadSys) then
        Result := false else Result := true;
    else Result := false;
  end;
end;

Продолжение...

[Sti.k]

function idfMailSend(EventLog: TFWEventLog; EventRecord: TFWEventLogRecord; Evnt: TEvent; Jrnl: string; var typeEventEng: string): boolean;
var
  idfTask: boolean;
  i: integer;
begin
  idfTask := false;
  Result := false;
  for i := 0 to fT do
    if fTask[i].EventJ = Jrnl then
      if AnsiLowerCase(fTask[i].fname) = AnsiLowerCase(EventRecord.SourceName) then begin
        idfTask := true;
        break;
      end;
  case EventRecord.EventType of
    rtSuccess     : begin
      typeEventEng := 'Success';
      case idfTask of
        true  : if fTask[i].Success then Result := true;
        false : if Evnt.Success then Result := true;
      end;
    end;
    rtError       : begin
      typeEventEng := 'Error';
      case idfTask of
        true  : if fTask[i].Error then Result := true;
        false : if Evnt.Error then Result := true;
      end;
    end;
    rtWarning     : begin
      typeEventEng := 'Warning';
      case idfTask of
        true  : if fTask[i].Warning then Result := true;
        false : if Evnt.Warning then Result := true;
      end;
    end;
    rtInformation : begin
      typeEventEng := 'Information';
      case idfTask of
        true  : if fTask[i].Information then Result := true;
        false : if Evnt.Information then Result := true;
      end;
    end;

    rtAuditSuccess: begin
      typeEventEng := 'AuditSuccess';
      case idfTask of
        true  : if fTask[i].AuditSuccess then Result := true;
        false : if Evnt.AuditSuccess then Result := true;
      end;
    end;
    rtAuditFailed : begin
      typeEventEng := 'AuditFailed';
      case idfTask of
        true  : if fTask[i].AuditFailed then Result := true;
        false : if Evnt.AuditFailed then Result := true;
      end;
    end;
  end;
end;

procedure Send(EventRecord: TFWEventLogRecord; typeEventEng: string);
var
  cmd: string;
begin
  cmd := 'Date: ' + DateTimeToStr(Now) + #13#10 +
         'Station: ' + EventRecord.ComputerName + #9 + 'Domain: ' + EventRecord.Domain + #9 + 'Account: ' + EventRecord.Account + #13#10 +
         'Source: ' + EventRecord.SourceName + #13#10 +
         'Category: ' + EventRecord.Category + #13#10 +
         'ID: ' + IntToStr(EventRecord.EventID) + #13#10 +
         '---' + #13#10 +
         'Description: ' + EventRecord.Description;
  //FileLog('c:\1.txt', '---------------------------- Event ------------------------' + #13#10 + cmd + #13#10);
  //mail(strIP, port, strFrom, strRecipient, typeEventEng + '  on  ' + EventRecord.ComputerName, '', cmd);
  mail('xxx', 25, 'xx@x.xx', 'x@x.xx', typeEventEng + '  on  ' + EventRecord.ComputerName, '', cmd);
end;

procedure Teventmail.OnEventReadApp(Sender: TObject; EventRecord: TFWEventLogRecord);
var
  typeEventEng: string;
begin                           
  FileLog('c:\1.txt', '------------ APP');
  if not idfMailSend(EventLogApp, EventRecord, appE, 'App', typeEventEng) then exit;
  Send(EventRecord, typeEventEng);
end;

procedure Teventmail.OnEventReadSec(Sender: TObject; EventRecord: TFWEventLogRecord);
var
  typeEventEng: string;
begin                        
  FileLog('c:\1.txt', '------------ SEC');
  if not idfMailSend(EventLogSec, EventRecord, secE, 'Sec', typeEventEng) then exit;
  Send(EventRecord, typeEventEng);
end;

procedure Teventmail.OnEventReadSys(Sender: TObject; EventRecord: TFWEventLogRecord);
var
  typeEventEng: string;
begin
  FileLog('c:\1.txt', '------------ SYS');
  if not idfMailSend(EventLogSys, EventRecord, sysE, 'Sys', typeEventEng) then exit;
  Send(EventRecord, typeEventEng);
end;