tpsystools_4.04/source/StNTLog.pas

// Upgraded to Delphi 2009: Sebastian Zierer

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* SysTools: StNTLog.pas 4.04                            *}
{*********************************************************}
{* SysTools: NT Event Logging                            *}
{*********************************************************}

{$I StDefine.inc}

unit StNTLog;

interface

uses
  Windows, SysUtils, Classes, Registry, StBase;

type

  TStNTEventType = (etSuccess, etError, etWarning, etInfo,
    etAuditSuccess, etAuditFailure);

  PStNTEventLogRec = ^TStNTEventLogRec;
  TStNTEventLogRec = record
    case Integer of
      0 : (Length              : DWORD;  { Length of full record }
           Reserved            : DWORD;  { Used by the service }
           RecordNumber        : DWORD;  { Absolute record number }
           TimeGenerated       : DWORD;  { Seconds since 1-1-1970 }
           TimeWritten         : DWORD;  { Seconds since 1-1-1970 }
           EventID             : DWORD;
           EventType           : WORD;
           NumStrings          : WORD;
           EventCategory       : WORD;
           ReservedFlags       : WORD;   { For use with paired events (auditing) }
           ClosingRecordNumber : DWORD;  { For use with paired events (auditing) }
           StringOffset        : DWORD;  { Offset from beginning of record }
           UserSidLength       : DWORD;
           UserSidOffset       : DWORD;
           DataLength          : DWORD;
           DataOffset          : DWORD); { Offset from beginning of record }

      1 : (VarData : array [0..65535] of Byte);

    //
    // Variable data may contain:
    //
    // WCHAR SourceName[]
    // WCHAR Computername[]
    // SID   UserSid
    // WCHAR Strings[]
    // BYTE  Data[]
    // CHAR  Pad[]
    // DWORD Length;
    //
    // Data is contained -after- the static data, the VarData field is set
    // to the beginning of the record merely to make the offsets match up.
  end;

  TStReadRecordEvent = procedure(Sender : TObject; const EventRec : TStNTEventLogRec;
    var Abort : Boolean) of object;

  TStNTEventLog = class(TStComponent)
  private
    { Internal use variables }
    elLogHandle : THandle;
    elLogList : TStringList;
    { Property variables }
    FComputerName : string;
    FEnabled : Boolean;
    FEventSource : string;
    FLogName : string;
    FOnReadRecord : TStReadRecordEvent;
  protected
    { Internal Methods }
    procedure elAddEntry(const EventType : TStNTEventType; EventCategory, EventID : DWORD;
      const Strings : TStrings; DataPtr : pointer; DataSize : DWORD);
    procedure elCloseLog;
    procedure elOpenLog;
    { Property Methods }
    function GetLogCount : DWORD;
    function GetLogs(Index : Integer) : string;
    function GetRecordCount : DWORD;
    procedure SetComputerName(const Value : string);
    procedure SetLogName(const Value : string);
  public
    { Public Methods }
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure AddEntry(const EventType : TStNTEventType; EventCategory, EventID : DWORD);
    procedure AddEntryEx(const EventType : TStNTEventType; EventCategory, EventID : DWORD;
      const Strings : TStrings; DataPtr : pointer; DataSize : DWORD);
    procedure ClearLog(const BackupName : TFileName);
    procedure CreateBackup(const BackupName : TFileName);
    procedure ReadLog(const Reverse : Boolean);
    procedure RefreshLogList;
    { Public Properties }
    property LogCount : DWORD read GetLogCount;
    property Logs[Index : Integer] : string read GetLogs;
    property RecordCount : DWORD read GetRecordCount;
  published
    { Published Properties }
    property ComputerName : string read FComputerName write SetComputerName;
    property Enabled : Boolean read FEnabled write FEnabled default True;
    property EventSource : string read FEventSource write FEventSource;
    property LogName : string read FLogName write SetLogName;
    property OnReadRecord : TStReadRecordEvent read FOnReadRecord write FOnReadRecord;
  end;

