1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:

function MonitorThread(lParam: PNotifyIconData): DWORD; stdcall;
var
  i: Integer;
  ret: DWORD;
begin
  ResetCounter;
  for i := 0 to idx - 1 do
    NotifyChangeEventLog(logs[i], events[i]);
  while True do
  begin
    ret := WaitForMultipleObjects(idx, @events, False, 1000);
    if ret <> WAIT_TIMEOUT then
    begin
      Blink := True;
      ModifyTrayIconText;
    end;
  end;
  result := 0;
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:

        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
          begin
            events[idx] := CreateEvent(nil, True, False, @Format(EventPrefix, [@namebuf])[1]);
            logs[idx] := OpenEventLog(nil, @namebuf);
            SetString(lognames[idx], PChar(@namebuf), lstrlen(@namebuf));
            bufsize := sizeof(namebuf);
            ZeroMemory(@namebuf, bufsize);
            inc(idx);
            if idx > maxlogs then
              Break;
          end;
        finally
          RegCloseKey(hReg);
        end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:

(******************************************************************************
 ******************************************************************************
 ***                                                                        ***
 ***   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            |                               ***
 ***   |____________________________________|                               ***
 ***   |                                    |                               ***
 ***   | Assarbad@gmx.info|.net|.com|.de    |                               ***
 ***   | ICQ: 281645                        |                               ***
 ***   | AIM: nixlosheute                   |                               ***
 ***   |      nixahnungnicht                |                               ***
 ***   | MSN: Assarbad@ePost.de             |                               ***
 ***   | YIM: sherlock_holmes_and_dr_watson |                               ***
 ***   |____________________________________|                               ***
 ***             ___                                                        ***
 ***            /   |                     ||              ||                ***
 ***           / _  |   ________ ___  ____||__    ___   __||                ***
 ***          / /_\ |  / __/ __//   |/  _/|   \  /   | /   |                ***
 ***         / ___  |__\\__\\  / /\ || |  | /\ \/ /\ |/ /\ | DOT NET        ***
 ***        /_/   \_/___/___/ /_____\|_|  |____/_____\\__/\|                ***
 ***       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~        ***
 ***              [http://assarbad.net | http://assarbad.org]               ***
 ***                                                                        ***
 ***   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.                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:

function GetEventIDText(EventID: DWORD; msgfile: string; pelr: PEVENTLOGRECORD): string;
type
  PVA_LIST = ^VA_LIST;
  VA_LIST = array[0..0] of Pointer;
var
  hLib: THandle;
  ret, flags, nSize: DWORD;
  ppc, pc, lpc: PChar;
  i: Integer;
//  pval: PVA_LIST;
begin
  result := '';
  flags := FORMAT_MESSAGE_FROM_HMODULE or
    FORMAT_MESSAGE_ALLOCATE_BUFFER or
    FORMAT_MESSAGE_ARGUMENT_ARRAY or
    FORMAT_MESSAGE_IGNORE_INSERTS;
  nSize := ExpandEnvironmentStrings(@msgfile[1], nil, 0) + 2;
  GetMem(pc, nSize);
  if Assigned(pc) then
  try
    ZeroMemory(pc, nSize);
    ExpandEnvironmentStrings(@msgfile[1], pc, nSize);
    for i := lstrlen(pc) - 1 downto 0 do
      if pc[i] = ';' then
        pc[i] := #0;
    lpc := pc;
    while lpc[0] <> #0 do
    begin
      hLib := LoadLibraryEx(lpc, 0, DONT_RESOLVE_DLL_REFERENCES);
      inc(lpc, lstrlen(lpc) + 1);
      if hLib <> 0 then
      try
        ret := FormatMessage(flags, Pointer(hLib), EventID, LANG_USER_DEFAULT, @ppc, 0, nil);
        if ((ret = 0) and (GetLastError = ERROR_MR_MID_NOT_FOUND) and (lpc[0] <> #0)) then
          Continue;
      finally
        FreeLibrary(hLib);
      end;
    end;
    if ret <> 0 then
      SetString(result, ppc, lstrlen(ppc));
    if Assigned(ppc) then
      LocalFree(THandle(ppc));
  finally
    Freemem(pc);
  end;
// TODO: insert the replacement strings!
end;

function GetEventRecordString(pelr: PEVENTLOGRECORD; el: PChar): MYEVENTLOGRECORD;
(*
  This function extracts the data from a EVENTLOGRECORD and the trailing data!
  "el" is the name of the Eventlog read. It is used to determine the event source.
*)
const
  elkey = 'SYSTEM\CurrentControlSet\Services\Eventlog\';
var
  ft: FILETIME;
  pc: PChar;
  uName,
    dName: array[0..MAX_PATH - 1] of Char;
  err, uSize, dSize, use: DWORD;
  key: HKEY;
  temps: string;
begin
// Fill record with zeroes
  ZeroMemory(@result, sizeof(result));
// Fill different members
  result.RecordNumber := pelr^.RecordNumber;
  result.EventID := pelr^.EventID;
// Convert unix type time format to local filetime
  ft := UnixTimeToFileTime(pelr^.TimeGenerated);
  FileTimeToLocalFileTime(ft, result.LocalTimeGenerated);
// ... twice
  ft := UnixTimeToFileTime(pelr^.TimeWritten);
  FileTimeToLocalFileTime(ft, result.LocalTimeWritten);
// Fill more members
  result.EventType := pelr^.EventType;
  result.EventCategory := pelr^.EventCategory;
// Check wether we need to copy data
  if pelr^.DataLength <> 0 then
  begin
    SetLength(result.Data, pelr^.DataLength);
// Copy the data into a string ... this might be more convenient to handle
    CopyMemory(@result.Data[1], PAdd(pelr, pelr^.DataOffset), pelr^.DataLength);
  end;
// Get event source name
  pc := PAdd(pelr, sizeof(pelr^));
  SetString(result.SourceName, pc, lstrlen(pc));
// Go to computer name ...
  inc(pc, lstrlen(pc) + 1);
  SetString(result.ComputerName, pc, lstrlen(pc));
  uSize := sizeof(uName);
  dSize := sizeof(dName);
// Is there a SID
  if pelr^.UserSidLength <> 0 then
// Yes, so look up its name ...
    if LookUpAccountSid(pc, PAdd(pelr, pelr^.UserSidOffset), uName, uSize, dName, dSize, use) then
// And set it
      result.UserName := Format('\\%s\%s', [@dName, @uName]);
// Use a temporary variable
  temps := elkey + string(el) + '\' + result.SourceName;
// Try to get the name for the library containing the message string
  err := RegOpenKey(HKEY_LOCAL_MACHINE, @temps[1], key);
  if err = ERROR_SUCCESS then
  try
    dSize := 0;
    RegQueryValueEx(key, 'EventMessageFile', nil, nil, nil, @dSize);
    begin
      GetMem(pc, dSize);
      if Assigned(pc) then
      try
        ZeroMemory(pc, dSize);
        if RegQueryValueEx(key, 'EventMessageFile', nil, nil, PByte(pc), @dSize) = ERROR_SUCCESS then
          SetString(result.SourceFile, pc, lstrlen(pc));
      finally
        FreeMem(pc);
      end;
    end;
  finally
    RegCloseKey(key);
  end;
// If we found a source file ...
  if result.SourceFile <> '' then
    result.MessageText := GetEventIDText(result.EventID, result.SourceFile, pelr);
end;