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工程

具体代码如下：

[delphi] view
plaincopy

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.

[delphi] view
plaincopy

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.