Subversion Repositories simple_log_event

Rev

Rev 3 | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 daniel-mar 1 
unit ViaThinkSoftSimpleLogEvent_Impl;
2 
 
3 
{$WARN SYMBOL_PLATFORM OFF}
4 
 
5 
interface
6 
 
7 
uses
8 
  ComObj, ActiveX, ViaThinkSoftSimpleLogEvent_TLB, StdVcl;
9 
 
10 
type
11 
  TViaThinkSoftSimpleEventLog = class(TAutoObject, IViaThinkSoftSimpleEventLog)
12 
  protected
3 daniel-mar 13 
    procedure LogEvent(const SourceName: WideString; EventType: LogEventType; const LogMsg: WideString);
14 
          safecall;
6 daniel-mar 15 
    procedure LogSimulate(const SourceName: WideString; EventType: LogEventType; const LogMsg: WideString;
16 
          out Reason: OleVariant); safecall;
2 daniel-mar 17 
  end;
18 
 
19 
implementation
20 
 
6 daniel-mar 21 
uses ComServ, Windows, SysUtils;
2 daniel-mar 22 
 
23 
const
24 
  MSG_SUCCESS        = $20000000;
25 
  MSG_INFORMATIONAL  = $60000001;
26 
  MSG_WARNING        = $A0000002;
27 
  MSG_ERROR          = $E0000003;
28 
 
6 daniel-mar 29 
procedure WriteEventLog(AProvider: string; AEventType: word; AEventId: Cardinal; AEntry: string);
2 daniel-mar 30 
var
6 daniel-mar 31 
  EventLog: THandle;
2 daniel-mar 32 
  P: Pointer;
33 
begin
34 
  P := PChar(AEntry);
35 
  EventLog := RegisterEventSource(nil, PChar(AProvider));
6 daniel-mar 36 
  if EventLog = 0 then
37 
  begin
38 
    raise Exception.CreateFmt('RegisterEventSource failed with error code %d', [GetLastError]);
39 
  end;
2 daniel-mar 40 
  if EventLog <> 0 then
41 
  try
6 daniel-mar 42 
    if not ReportEvent(EventLog, // event log handle
2 daniel-mar 43 
          AEventType,     // event type
44 
          0,              // category zero
45 
          AEventId,       // event identifier
46 
          nil,            // no user security identifier
47 
          1,              // one substitution string
48 
          0,              // no data
49 
          @P,             // pointer to string array
6 daniel-mar 50 
          nil) then       // pointer to data
51 
    begin
52 
      raise Exception.CreateFmt('ReportEvent failed with error code %d', [GetLastError]);
53 
    end;
2 daniel-mar 54 
  finally
55 
    DeregisterEventSource(EventLog);
56 
  end;
57 
end;
58 
 
3 daniel-mar 59 
procedure TViaThinkSoftSimpleEventLog.LogEvent(const SourceName: WideString; EventType: LogEventType;
60 
          const LogMsg: WideString);
2 daniel-mar 61 
begin
62 
  case EventType of
3 daniel-mar 63 
    ViaThinkSoftSimpleLogEvent_TLB.Success:
64 
      WriteEventLog(SourceName, EVENTLOG_SUCCESS,          MSG_SUCCESS,       LogMsg);
65 
    ViaThinkSoftSimpleLogEvent_TLB.Informational:
66 
      WriteEventLog(SourceName, EVENTLOG_INFORMATION_TYPE, MSG_INFORMATIONAL, LogMsg);
67 
    ViaThinkSoftSimpleLogEvent_TLB.Warning:
68 
      WriteEventLog(SourceName, EVENTLOG_WARNING_TYPE,     MSG_WARNING,       LogMsg);
69 
    ViaThinkSoftSimpleLogEvent_TLB.Error:
70 
      WriteEventLog(SourceName, EVENTLOG_ERROR_TYPE,       MSG_ERROR,         LogMsg);
6 daniel-mar 71 
    else
72 
    begin
73 
      raise Exception.CreateFmt('ViaThinkSoftSimpleEventLog.LogEvent: Unexpected event type %d', [Ord(EventType)]);
74 
    end;
2 daniel-mar 75 
  end;
76 
end;
77 
 
6 daniel-mar 78 
procedure TViaThinkSoftSimpleEventLog.LogSimulate(const SourceName: WideString; EventType: LogEventType;
79 
          const LogMsg: WideString; out Reason: OleVariant);
80 
var
81 
  EventLog: THandle;
82 
begin
83 
  try
84 
    Reason := '';
85 
    if (EventType < 0) or (EventType > ViaThinkSoftSimpleLogEvent_TLB.Error) then
86 
    begin
87 
      Reason := Format('Unexpected event type %d', [Ord(EventType)]);
88 
      Exit;
89 
    end;
90 
 
91 
    EventLog := RegisterEventSource(nil, PChar(SourceName));
92 
    if EventLog = 0 then
93 
    begin
94 
      Reason := Format('RegisterEventSource failed with error code %d', [GetLastError]);
95 
      Exit;
96 
    end
97 
    else
98 
    begin
99 
      DeregisterEventSource(EventLog);
100 
    end;
101 
  except
102 
    on E: Exception do
103 
    begin
104 
      Reason := Format('Unexpected error: %s', [e.Message]);
105 
    end;
106 
  end;
107 
end;
108 
 
2 daniel-mar 109 
initialization
110 
  TAutoObjectFactory.Create(ComServer, TViaThinkSoftSimpleEventLog, Class_ViaThinkSoftSimpleEventLog,
111 
    ciMultiInstance, tmApartment);
112 
end.