implementation

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;

  StEventLogKey = '\SYSTEM\CurrentControlSet\Services\EventLog';

  
{ Create instance of event log component }
constructor TStNTEventLog.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);

  { initialization }
  elLogHandle := 0;
  elLogList := TStringList.Create;
  FEnabled := True;
  FLogName := 'Application';

  { initialize log list }
  RefreshLogList;
end;

{ Destroy instance of event log component }
destructor TStNTEventLog.Destroy;
begin
  if elLogHandle <> 0 then elCloseLog;
  elLogList.Free;
  inherited;
end;

{ Add entry to the event log }
procedure TStNTEventLog.AddEntry(const EventType : TStNTEventType;
  EventCategory, EventID : DWORD);
begin
  elAddEntry(EventType, EventCategory, EventID, nil, nil, 0);
end;

{ Add entry to the event log - more options }
procedure TStNTEventLog.AddEntryEx(const EventType : TStNTEventType;
  EventCategory, EventID : DWORD; const Strings : TStrings;
  DataPtr : pointer; DataSize : DWORD);
begin
  elAddEntry(EventType, EventCategory, EventID, Strings, DataPtr, DataSize);
end;

{ Clear the event log }
procedure TStNTEventLog.ClearLog(const BackupName : TFileName);
begin
  elOpenLog;
  try
    ClearEventLog(elLogHandle, PChar(BackupName));
  finally
    elCloseLog;
  end;
end;

{ Back up the event log }
procedure TStNTEventLog.CreateBackup(const BackupName : TFileName);
begin
  elOpenLog;
  try
    BackupEventLog(elLogHandle, PChar(BackupName));
  finally
    elCloseLog;
  end;
end;

{ Adds an entry to the event log }
procedure TStNTEventLog.elAddEntry(const EventType : TStNTEventType;
  EventCategory, EventID : DWORD; const Strings : TStrings; DataPtr : pointer; DataSize : DWORD);
const
  StrArraySize = 1024;
var
  TempType, StrCount : DWORD;
  StrArray : array[0..StrArraySize-1] of PChar;
  StrArrayPtr : pointer;
  I : Integer;
