(******************************************************************************
******************************************************************************
***                                                                        ***
***  Assa's EventLog Lister                                              ***
***  Version [1.00]                              {Last mod 2003-07-09}  ***
***                                                                        ***
******************************************************************************
******************************************************************************

                                _\\|//_
                                (` * * ')
______________________________ooO_(_)_Ooo_____________________________________
******************************************************************************
******************************************************************************
***                                                                        ***
***                Copyright (c) 1995 - 2003 by -=Assarbad=-              ***
***                                                                        ***
***  CONTACT TO THE AUTHOR(S):                                            ***
***    ____________________________________                                ***
***  |                                    |                              ***
***  | -=Assarbad=- aka Oliver            |                              ***
***  |____________________________________|                              ***
***  |                                    |                              ***
***  | [email]Assarbad@gmx.info|.net|.com|.de[/email]    |                              ***
***  | ICQ: 281645                        |                              ***
***  | AIM: nixlosheute                  |                              ***
***  |      nixahnungnicht                |                              ***
***  | MSN: [email]Assarbad@ePost.de[/email]            |                              ***
***  | YIM: sherlock_holmes_and_dr_watson |                              ***
***  |____________________________________|                              ***
***            ___                                                        ***
***            /  |                    ||              ||                ***
***          / _  |  ________ ___  ____||__    ___  __||                ***
***          / /_\ |  / __/ __//  |/  _/|  \  /  | /  |                ***
***        / ___  |__\\__\\  / /\ || |  | /\ \/ /\ |/ /\ | DOT NET        ***
***        /_/  \_/___/___/ /_____\|_|  |____/_____\\__/\|                ***
***      ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~        ***
***              [[url]http://assarbad.net[/url] | [url]http://assarbad.org][/url]              ***
***                                                                        ***
***  Notes:                                                              ***
***  - my first name is Oliver, you may well use this in your e-mails    ***
***  - for questions and/or proposals drop me a mail or instant message  ***
***                                                                        ***
***~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~***
***              May the source be with you, stranger ... ;)              ***
***    Snizhok, eto ne tolko fruktovij kefir, snizhok, eto stil zhizn.    ***
***                    Vsem Privet iz Germanij                            ***
***                                                                        ***
*** Greets from -=Assarbad=- fly to YOU =)                                ***
*** Special greets fly 2 Nico, Casper, SA, Pizza, Navarion, Eugen, Zhenja, ***
*** Xandros, Melkij, Strelok etc pp.                                      ***
***                                                                        ***
*** Thanks to:                                                            ***
*** W.A. Mozart, Vivaldi, Beethoven, Poeta Magica, Kurtzweyl, Manowar,    ***
*** Blind Guardian, Weltenbrand, In Extremo, Wolfsheim, Carl Orff, Zemfira ***
*** ... most of my work was done with their music in the background ;)    ***
***                                                                        ***
******************************************************************************
******************************************************************************

LEGAL STUFF:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Copyright (c) 1995-2003, -=Assarbad=- ["copyright holder(s)"]
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

1. Redistributions of source code must retain the above copyright notice, this
    list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright notice,
    this list of conditions and the following disclaimer in the documentation
    and/or other materials provided with the distribution.
3. The name(s) of the copyright holder(s) may not be used to endorse or
    promote products derived from this software without specific prior written
    permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY
DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                            .oooO    Oooo.
____________________________(  )_____(  )___________________________________
                              \ (      ) /
                              \_)    (_/

******************************************************************************)

program eventlog;
uses
  Windows;

{$INCLUDE .\Include\FormatString.pas}
{$APPTYPE CONSOLE}

const
  servicekey = 'SYSTEM\CurrentControlSet\Services\Eventlog';

const
// Defines for the READ flags for Eventlogging
  EVENTLOG_SEQUENTIAL_READ = $0001;
  EVENTLOG_SEEK_READ = $0002;
  EVENTLOG_FORWARDS_READ = $0004;
  EVENTLOG_BACKWARDS_READ = $0008;

// The types of events that can be logged.
  EVENTLOG_SUCCESS = $0000;
  EVENTLOG_ERROR_TYPE = $0001;
  EVENTLOG_WARNING_TYPE = $0002;
  EVENTLOG_INFORMATION_TYPE = $0004;
  EVENTLOG_AUDIT_SUCCESS = $0008;
  EVENTLOG_AUDIT_FAILURE = $0010;

// Defines for the WRITE flags used by Auditing for paired events
// These are not implemented in Product 1
  EVENTLOG_START_PAIRED_EVENT = $0001;
  EVENTLOG_END_PAIRED_EVENT = $0002;
  EVENTLOG_END_ALL_PAIRED_EVENTS = $0004;
  EVENTLOG_PAIRED_EVENT_ACTIVE = $0008;
  EVENTLOG_PAIRED_EVENT_INACTIVE = $0010;

type
//
// Structure that defines the header of the Eventlog record. This is the
// fixed-sized portion before all the variable-length strings, binary
// data and pad bytes.
//
// TimeGenerated is the time it was generated at the client.
// TimeWritten is the time it was put into the log at the server end.
//
  PEVENTLOGRECORD = ^EVENTLOGRECORD;
  EVENTLOGRECORD = packed record
    Length,
      Reserved,
      RecordNumber,
      TimeGenerated,
      TimeWritten,
      EventID: DWORD;
    EventType,
      NumStrings,
      EventCategory,
      ReservedFlags: Word;
    ClosingRecordNumber,
      StringOffset,
      UserSidLength,
      UserSidOffset,
      DataLength,
      DataOffset: DWORD;
  end;

function UnixTimeToFileTime(t: LongWord): FILETIME;
var ll: int64;
begin
  ll := (Int64(t) * 10000000) + int64(116444736000000000);
  result.dwLowDateTime := LongWord(ll);
  result.dwHighDateTime := ll shr 32;
end;

function GetDateString(ft: FILETIME): string;
var
  st: SYSTEMTIME;
begin
  FileTimeToSystemTime(ft, st);
  result := Format('%4.4d-%2.2d-%2.2d@%2.2d:%2.2d:%2.2d', [st.wYear, st.wMonth, st.wDay, st.wHour, st.wMinute, st.wSecond]);
end;

var
  idx: Integer;
  hReg: HKEY;
  needed, oldrec, numrecs, bufsize, err: DWORD;
  ft: FILETIME;
  namebuf: array[0..MAX_PATH] of char;
  log: THandle;
  elr: EVENTLOGRECORD;
  pelr: PEVENTLOGRECORD;
begin
  err := RegOpenKey(HKEY_LOCAL_MACHINE, servicekey, hReg);
  if err = ERROR_SUCCESS then
  try
    bufsize := sizeof(namebuf);
    ZeroMemory(@namebuf, bufsize);
    idx := 0;
    while RegEnumKeyEx(hReg, idx, @namebuf, bufsize, nil, nil, nil, @ft) = ERROR_SUCCESS do
    try
      log := OpenEventLog(nil, @namebuf);
      if GetNumberOfEventLogRecords(log, numrecs) then
        if GetOldestEventLogRecord(log, oldrec) then
          for err := oldrec to oldrec + numrecs - 1 do
            if not ReadEventLog(log, EVENTLOG_SEEK_READ or EVENTLOG_FORWARDS_READ, err, @elr, 0, bufsize, needed) then
              if GetLastError = ERROR_INSUFFICIENT_BUFFER then
              begin
                GetMem(pelr, needed);
                if Assigned(pelr) then
                try
                  if ReadEventLog(log, EVENTLOG_SEEK_READ or EVENTLOG_FORWARDS_READ, err, pelr, needed, bufsize, needed) then
                  begin
                    Writeln(Format('Record: %6.6d - EventID: %6.6d - EventType: %6.6d', [pelr^.RecordNumber, pelr^.EventID, pelr^.EventType]));
                    Writeln(' Logged : ',GetDateString(UnixTimeToFileTime(pelr^.TimeGenerated)),
                            ' Written: ',GetDateString(UnixTimeToFileTime(pelr^.TimeWritten)));
                  end;
                finally
                  FreeMem(pelr);
                end;
              end;
      bufsize := sizeof(namebuf);
      ZeroMemory(@namebuf, bufsize);
      inc(idx);
    finally
      CloseEventlog(log);
    end;
  finally
    RegCloseKey(hReg);
  end;
end.