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 plain copy

1. program SystemLog;  
2.   
3. uses  
4.   Vcl.SvcMgr,  
5.   ServerMain in 'ServerMain.pas' {SystemLogService: TService};  
6.   
7. {$R *.RES}  
8. {$R SystemLog.res}  
9.   
10. begin  
11.   // Windows 2003 Server requires StartServiceCtrlDispatcher to be  
12.   // called before CoRegisterClassObject, which can be called indirectly  
13.   // by Application.Initialize. TServiceApplication.DelayInitialize allows  
14.   // Application.Initialize to be called from TService.Main (after  
15.   // StartServiceCtrlDispatcher has been called).  
16.   //  
17.   // Delayed initialization of the Application object may affect  
18.   // events which then occur prior to initialization, such as  
19.   // TService.OnCreate. It is only recommended if the ServiceApplication  
20.   // registers a class object with OLE and is intended for use with  
21.   // Windows 2003 Server.  
22.   //  
23.   // Application.DelayInitialize := True;  
24.   //  
25.   if not Application.DelayInitialize or Application.Installing then  
26.     Application.Initialize;  
27.   Application.CreateForm(TSystemLogService, SystemLogService);  
28.   Application.Run;  
29. end.  

[delphi]  view plain copy

1. unit ServerMain;  
2.   
3. interface  
4.   
5. uses  
6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics,  
7.   Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs, Registry, Vcl.Forms;  
8.   
9. type  
10.   TSystemLogService = class(TService)  
11.     procedure ServiceStart(Sender: TService; var Started: Boolean);  
12.     procedure ServiceStop(Sender: TService;  var Stopped: Boolean);  
13.     procedure ServiceAfterInstall(Sender: TService);  
14.   private  
15.     procedure RegistryEventSource;  
16.     //如果是一般的应用程序，可以使用这个function来写入系统日志  
17.     procedure WriteSystemLog(Msg: string; EventType: Cardinal);  
18.   public  
19.     function GetServiceController: TServiceController; override;  
20.     constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;  
21.   end;  
22.   
23. var  
24.   SystemLogService: TSystemLogService;  
25.   
26. implementation  
27.   
28. {$R *.DFM}  
29.   
30. procedure ServiceController(CtrlCode: DWord); stdcall;  
31. begin  
32.   SystemLogService.Controller(CtrlCode);  
33. end;  
34.   
35. constructor TSystemLogService.CreateNew(AOwner: TComponent; Dummy: Integer);  
36. begin  
37.   inherited;  
38.   inherited CreateNew(AOwner, Dummy);  
39.   AllowPause := False;  
40.   Interactive := True;  
41.   OnStart := ServiceStart;  
42.   OnStop := ServiceStop;  
43. end;  
44.   
45. function TSystemLogService.GetServiceController: TServiceController;  
46. begin  
47.   Result := ServiceController;  
48. end;  
49.   
50. procedure TSystemLogService.RegistryEventSource;  
51. var  
52.   reg: TRegistry;  
53.   EventMessageFile: string;  
54.   TypesSupported: Integer;  
55. begin  
56.   reg := TRegistry.Create;  
57.   try  
58.     with reg do  
59.     begin  
60.       RootKey := HKEY_LOCAL_MACHINE;  
61.       try  
62.         if OpenKey('SYSTEM\CurrentControlSet\Services\EventLog\Application\' +  
63.           Self.Name, false) then  
64.         begin  
65.           Application.MessageBox('Event Source exists', 'hint',  
66.             MB_OK + MB_ICONERROR);  
67.           EventMessageFile := ReadString('EventMessageFile');  
68.           if LowerCase(EventMessageFile)<>LowerCase(Application.ExeName) then  
69.             WriteExpandString('EventMessageFile', Application.ExeName);  
70.           TypesSupported := ReadInteger('TypesSupported');  
71.           if TypesSupported<>7 then  
72.             WriteInteger('TypesSupported', 7);  
73.         end  
74.         else begin  
75.           reg.CreateKey('SYSTEM\CurrentControlSet\Services\EventLog\Application\' + Self.Name);  
76.           if OpenKey('SYSTEM\CurrentControlSet\Services\EventLog\Application\' +  
77.             Self.Name, false) then  
78.           begin  
79.             WriteExpandString('EventMessageFile', Application.ExeName);  
80.             reg.WriteInteger('TypesSupported', 7);  
81.           end;  
82.         end;  
83.       except  
84.         Application.MessageBox('Event Source Register Fail', 'Error',  
85.           MB_OK + MB_ICONERROR);  
86.       end;  
87.     end;  
88.   finally  
89.     Reg.CloseKey();  
90.     reg.Free;  
91.   end;  
92. end;  
93.   
94. procedure TSystemLogService.ServiceAfterInstall(Sender: TService);  
95. var  
96.   reg: TRegistry;  
97. begin  
98.   reg := TRegistry.Create;  
99.   try  
100.     with reg do  
101.     begin  
102.       RootKey := HKEY_LOCAL_MACHINE;  
103.       if OpenKey('SYSTEM\CurrentControlSet\Services\' + Self.Name, false) then  
104.       begin  
105.         WriteString('Description', 'Demo for write log to system log');  
106.       end;  
107.       CloseKey();  
108.     end;  
109.     RegistryEventSource;  
110.   finally  
111.     reg.Free;  
112.   end;  
113. end;  
114. procedure TSystemLogService.ServiceStart(Sender: TService; var Started: Boolean);  
115. begin  
116.   Started := False;  
117.   LogMessage('Service Start Success', EVENTLOG_INFORMATION_TYPE, 0, 1000);  
118.   Started := True;  
119. end;  
120.   
121. procedure TSystemLogService.ServiceStop(Sender: TService; var Stopped: Boolean);  
122. begin  
123.   Stopped := False;  
124.   LogMessage('Service Stop Success', EVENTLOG_INFORMATION_TYPE, 0, 1000);  
125.   Stopped := True;  
126. end;  
127.   
128. //如果是一般的应用程序，可以使用这个function来写入系统日志  
129. procedure TSystemLogService.WriteSystemLog(Msg: string; EventType: Cardinal);  
130. var  
131.   hEventSource: THandle;  
132. begin  
133.   hEventSource := RegisterEventSource(nil, PChar(Self.Name));  
134.   
135.   if hEventSource > 0 then  
136.   begin  
137.     case EventType of  
138.       EVENTLOG_INFORMATION_TYPE:  
139.       begin  
140.         //EventID：1000  在SystemLog.mc 定义的  
141.         ReportEvent(hEventSource, EVENTLOG_INFORMATION_TYPE, 0, 1000, nil,  
142.           2, 0, @Msg, nil);  
143.       end;  
144.       EVENTLOG_ERROR_TYPE:  
145.       begin  
146.         ReportEvent(hEventSource, EVENTLOG_ERROR_TYPE, 0, 1001, nil,  
147.           2, 0, @Msg, nil);  
148.       end;  
149.     end;  
150.   
151.     DeregisterEventSource(hEventSource);  
152.   end;  
153. end;  
154.   
155. end.