Delphi应用程序日志写入系统日志

１、首先要写一个文本类型的消息文件，格式如下：
//==== 文件格式 SystemLog.mc=========
LanguageNames=(English=0x409:LicenseServer_en)
LanguageNames=(Chinese=0x411:LicenseServer_cn)
MessageId=1000
SymbolicName = EVMSG_INFORMATION
Language=English
CommomMessage：%1
.
LanguageNames=(Chinese=2052:MSG0052)
MessageId =1001
SymbolicName = EVMSG_INFORMATION
Language=English
ErrorMessage：%1
.
//=======================
说明:默认的语言是英语,此时"LanguageNames="那句可以省略;
%1，%2等表示从ReportEvent传来的参数;
如果使用中文，在文件最初定义
LanguageNames=((Chinese=0x411:LicenseServer_cn)//0x411为CodePage，LicenseServer_cn为定义文件名称（mc输出的.bin文件）。然后替换基本格式中的Language字段，如下Language=Chinese
文件必须以一个空行结束，即在最后一个信息定义块的 '.' 后加回车换行


2、使用mc编译此SystemLog.mc文件
① mc.exe是VC带的工具，路径参考：
C:\Program Files\Microsoft SDKs\windows\v6.0A\Bin
② 进dos，使用mc编译文件。如果你的项目使用UNICODE，如下：mc myevt.mc；否则必须加入命令选项：mc myevt.mc -A。将生成的三个文件SystemLog.rc SystemLog.h SystemLog.bin。


 3、把rc文件转化成res文件
brcc32 D:\PQXSource\SystemLog\Res\LicenseServerLog.rc


4、在注册表中添加事件源
HKEY_LOCAL_MACHINE
     SYSTEM
          CurrentControlSet
               Services
                    EventLog
                         Application

                              AppName

5、把res文件添加到Delphi工程

具体代码如下：

program SystemLog;

uses
  Vcl.SvcMgr,
  ServerMain in 'ServerMain.pas' {SystemLogService: TService};

{$R *.RES}
{$R SystemLog.res}

begin
  // Windows 2003 Server requires StartServiceCtrlDispatcher to be
  // called before CoRegisterClassObject, which can be called indirectly
  // by Application.Initialize. TServiceApplication.DelayInitialize allows
  // Application.Initialize to be called from TService.Main (after
  // StartServiceCtrlDispatcher has been called).
  //
  // Delayed initialization of the Application object may affect
  // events which then occur prior to initialization, such as
  // TService.OnCreate. It is only recommended if the ServiceApplication
  // registers a class object with OLE and is intended for use with
  // Windows 2003 Server.
  //
  // Application.DelayInitialize := True;
  //
  if not Application.DelayInitialize or Application.Installing then
    Application.Initialize;
  Application.CreateForm(TSystemLogService, SystemLogService);
  Application.Run;
end.

unit ServerMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs, Registry, Vcl.Forms;

type
  TSystemLogService = class(TService)
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService;  var Stopped: Boolean);
    procedure ServiceAfterInstall(Sender: TService);
  private
    procedure RegistryEventSource;
    //如果是一般的应用程序，可以使用这个function来写入系统日志
    procedure WriteSystemLog(Msg: string; EventType: Cardinal);
  public
    function GetServiceController: TServiceController; override;
    constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
  end;

var
  SystemLogService: TSystemLogService;

implementation

{$R *.DFM}

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

constructor TSystemLogService.CreateNew(AOwner: TComponent; Dummy: Integer);
begin
  inherited;
  inherited CreateNew(AOwner, Dummy);
  AllowPause := False;
  Interactive := True;
  OnStart := ServiceStart;
  OnStop := ServiceStop;
end;

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

procedure TSystemLogService.RegistryEventSource;
var
  reg: TRegistry;
  EventMessageFile: string;
  TypesSupported: Integer;
begin
  reg := TRegistry.Create;
  try
    with reg do
    begin
      RootKey := HKEY_LOCAL_MACHINE;
      try
        if OpenKey('SYSTEM\CurrentControlSet\Services\EventLog\Application\' +
          Self.Name, false) then
        begin
          Application.MessageBox('Event Source exists', 'hint',
            MB_OK + MB_ICONERROR);
          EventMessageFile := ReadString('EventMessageFile');
          if LowerCase(EventMessageFile)<>LowerCase(Application.ExeName) then
            WriteExpandString('EventMessageFile', Application.ExeName);
          TypesSupported := ReadInteger('TypesSupported');
          if TypesSupported<>7 then
            WriteInteger('TypesSupported', 7);
        end
        else begin
          reg.CreateKey('SYSTEM\CurrentControlSet\Services\EventLog\Application\' + Self.Name);
          if OpenKey('SYSTEM\CurrentControlSet\Services\EventLog\Application\' +
            Self.Name, false) then
          begin
            WriteExpandString('EventMessageFile', Application.ExeName);
            reg.WriteInteger('TypesSupported', 7);
          end;
        end;
      except
        Application.MessageBox('Event Source Register Fail', 'Error',
          MB_OK + MB_ICONERROR);
      end;
    end;
  finally
    Reg.CloseKey();
    reg.Free;
  end;
end;

procedure TSystemLogService.ServiceAfterInstall(Sender: TService);
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  try
    with reg do
    begin
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKey('SYSTEM\CurrentControlSet\Services\' + Self.Name, false) then
      begin
        WriteString('Description', 'Demo for write log to system log');
      end;
      CloseKey();
    end;
    RegistryEventSource;
  finally
    reg.Free;
  end;
end;
procedure TSystemLogService.ServiceStart(Sender: TService; var Started: Boolean);
begin
  Started := False;
  LogMessage('Service Start Success', EVENTLOG_INFORMATION_TYPE, 0, 1000);
  Started := True;
end;

procedure TSystemLogService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  Stopped := False;
  LogMessage('Service Stop Success', EVENTLOG_INFORMATION_TYPE, 0, 1000);
  Stopped := True;
end;

//如果是一般的应用程序，可以使用这个function来写入系统日志
procedure TSystemLogService.WriteSystemLog(Msg: string; EventType: Cardinal);
var
  hEventSource: THandle;
begin
  hEventSource := RegisterEventSource(nil, PChar(Self.Name));

  if hEventSource > 0 then
  begin
    case EventType of
      EVENTLOG_INFORMATION_TYPE:
      begin
        //EventID：1000  在SystemLog.mc 定义的
        ReportEvent(hEventSource, EVENTLOG_INFORMATION_TYPE, 0, 1000, nil,
          2, 0, @Msg, nil);
      end;
      EVENTLOG_ERROR_TYPE:
      begin
        ReportEvent(hEventSource, EVENTLOG_ERROR_TYPE, 0, 1001, nil,
          2, 0, @Msg, nil);
      end;
    end;

    DeregisterEventSource(hEventSource);
  end;
end;

end.

下载源代码：SystemLog.rar