Retrofitting Windows Event Log to a Delphi 5 app

后端 未结 4 1888
慢半拍i
慢半拍i 2021-01-01 04:56

I\'m looking for a (fairly pain-free) means of adding some Windows Application Event-Log support to a small legacy Delphi 5 application. We just want it to log when it start

4条回答
  •  旧时难觅i
    2021-01-01 05:50

    Summary: Writing to the Windows Event Log using Delphi


    If you are writing a Windows Service and need to write to the local machine's Windows Event Log then you can call TService.LogMessage as mentioned here.

    //TMyTestService = class(TService)
    
    procedure TMyTestService.ServiceStart(Sender: TService; var Started: Boolean);
    begin
      LogMessage('This is an error.');
      LogMessage('This is another error.', EVENTLOG_ERROR_TYPE);
      LogMessage('This is information.', EVENTLOG_INFORMATION_TYPE);
      LogMessage('This is a warning.', EVENTLOG_WARNING_TYPE);
    end;
    

    For any other type of applications you can use the SvcMgr.TEventLogger undocumented helper class for TService to write the the local machine's Windows Event Log as mentioned here, here and here.

    uses
      SvcMgr;
    
    procedure TForm1.EventLoggerExampleButtonClick(Sender: TObject);
    begin
      with TEventLogger.Create('My Test App Name') do
      begin
        try
          LogMessage('This is an error.');
          LogMessage('This is another error.', EVENTLOG_ERROR_TYPE);
          LogMessage('This is information.', EVENTLOG_INFORMATION_TYPE);
          LogMessage('This is a warning.', EVENTLOG_WARNING_TYPE);
        finally
          Free;
        end;
      end;
    end;
    

    You can also use the Windows API ReportEvent function as mentioned here and here.

    I've created a simple class to make it easier, it is available on GitHub.

    //----------------- EXAMPLE USAGE: ---------------------------------
    
    uses
      EventLog;
    
    procedure TForm1.EventLogExampleButtonClick(Sender: TObject);
    begin
      TEventLog.Source := 'My Test App Name';
    
      TEventLog.WriteError('This is an error.');
      TEventLog.WriteInfo('This is information.');
      TEventLog.WriteWarning('This is a warning.');
    end;
    
    //------------------------------------------------------------------
    
    
    unit EventLog;
    
    interface
    
    type
      TEventLog = class
      private
        class procedure CheckEventLogHandle;
        class procedure Write(AEntryType: Word; AEventId: Cardinal; AMessage: string); static;
      public
        class var Source: string;
        class destructor Destroy;
    
        class procedure WriteInfo(AMessage: string); static;
        class procedure WriteWarning(AMessage: string); static;
        class procedure WriteError(AMessage: string); static;
    
        class procedure AddEventSourceToRegistry; static;
      end;
    
    threadvar EventLogHandle: THandle;
    
    implementation
    
    uses Windows, Registry, SysUtils;
    
    class destructor TEventLog.Destroy;
    begin
      if EventLogHandle > 0 then
      begin
        DeregisterEventSource(EventLogHandle);
      end;
    end;
    
    class procedure TEventLog.WriteInfo(AMessage: string);
    begin
      Write(EVENTLOG_INFORMATION_TYPE, 2, AMessage);
    end;
    
    class procedure TEventLog.WriteWarning(AMessage: string);
    begin
      Write(EVENTLOG_WARNING_TYPE, 3, AMessage);
    end;
    
    class procedure TEventLog.WriteError(AMessage: string);
    begin
      Write(EVENTLOG_ERROR_TYPE, 4, AMessage);
    end;
    
    class procedure TEventLog.CheckEventLogHandle;
    begin
      if EventLogHandle = 0 then
      begin
       EventLogHandle := RegisterEventSource(nil, PChar(Source));
      end;
      if EventLogHandle <= 0 then
      begin
        raise Exception.Create('Could not obtain Event Log handle.');
      end;
    end;
    
    class procedure TEventLog.Write(AEntryType: Word; AEventId: Cardinal; AMessage: string);
    begin
      CheckEventLogHandle;
      ReportEvent(EventLogHandle, AEntryType, 0, AEventId, nil, 1, 0, @AMessage, nil);
    end;
    
    // This requires admin rights. Typically called once-off during the application's installation
    class procedure TEventLog.AddEventSourceToRegistry;
    var
      reg: TRegistry;
    begin
      reg := TRegistry.Create;
      try
        reg.RootKey := HKEY_LOCAL_MACHINE;
        if reg.OpenKey('\SYSTEM\CurrentControlSet\Services\Eventlog\Application\' + Source, True) then
        begin
          reg.WriteString('EventMessageFile', ParamStr(0)); // The application exe's path
          reg.WriteInteger('TypesSupported', 7);
          reg.CloseKey;
        end
        else
        begin
          raise Exception.Create('Error updating the registry. This action requires administrative rights.');
        end;
      finally
        reg.Free;
      end;
    end;
    
    initialization
    
    TEventLog.Source := 'My Application Name';
    
    end.
    

    ReportEvent supports writing a log entry to either a local or remote machine's Event Log. For a remote example see John Kaster's EDN article.


    Note that you would also have to create a message file and register your event source otherwise all your log messages will be starting with something like this:

    The description for Event ID xxx from source xxxx cannot be found. Either the component that raises this event is not installed on your local computer or the installation is corrupted. You can install or repair the component on the local computer.

    If the event originated on another computer, the display information had to be saved with the event.

    The following information was included with the event:

    1, For more information on how to create a message file see Finn Tolderlund's tutorial or Michael Hex's article or you can use an existing MC and RES file included in the GitHub project.

    2, Embed the RES file into your application by including the MessageFile.res in your DPR file. Alternatively you can create a dll for the messages.

    program MyTestApp;
    
    uses
      Forms,
      FormMain in 'FormMain.pas' {MainForm},
      EventLog in 'EventLog.pas';
    
    {$R *.res}
    {$R MessageFile\MessageFile.res}
    
    begin
      Application.Initialize;
    

    3, The once-off registration requires admin rights writing to the registry so it us usually done as part of your application's installation process.

    //For example
    AddEventSourceToRegistry('My Application Name', ParamStr(0));
    //or
    AddEventSourceToRegistry('My Application Name', 'C:\Program Files\MyApp\Messages.dll');
    
    //--------------------------------------------------
    
    procedure AddEventSourceToRegistry(ASource, AFilename: string);
    var
      reg: TRegistry;
    begin
      reg := TRegistry.Create;
      try
        reg.RootKey := HKEY_LOCAL_MACHINE;
        if reg.OpenKey('\SYSTEM\CurrentControlSet\Services\Eventlog\Application\' + ASource, True) then
        begin
          reg.WriteString('EventMessageFile', AFilename);
          reg.WriteInteger('TypesSupported', 7);
          reg.CloseKey;
        end
        else
        begin
          raise Exception.Create('Error updating the registry. This action requires administrative rights.');
        end;
      finally
        reg.Free;
      end;
    end;
    

    If you have need Windows event logging and other logging requirements you can also use logging frameworks such as log4d and TraceTool


    See here if you want to write to the Event Log window in the Delphi IDE.

提交回复
热议问题