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