fpc/fcl/win32/eventlog.inc

{
    This file is part of the Free Pascal run time library.
    Copyright (c) 2003 by the Free Pascal development team

    Win32 implementation part of event logging facility.

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}

uses windows,registry;

Function TEventLog.DefaultFileName : String;

begin
  Result:=ChangeFileExt(Paramstr(0),'.log');
end;

Resourcestring
  SErrNoSysLog = 'Could not open system log (error %d)';
  SErrLogFailed = 'Failed to log entry (error %d)';

Procedure TEventLog.ActivateSystemLog;

begin
  CheckIdentification;
  FLogHandle := Pointer(OpenEventLog(Nil,Pchar(Identification)));
  If FLogHandle=Nil then
    Raise ELogError.CreateFmt(SErrNoSysLog,[GetLastError]);
end;

Procedure TEventLog.DeActivateSystemLog;

begin
  CloseEventLog(Cardinal(FLogHandle));
end;

{
function ReportEvent(hEventLog: THandle; wType, wCategory: Word;
  dwEventID: DWORD; lpUserSid: Pointer; wNumStrings: Word;
  dwDataSize: DWORD; lpStrings, lpRawData: Pointer): BOOL; stdcall;
}

procedure TEventLog.WriteSystemLog(EventType : TEventType; Msg : String);

Var
  P : PChar;
  I : Integer;
  FCategory : Word;
  FEventID : DWord;
  FEventType : Word;

begin
  FCategory:=MapTypeToCategory(EventType);
  FEventID:=MapTypeToEventID(EventType);
  FEventType:=MapTypeToEvent(EventType);
  P:=PChar(Msg);
  If Not ReportEvent(Cardinal(FLogHandle),FEventType,FCategory,FEventID,Nil,1,0,@P,Nil) then
    begin
    I:=GetLastError;
    Raise ELogError.CreateFmt(SErrLogFailed,[I]);
    end;
end;

Function TEventLog.RegisterMessageFile(AFileName : String) : Boolean;

Const
  SKeyEventLog = '\SYSTEM\CurrentControlSet\Services\EventLog\Application\%s';
  SKeyCategoryCount       = 'CategoryCount';
  SKeyEventMessageFile    = 'EventMessageFile';
  SKeyCategoryMessageFile = 'CategoryMessageFile';
  SKeyTypesSupported      = 'TypesSupported';

Var
  ELKey : String;
  R : TRegistry;

begin
  CheckIdentification;
  If AFileName='' then
    AFileName:=ParamStr(0);
  R:=TRegistry.Create;
  Try
    R.RootKey:=HKEY_LOCAL_MACHINE;
    ELKey:=Format(SKeyEventLog,[IDentification]);
    Result:=R.OpenKey(ELKey,True);
    If Result then
      try
        R.WriteInteger(SKeyCategoryCount,4);
        R.WriteString(SKeyCategoryMessageFile,AFileName);
        R.WriteString(SKeyEventMessageFile,AFileName);
        R.WriteInteger(SKeyTypesSupported,7);
      except
        Result:=False;
      end
  Finally
   R.Free;
  end;
end;

function TEventLog.MapTypeToCategory(EventType: TEventType): Word;
begin
  If (EventType=ETCustom) then
    DoGetCustomEventCategory(Result)
  else
    Result:=Ord(EventType);
  If Result=0 then
    Result:=1;
end;

function TEventLog.MapTypeToEventID(EventType: TEventType): DWord;

begin
  If (EventType=ETCustom) then
    DoGetCustomEventID(Result)
  else
    begin
    If (FEventIDOffset=0) then
      FEventIDOffset:=1000;
    Result:=FEventIDOffset+Ord(EventType);
    end;
end;

function TEventLog.MapTypeToEvent(EventType: TEventType): DWord;



Const
  EVENTLOG_SUCCESS=0;
  WinET : Array[TEventType] of word = (EVENTLOG_SUCCESS,
     EVENTLOG_INFORMATION_TYPE,
     EVENTLOG_WARNING_TYPE,EVENTLOG_ERROR_TYPE,
     EVENTLOG_AUDIT_SUCCESS);

begin
  If EventType=etCustom Then
    begin
    If CustomLogType=0 then
      CustomLogType:=EVENTLOG_SUCCESS;
    Result:=CustomLogType;
    DoGetCustomEvent(Result);
    end
  else
    Result:=WinET[EventType];
end;