1、首先要写一个文本类型的消息文件,格式如下:
//==== 文件格式 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
具体代码如下:
- 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.