jvqnteventlog.pas

East make Tray Icon in delphi

      RaiseLastOSError;
  end
  else
  if FLastError <> ERROR_HANDLE_EOF then
    RaiseLastOSError;
end;

procedure TJvNTEventLog.SeekRecord(N: Cardinal);
var
  Offset, Flags: DWORD;
  BytesRead, BytesNeeded: Cardinal;
  Dummy: Char;
  RecNo: Integer;
begin
  GetOldestEventLogRecord(FLogHandle, Offset);
  RecNo := N + Offset;

  Flags := EVENTLOG_SEEK_READ;
  Flags := Flags or EVENTLOG_FORWARDS_READ;

  ReadEventLog(FLogHandle, Flags, RecNo, @Dummy, 0, BytesRead, BytesNeeded);
  FLastError := GetLastError;
  if FLastError = ERROR_INSUFFICIENT_BUFFER then
  begin
    ReallocMem(FEventRecord.FCurrentRecord, BytesNeeded);
    if not ReadEventLog(FLogHandle, Flags, RecNo, FEventRecord.FCurrentRecord, BytesNeeded, BytesRead, BytesNeeded) then
      RaiseLastOSError;
  end
  else
  if FLastError <> ERROR_HANDLE_EOF then
    RaiseLastOSError;
end;

procedure TJvNTEventLog.Seek(N: Cardinal);
begin
  if N <> FEventRecord.RecordNumber then
    SeekRecord(N);
end;

procedure TJvNTEventLog.ReadEventLogs(AStrings: TStrings);
begin
  with TRegistry.Create do
  begin
    AStrings.BeginUpdate;
    try
      RootKey := HKEY_LOCAL_MACHINE;
      OpenKey(cEventLogBaseKey, False);
      GetKeyNames(AStrings);
    finally
      Free;
      AStrings.EndUpdate;
    end;
  end;
end;

//=== { TNotifyChangeEventLog } ==============================================

constructor TNotifyChangeEventLog.Create(AOwner: TComponent);
begin
  inherited Create(True); // Create thread suspended
  FreeOnTerminate := True; // Thread Free Itself when terminated

  // initialize system events
  FEventLog := TJvNTEventLog(AOwner);
  FEventHandle := CreateEvent(nil, True, False, nil);
  NotifyChangeEventLog(FEventLog.FLogHandle, FEventHandle);

  Suspended := False; // Continue the thread
end;

procedure TNotifyChangeEventLog.DoChange;
begin
  if Assigned(FEventLog.FOnChange) then
    FEventLog.FOnChange(FEventLog);
end;

procedure TNotifyChangeEventLog.Execute;
var
  LResult: DWORD;
begin
  // (rom) secure thread against exceptions
  try
    while not Terminated do
    begin
      // reset event signal, so we can get it again
      ResetEvent(FEventHandle);
      // wait for event to happen
      LResult := WaitForSingleObject(FEventHandle, INFINITE);
      // check event Result
      case LResult of
        WAIT_OBJECT_0:
          Synchronize(DoChange);
      else
        Synchronize(DoChange);
      end;
    end;
  except
  end;
end;

//=== { TJvNTEventLogRecord } ================================================

constructor TJvNTEventLogRecord.Create(AOwner: TComponent);
begin
  // (rom) added inherited Create
  inherited Create;
  FEventLog := TJvNTEventLog(AOwner);
  FCurrentRecord := nil;
  FOwner := AOwner;
end;

function TJvNTEventLogRecord.GetRecordNumber: Cardinal;
begin
  Result := PEventLogRecord(FCurrentRecord)^.RecordNumber;
end;

function TJvNTEventLogRecord.GetMessageText: string;
var
  MessagePath: string;
  Count, I: Integer;
  P: PChar;
  Args, PArgs: ^PChar;
  St: string;

  function FormatMessageFrom(const DllName: string): Boolean;
  var
    DllModule: THandle;
    Buffer: array [0..2047] of Char;
    FullDLLName: array [0..MAX_PATH] of Char;
  begin
    Result := False;
    ExpandEnvironmentStrings(PChar(DllName), FullDLLName, MAX_PATH);
    DllModule := LoadLibraryEx(FullDLLName, 0, LOAD_LIBRARY_AS_DATAFILE);
    if DllModule <> 0 then
    try
      // (rom) memory leak fixed
      if FormatMessage(
        FORMAT_MESSAGE_FROM_HMODULE or FORMAT_MESSAGE_ARGUMENT_ARRAY,
        Pointer(DllModule), ID, 0, Buffer, SizeOf(Buffer), Args) > 0 then
      begin
        Buffer[StrLen(Buffer) - 2] := #0;
        St := Buffer;
        Result := True;
      end
    finally
      FreeLibrary(DllModule);
    end
  end;

