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

创建系统日志服务

最新推荐文章于 2023-10-05 06:08:42 发布

转载最新推荐文章于 2023-10-05 06:08:42 发布 · 2.9k 阅读

Delphi 专栏收录该内容

20 篇文章

订阅专栏

本文介绍如何通过编写消息文件、编译资源文件并利用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.  