begin
  StrArrayPtr := nil;

  case EventType of
    etSuccess : TempType := EVENTLOG_SUCCESS;
    etError : TempType := EVENTLOG_ERROR_TYPE;
    etWarning : TempType := EVENTLOG_WARNING_TYPE;
    etInfo : TempType := EVENTLOG_INFORMATION_TYPE;
    etAuditSuccess : TempType := EVENTLOG_AUDIT_SUCCESS;
    etAuditFailure : TempType := EVENTLOG_AUDIT_FAILURE;
  else
    TempType := 0;
  end;

  elOpenLog;
  try
    { Fill string array }
    if Assigned(Strings) then begin
      FillChar(StrArray, SizeOf(StrArray), #0);
      StrCount := Strings.Count;
      Assert(StrCount <= StrArraySize);
      for I := 0 to StrCount-1 do begin
        StrArray[I] := StrAlloc(Length(Strings[I]));
        StrPCopy(StrArray[I], Strings[I]);
      end;
      StrArrayPtr := @StrArray;
    end else begin
      StrCount := 0;
    end;
    ReportEvent(elLogHandle, TempType, EventCategory,
      EventID, nil, StrCount, DataSize, StrArrayPtr, DataPtr);
  finally
    { Release string array memory }
    for I := 0 to StrArraySize-1 do begin
      if StrArray[I] = nil then Break;
      StrDispose(StrArray[I]);
    end;
    elCloseLog;
  end;
end;

{ Close event log }
procedure TStNTEventLog.elCloseLog;
begin
  if elLogHandle <> 0 then begin
    CloseEventLog(elLogHandle);
    elLogHandle := 0;
  end;
end;

{ Open event log }
procedure TStNTEventLog.elOpenLog;
begin
  if elLogHandle = 0 then
    elLogHandle := OpenEventLog(PChar(FComputerName), PChar(FLogName));
end;

{ Get number on logs available on system }
function TStNTEventLog.GetLogCount : DWORD;
begin
  Result := elLogList.Count;
end;

{ Get name of logs }
function TStNTEventLog.GetLogs(Index : Integer) : string;
begin
  Result := elLogList[Index];
end;

{ Get number of log entries in event log }
function TStNTEventLog.GetRecordCount : DWORD;
begin
  elOpenLog;
  try
    GetNumberOfEventLogRecords(elLogHandle, Result);
  finally
    elCloseLog;
  end;
end;

{ Reads log until complete or aborted }
procedure TStNTEventLog.ReadLog(const Reverse : Boolean);
var
  ReadDir, BytesRead, BytesNeeded, LastErr : DWORD;
  RetVal, Aborted : Boolean;
  TempBuffer : array[0..2047] of Byte;
  TempPointer : Pointer;
  TempRecPtr : PStNTEventLogRec;  { used as an alias, don't actually allocate }
  FakeBuf : Byte;
begin
  Aborted := False;
  TempPointer := nil;

  { Set direction }
  if Reverse then
    ReadDir := EVENTLOG_SEQUENTIAL_READ or EVENTLOG_BACKWARDS_READ
  else
    ReadDir := EVENTLOG_SEQUENTIAL_READ or EVENTLOG_FORWARDS_READ;

  elOpenLog;
  try
    repeat
      { Fake read to determine required buffer size }
      RetVal := ReadEventLog(elLogHandle, ReadDir, 0, @FakeBuf,
        SizeOf(FakeBuf), BytesRead, BytesNeeded);

      if not RetVal then begin
        LastErr := GetLastError;
        if (LastErr = ERROR_INSUFFICIENT_BUFFER) then begin

          { We can use local buffer, which is faster }
          if (BytesNeeded <= SizeOf(TempBuffer)) then begin
            if not (ReadEventLog(elLogHandle, ReadDir, 0, @TempBuffer,
              BytesNeeded, BytesRead, BytesNeeded)) then
              {$WARNINGS OFF}  { Yeah, we know RaiseLastWin32Error is deprecated }
              RaiseLastWin32Error;
              {$WARNINGS ON}

            TempRecPtr := @TempBuffer

          { Local buffer too small, need to allocate a buffer on the heap }
          end else begin
            if TempPointer = nil then
              GetMem(TempPointer, BytesNeeded)
            else
              ReallocMem(TempPointer, BytesNeeded);

            if not (ReadEventLog(elLogHandle, ReadDir, 0, TempPointer,
              BytesNeeded, BytesRead, BytesNeeded)) then
              {$WARNINGS OFF}  { Yeah, we know RaiseLastWin32Error is deprecated }
              RaiseLastWin32Error;
              {$WARNINGS ON}

            TempRecPtr := TempPointer;

          end;

          { At this point, we should have the data -- fire the event }
          if Assigned(FOnReadRecord) then
            FOnReadRecord(Self, TempRecPtr^, Aborted);

        end else begin
          Aborted := True;

          { Handle unexpected error }
          {$WARNINGS OFF}  { Yeah, we know RaiseLastWin32Error is deprecated }
          if (LastErr <> ERROR_HANDLE_EOF) then
            RaiseLastWin32Error;
          {$WARNINGS ON}
        end;
      end;
    until Aborted;

  finally
    elCloseLog;

    if TempPointer = nil then
      FreeMem(TempPointer);
  end;
end;

{ Refreshes log list }
procedure TStNTEventLog.RefreshLogList;
var
  Reg : TRegistry;
begin
  elLogList.Clear;
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey(StEventLogKey, False) then begin
      Reg.GetKeyNames(elLogList);
      Reg.CloseKey;
    end;
  finally
    Reg.Free;
  end;
end;

{ Set log name }
procedure TStNTEventLog.SetLogName(const Value : string);
begin
  FLogName := Value
end;

{ Set computer name }
procedure TStNTEventLog.SetComputerName(const Value : string);
begin
  FComputerName := Value;
  RefreshLogList;
end;

end.
1	torben	2671	// Upgraded to Delphi 2009: Sebastian Zierer
2
3			(* *** BEGIN LICENSE BLOCK ***
4			* Version: MPL 1.1
5			*
6			* The contents of this file are subject to the Mozilla Public License Version
7			* 1.1 (the "License"); you may not use this file except in compliance with
8			* the License. You may obtain a copy of the License at
9			* http://www.mozilla.org/MPL/
10			*
11			* Software distributed under the License is distributed on an "AS IS" basis,
12			* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
13			* for the specific language governing rights and limitations under the
14			* License.
15			*
16			* The Original Code is TurboPower SysTools
17			*
18			* The Initial Developer of the Original Code is
19			* TurboPower Software
20			*
21			* Portions created by the Initial Developer are Copyright (C) 1996-2002
22			* the Initial Developer. All Rights Reserved.
23			*
24			* Contributor(s):
25			*
26			* *** END LICENSE BLOCK *** *)
27
28			{*********************************************************}
29			{* SysTools: StNTLog.pas 4.04 *}
30			{*********************************************************}
31			{* SysTools: NT Event Logging *}
32			{*********************************************************}
33
34			{$I StDefine.inc}
35
36			unit StNTLog;
37
38			interface
39
40			uses
41			Windows, SysUtils, Classes, Registry, StBase;
42
43			type
44
45			TStNTEventType = (etSuccess, etError, etWarning, etInfo,
46			etAuditSuccess, etAuditFailure);
47
48			PStNTEventLogRec = ^TStNTEventLogRec;
49			TStNTEventLogRec = record
50			case Integer of
51			0 : (Length : DWORD; { Length of full record }
52			Reserved : DWORD; { Used by the service }
53			RecordNumber : DWORD; { Absolute record number }
54			TimeGenerated : DWORD; { Seconds since 1-1-1970 }
55			TimeWritten : DWORD; { Seconds since 1-1-1970 }
56			EventID : DWORD;
57			EventType : WORD;
58			NumStrings : WORD;
59			EventCategory : WORD;
60			ReservedFlags : WORD; { For use with paired events (auditing) }
61			ClosingRecordNumber : DWORD; { For use with paired events (auditing) }
62			StringOffset : DWORD; { Offset from beginning of record }
63			UserSidLength : DWORD;
64			UserSidOffset : DWORD;
65			DataLength : DWORD;
66			DataOffset : DWORD); { Offset from beginning of record }
67
68			1 : (VarData : array [0..65535] of Byte);
69
70			//
71			// Variable data may contain:
72			//
73			// WCHAR SourceName[]
74			// WCHAR Computername[]
75			// SID UserSid
76			// WCHAR Strings[]
77			// BYTE Data[]
78			// CHAR Pad[]
79			// DWORD Length;
80			//
81			// Data is contained -after- the static data, the VarData field is set
82			// to the beginning of the record merely to make the offsets match up.
83			end;
84
85			TStReadRecordEvent = procedure(Sender : TObject; const EventRec : TStNTEventLogRec;
86			var Abort : Boolean) of object;
87
88			TStNTEventLog = class(TStComponent)
89			private
90			{ Internal use variables }
91			elLogHandle : THandle;
92			elLogList : TStringList;
93			{ Property variables }
94			FComputerName : string;
95			FEnabled : Boolean;
96			FEventSource : string;
97			FLogName : string;
98			FOnReadRecord : TStReadRecordEvent;
99			protected
100			{ Internal Methods }
101			procedure elAddEntry(const EventType : TStNTEventType; EventCategory, EventID : DWORD;
102			const Strings : TStrings; DataPtr : pointer; DataSize : DWORD);
103			procedure elCloseLog;
104			procedure elOpenLog;
105			{ Property Methods }
106			function GetLogCount : DWORD;
107			function GetLogs(Index : Integer) : string;
108			function GetRecordCount : DWORD;
109			procedure SetComputerName(const Value : string);
110			procedure SetLogName(const Value : string);
111			public
112			{ Public Methods }
113			constructor Create(AOwner : TComponent); override;
114			destructor Destroy; override;
115			procedure AddEntry(const EventType : TStNTEventType; EventCategory, EventID : DWORD);
116			procedure AddEntryEx(const EventType : TStNTEventType; EventCategory, EventID : DWORD;
117			const Strings : TStrings; DataPtr : pointer; DataSize : DWORD);
118			procedure ClearLog(const BackupName : TFileName);
119			procedure CreateBackup(const BackupName : TFileName);
120			procedure ReadLog(const Reverse : Boolean);
121			procedure RefreshLogList;
122			{ Public Properties }
123			property LogCount : DWORD read GetLogCount;
124			property Logs[Index : Integer] : string read GetLogs;
125			property RecordCount : DWORD read GetRecordCount;
126			published
127			{ Published Properties }
128			property ComputerName : string read FComputerName write SetComputerName;
129			property Enabled : Boolean read FEnabled write FEnabled default True;
130			property EventSource : string read FEventSource write FEventSource;
131			property LogName : string read FLogName write SetLogName;
132			property OnReadRecord : TStReadRecordEvent read FOnReadRecord write FOnReadRecord;
133			end;
134
135			implementation
136
137			const
138			{ Defines for the READ flags for Eventlogging }
139
140			EVENTLOG_SEQUENTIAL_READ = $0001;
141			EVENTLOG_SEEK_READ = $0002;
142			EVENTLOG_FORWARDS_READ = $0004;
143			EVENTLOG_BACKWARDS_READ = $0008;
144
145			{ The types of events that can be logged. }
146
147			EVENTLOG_SUCCESS = $0000;
148			EVENTLOG_ERROR_TYPE = $0001;
149			EVENTLOG_WARNING_TYPE = $0002;
150			EVENTLOG_INFORMATION_TYPE = $0004;
151			EVENTLOG_AUDIT_SUCCESS = $0008;
152			EVENTLOG_AUDIT_FAILURE = $0010;
153
154			{ Defines for the WRITE flags used by Auditing for paired events }
155			{ These are not implemented in Product 1 }
156
157			EVENTLOG_START_PAIRED_EVENT = $0001;
158			EVENTLOG_END_PAIRED_EVENT = $0002;
159			EVENTLOG_END_ALL_PAIRED_EVENTS = $0004;
160			EVENTLOG_PAIRED_EVENT_ACTIVE = $0008;
161			EVENTLOG_PAIRED_EVENT_INACTIVE = $0010;
162
163			StEventLogKey = '\SYSTEM\CurrentControlSet\Services\EventLog';
164
165
166			{ Create instance of event log component }
167			constructor TStNTEventLog.Create(AOwner : TComponent);
168			begin
169			inherited Create(AOwner);
170
171			{ initialization }
172			elLogHandle := 0;
173			elLogList := TStringList.Create;
174			FEnabled := True;
175			FLogName := 'Application';
176
177			{ initialize log list }
178			RefreshLogList;
179			end;
180
181			{ Destroy instance of event log component }
182			destructor TStNTEventLog.Destroy;
183			begin
184			if elLogHandle <> 0 then elCloseLog;
185			elLogList.Free;
186			inherited;
187			end;
188
189			{ Add entry to the event log }
190			procedure TStNTEventLog.AddEntry(const EventType : TStNTEventType;
191			EventCategory, EventID : DWORD);
192			begin
193			elAddEntry(EventType, EventCategory, EventID, nil, nil, 0);
194			end;
195
196			{ Add entry to the event log - more options }
197			procedure TStNTEventLog.AddEntryEx(const EventType : TStNTEventType;
198			EventCategory, EventID : DWORD; const Strings : TStrings;
199			DataPtr : pointer; DataSize : DWORD);
200			begin
201			elAddEntry(EventType, EventCategory, EventID, Strings, DataPtr, DataSize);
202			end;
203
204			{ Clear the event log }
205			procedure TStNTEventLog.ClearLog(const BackupName : TFileName);
206			begin
207			elOpenLog;
208			try
209			ClearEventLog(elLogHandle, PChar(BackupName));
210			finally
211			elCloseLog;
212			end;
213			end;
214
215			{ Back up the event log }
216			procedure TStNTEventLog.CreateBackup(const BackupName : TFileName);
217			begin
218			elOpenLog;
219			try
220			BackupEventLog(elLogHandle, PChar(BackupName));
221			finally
222			elCloseLog;
223			end;
224			end;
225
226			{ Adds an entry to the event log }
227			procedure TStNTEventLog.elAddEntry(const EventType : TStNTEventType;
228			EventCategory, EventID : DWORD; const Strings : TStrings; DataPtr : pointer; DataSize : DWORD);
229			const
230			StrArraySize = 1024;
231			var
232			TempType, StrCount : DWORD;
233			StrArray : array[0..StrArraySize-1] of PChar;
234			StrArrayPtr : pointer;
235			I : Integer;
236			begin
237			StrArrayPtr := nil;
238
239			case EventType of
240			etSuccess : TempType := EVENTLOG_SUCCESS;
241			etError : TempType := EVENTLOG_ERROR_TYPE;
242			etWarning : TempType := EVENTLOG_WARNING_TYPE;
243			etInfo : TempType := EVENTLOG_INFORMATION_TYPE;
244			etAuditSuccess : TempType := EVENTLOG_AUDIT_SUCCESS;
245			etAuditFailure : TempType := EVENTLOG_AUDIT_FAILURE;
246			else
247			TempType := 0;
248			end;
249
250			elOpenLog;
251			try
252			{ Fill string array }
253			if Assigned(Strings) then begin
254			FillChar(StrArray, SizeOf(StrArray), #0);
255			StrCount := Strings.Count;
256			Assert(StrCount <= StrArraySize);
257			for I := 0 to StrCount-1 do begin
258			StrArray[I] := StrAlloc(Length(Strings[I]));
259			StrPCopy(StrArray[I], Strings[I]);
260			end;
261			StrArrayPtr := @StrArray;
262			end else begin
263			StrCount := 0;
264			end;
265			ReportEvent(elLogHandle, TempType, EventCategory,
266			EventID, nil, StrCount, DataSize, StrArrayPtr, DataPtr);
267			finally
268			{ Release string array memory }
269			for I := 0 to StrArraySize-1 do begin
270			if StrArray[I] = nil then Break;
271			StrDispose(StrArray[I]);
272			end;
273			elCloseLog;
274			end;
275			end;
276
277			{ Close event log }
278			procedure TStNTEventLog.elCloseLog;
279			begin
280			if elLogHandle <> 0 then begin
281			CloseEventLog(elLogHandle);
282			elLogHandle := 0;
283			end;
284			end;
285
286			{ Open event log }
287			procedure TStNTEventLog.elOpenLog;
288			begin
289			if elLogHandle = 0 then
290			elLogHandle := OpenEventLog(PChar(FComputerName), PChar(FLogName));
291			end;
292
293			{ Get number on logs available on system }
294			function TStNTEventLog.GetLogCount : DWORD;
295			begin
296			Result := elLogList.Count;
297			end;
298
299			{ Get name of logs }
300			function TStNTEventLog.GetLogs(Index : Integer) : string;
301			begin
302			Result := elLogList[Index];
303			end;
304
305			{ Get number of log entries in event log }
306			function TStNTEventLog.GetRecordCount : DWORD;
307			begin
308			elOpenLog;
309			try
310			GetNumberOfEventLogRecords(elLogHandle, Result);
311			finally
312			elCloseLog;
313			end;
314			end;
315
316			{ Reads log until complete or aborted }
317			procedure TStNTEventLog.ReadLog(const Reverse : Boolean);
318			var
319			ReadDir, BytesRead, BytesNeeded, LastErr : DWORD;
320			RetVal, Aborted : Boolean;
321			TempBuffer : array[0..2047] of Byte;
322			TempPointer : Pointer;
323			TempRecPtr : PStNTEventLogRec; { used as an alias, don't actually allocate }
324			FakeBuf : Byte;
325			begin
326			Aborted := False;
327			TempPointer := nil;
328
329			{ Set direction }
330			if Reverse then
331			ReadDir := EVENTLOG_SEQUENTIAL_READ or EVENTLOG_BACKWARDS_READ
332			else
333			ReadDir := EVENTLOG_SEQUENTIAL_READ or EVENTLOG_FORWARDS_READ;
334
335			elOpenLog;
336			try
337			repeat
338			{ Fake read to determine required buffer size }
339			RetVal := ReadEventLog(elLogHandle, ReadDir, 0, @FakeBuf,
340			SizeOf(FakeBuf), BytesRead, BytesNeeded);
341
342			if not RetVal then begin
343			LastErr := GetLastError;
344			if (LastErr = ERROR_INSUFFICIENT_BUFFER) then begin
345
346			{ We can use local buffer, which is faster }
347			if (BytesNeeded <= SizeOf(TempBuffer)) then begin
348			if not (ReadEventLog(elLogHandle, ReadDir, 0, @TempBuffer,
349			BytesNeeded, BytesRead, BytesNeeded)) then
350			{$WARNINGS OFF} { Yeah, we know RaiseLastWin32Error is deprecated }
351			RaiseLastWin32Error;
352			{$WARNINGS ON}
353
354			TempRecPtr := @TempBuffer
355
356			{ Local buffer too small, need to allocate a buffer on the heap }
357			end else begin
358			if TempPointer = nil then
359			GetMem(TempPointer, BytesNeeded)
360			else
361			ReallocMem(TempPointer, BytesNeeded);
362
363			if not (ReadEventLog(elLogHandle, ReadDir, 0, TempPointer,
364			BytesNeeded, BytesRead, BytesNeeded)) then
365			{$WARNINGS OFF} { Yeah, we know RaiseLastWin32Error is deprecated }
366			RaiseLastWin32Error;
367			{$WARNINGS ON}
368
369			TempRecPtr := TempPointer;
370
371			end;
372
373			{ At this point, we should have the data -- fire the event }
374			if Assigned(FOnReadRecord) then
375			FOnReadRecord(Self, TempRecPtr^, Aborted);
376
377			end else begin
378			Aborted := True;
379
380			{ Handle unexpected error }
381			{$WARNINGS OFF} { Yeah, we know RaiseLastWin32Error is deprecated }
382			if (LastErr <> ERROR_HANDLE_EOF) then
383			RaiseLastWin32Error;
384			{$WARNINGS ON}
385			end;
386			end;
387			until Aborted;
388
389			finally
390			elCloseLog;
391
392			if TempPointer = nil then
393			FreeMem(TempPointer);
394			end;
395			end;
396
397			{ Refreshes log list }
398			procedure TStNTEventLog.RefreshLogList;
399			var
400			Reg : TRegistry;
401			begin
402			elLogList.Clear;
403			Reg := TRegistry.Create;
404			try
405			Reg.RootKey := HKEY_LOCAL_MACHINE;
406			if Reg.OpenKey(StEventLogKey, False) then begin
407			Reg.GetKeyNames(elLogList);
408			Reg.CloseKey;
409			end;
410			finally
411			Reg.Free;
412			end;
413			end;
414
415			{ Set log name }
416			procedure TStNTEventLog.SetLogName(const Value : string);
417			begin
418			FLogName := Value
419			end;
420
421			{ Set computer name }
422			procedure TStNTEventLog.SetComputerName(const Value : string);
423			begin
424			FComputerName := Value;
425			RefreshLogList;
426			end;
427
428			end.