begin
  St := '';
  Count := StringCount;
  GetMem(Args, Count * SizeOf(PChar));
  try
    PArgs := Args;
    P := PEventLogRecord(FCurrentRecord)^.StringOffset + PChar(FCurrentRecord);
    for I := 0 to Count - 1 do
    begin
      PArgs^ := P;
      Inc(P, lstrlen(P) + 1);
      Inc(PArgs);
    end;
    with TRegistry.Create do
    begin
      RootKey := HKEY_LOCAL_MACHINE;
      OpenKey(Format('%s\%s\%s', [cEventLogBaseKey, FEventLog.Log, Source]), False); {rw}
//      OpenKey(Format('SYSTEM\CurrentControlSet\Services\EventLog\%s\%s', [FEventLog.Log, FEventLog.Source]), False);
      MessagePath := ReadString('EventMessageFile');
      repeat
        I := Pos(';', MessagePath);
        if I <> 0 then
        begin
          if FormatMessageFrom(Copy(MessagePath, 1, I - 1 )) then {rw}
//          if FormatMessageFrom(Copy(MessagePath, 1, I)) then
            Break;
          MessagePath := Copy(MessagePath, I + 1, MaxInt); {rw}
//          MessagePath := Copy(MessagePath, I, MaxInt);
        end
        else
          FormatMessageFrom(MessagePath);
      until I = 0;
    end
  finally
    FreeMem(Args)
  end;
  Result := St;
end;

function TJvNTEventLogRecord.GetUsername: string;
var
  UserName: array [0..256] of Char;
  UserNameLen: Cardinal;
  DomainName: array [0..256] of Char;
  DomainNameLen: Cardinal;
  Use: SID_NAME_USE;

begin
  Result := '';
  UserNameLen := SizeOf(UserName);
  DomainNameLen := SizeOf(DomainName);
  if LookupAccountSID(nil, SID, UserName, UserNameLen, DomainName, DomainNameLen, Use) then
    Result := string(DomainName) + '\' + string(UserName);
end;

function TJvNTEventLogRecord.GetType: string;
begin
  case PEventLogRecord(FCurrentRecord)^.EventType of
    EVENTLOG_ERROR_TYPE:
      Result := RsLogError;
    EVENTLOG_WARNING_TYPE:
      Result := RsLogWarning;
    EVENTLOG_INFORMATION_TYPE:
      Result := RsLogInformation;
    EVENTLOG_AUDIT_SUCCESS:
      Result := RsLogSuccessAudit;
    EVENTLOG_AUDIT_FAILURE:
      Result := RsLogFailureAudit;
  else
    Result := '';
  end;
end;

function TJvNTEventLogRecord.GetSource: string;
begin
  Result := PChar(FCurrentRecord) + SizeOf(TEventLogRecord);
end;

function TJvNTEventLogRecord.GetComputer: string;
var
  P: PChar;
begin
  P := PChar(FCurrentRecord) + SizeOf(TEventLogRecord);
  Result := P + StrLen(P) + 1;
end;

function TJvNTEventLogRecord.GetID: DWORD;
begin
  Result := PEventLogRecord(FCurrentRecord)^.EventID;
end;

function TJvNTEventLogRecord.GetStringCount: DWORD;
begin
  Result := PEventLogRecord(FCurrentRecord)^.NumStrings;
end;

function TJvNTEventLogRecord.GetCategory: Cardinal;
begin
  Result := PEventLogRecord(FCurrentRecord)^.EventCategory;
end;

function TJvNTEventLogRecord.GetSID: PSID;
begin
  Result := PSID(PChar(FCurrentRecord) + PEventLogRecord(FCurrentRecord)^.UserSidOffset);
end;

function TJvNTEventLogRecord.GetString(Index: Cardinal): string;
var
  P: PChar;
begin
  Result := '';
  if Index < StringCount then
  begin
    P := PChar(FCurrentRecord) + PEventLogRecord(FCurrentRecord)^.StringOffset;
    while Index > 0 do
    begin
      Inc(P, StrLen(P) + 1);
      Dec(Index);
    end;
    Result := StrPas(P);
  end;
end;

function TJvNTEventLogRecord.GetDateTime: TDateTime;
const
  StartPoint: TDateTime = 25569.0; // January 1, 1970 00:00:00
begin
  // Result := IncSecond(StartPoint, PEventLogRecord(FCurrentRecord)^.TimeGenerated);
//  Result := IncSecond(StartPoint, PEventLogRecord(FCurrentRecord)^.TimeWritten);
  Result := ((StartPoint * 86400.0) + PEventLogRecord(FCurrentRecord)^.TimeWritten) / 86400.0;
end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQNTEventLog.pas,v $';
    Revision: '$Revision: 1.16 $';
    Date: '$Date: 2005/02/06 14:06:14 $';
    LogPath: 'JVCL\run'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.