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	// 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.