Здравствуйте, Hattori Hanzo!
К примеру, используя технологию WMI.

Приложение:
unit Main;interfaceuses Windows, ImgList, Controls, StdCtrls, Gauges, Graphics, ExtCtrls, Classes, ComCtrls, Forms, RunOnce, Utils, SysUtils, WbemScripting_TLB, Variants, ActiveX;type TfrmMain = class(TForm) lvEventsList: TListView; pnlBottom: TPanel; btnClose: TButton; btnRefresh: TButton; imlImageList: TImageList; imgAbout: TImage; cboLogs: TComboBox; prgGauge: TGauge; procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure btnCloseClick(Sender: TObject); procedure FormKeyPress(Sender: TObject; var Key: Char); procedure btnRefreshClick(Sender: TObject); procedure lvEventsListDblClick(Sender: TObject); procedure lvEventsListKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormShow(Sender: TObject); procedure cboLogsChange(Sender: TObject); private FMutex : TMutex; cboIndex : Integer; procedure ShowErrorMessage(Sender: TObject; E: Exception); procedure DoKeyPress(Sender: TObject; var Key: Char); function SelectLog: string; public FEventsList: TStringList; function ShowProp(SProp: ISWbemProperty): string; procedure ReadEventMessages(); procedure RefreshList(const SourceName: string); end; PEventLogRecord = ^TEventLogRecord; TEventLogRecord = class RecordNumber : Cardinal; _Type : string; EventType : Byte; TimeGenerated : TDateTime; SourceName : String; CategoryString : string; EventCode : Word; User : String; ComputerName : String; _Message : string; end;var frmMain: TfrmMain;implementationuses DescEvent;{$R *.DFM}var WbemLocator: TSWbemLocator; WbemService: ISWbemServices; WbemObject: ISWbemObject; WbemObjectSet: ISWbemObjectSet; WbemPropertySet: ISWbemPropertySet; WbemProperty: ISWbemProperty;procedure TfrmMain.ShowErrorMessage(Sender: TObject; E: Exception);begin Application.ShowException(E); Screen.Cursor := crDefault;end;function TfrmMain.ShowProp(SProp: ISWbemProperty): string;begin Result:= ‘‘; if VarIsNull(SProp.Get_Value) then Exit; case SProp.CIMType of wbemCimtypeUint8, wbemCimtypeUint16, wbemCimtypeUint32: Result:= IntToStr(SProp.Get_Value); wbemCimtypeString: Result:= SProp.Get_Value; wbemCimtypeDatetime: Result:= SProp.Get_Value; end;end;procedure TfrmMain.FormCreate(Sender: TObject);begin Screen.Cursor := crHourGlass; Caption := Application.Title ; FMutex := TMutex.Create(MUTEX_NAME); FEventsList := TStringList.Create; Application.OnException := ShowErrorMessage; Screen.Cursor := crDefault;end;procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);var i: Integer;begin AnimateWindow(WindowHandle, 500, AW_BLEND or AW_HIDE); FMutex.Release; FMutex.Free; if Assigned(FEventsList) then begin for i:=0 to FEventsList.Count-1 do TEventLogRecord(FEventsList.Objects[i]).Free; FEventsList.Free; end;end;procedure TfrmMain.btnCloseClick(Sender: TObject);begin Close;end;function StringToDateTime(Str: string): TDateTime;var TempStr, TimeStr, DateStr: string;begin Str:=Copy(Str,1,Pos(‘.‘,Str)-1); TimeStr:=Copy(Str,9,6); Insert(TimeSeparator,TimeStr,5); Insert(TimeSeparator,TimeStr,3); Insert(‘ ‘,TimeStr,1); DateStr:=Copy(Str,1,8); TempStr:=Copy(DateStr,7,2); DateStr:=Copy(DateStr,1,6); Insert(TempStr,DateStr,1); TempStr:=Copy(DateStr,7,2); DateStr:=Copy(DateStr,1,6); Insert(TempStr,DateStr,3); Insert(DateSeparator,DateStr,5); Insert(DateSeparator,DateStr,3); Result:=StrToDateTime(DateStr+TimeStr);end;procedure TfrmMain.ReadEventMessages();var Value: Cardinal; TempObj: OleVariant; Enum,PropEnum: IEnumVariant; EventLogRecord : TEventLogRecord; isBreak : boolean;begin FEventsList.BeginUpdate; FEventsList.Clear; FEventsList.EndUpdate; isBreak:=false; WbemLocator:=TSWbemLocator.Create(Self); WbemService:= WbemLocator.ConnectServer(‘.‘, ‘ROOT\CIMV2‘, ‘‘, ‘‘, ‘‘, ‘‘, 0 , nil); WbemObject:= WbemService.Get(‘Win32_NTLogEvent‘, wbemFlagUseAmendedQualifiers , nil); try WbemObjectSet:=WbemObject.Instances_(0 , nil); except on E: Exception do begin //Result:= ‘Error = ‘+E.Message; WbemObject:=nil; Exit; end; end; with prgGauge do begin MinValue := 0; MaxValue := WbemObjectSet.Count; Progress := 0; Visible := True; end; Enum:= (WbemObjectSet._NewEnum) as IEnumVariant; try while Enum.Next(1, TempObj, Value)=S_OK do begin WbemObject:= IUnknown(TempObj) as SWBemObject; WbemPropertySet:= WbemObject.Properties_; PropEnum:= (WbemPropertySet._NewEnum) as IEnumVariant; EventLogRecord := TEventLogRecord.Create; while (PropEnum.Next(1, TempObj, Value) = S_OK) do begin WbemProperty:= IUnknown(TempObj) as SWBemProperty; if WbemProperty.Name=‘Logfile‘ then if UpperCase(ShowProp(WbemProperty))<>cboLogs.Text then isBreak:=true; if WbemProperty.Name=‘EventType‘ then EventLogRecord.EventType := WbemProperty.Get_Value; //EVENT_TYPE if WbemProperty.Name=‘Type‘ then EventLogRecord._Type := ShowProp(WbemProperty); //TYPE if WbemProperty.Name=‘TimeGenerated‘ then EventLogRecord.TimeGenerated := StringToDateTime(WbemProperty.Get_Value); //EVENT_DATETIME_GENERATE if WbemProperty.Name=‘SourceName‘ then EventLogRecord.SourceName := ShowProp(WbemProperty); //EVENT_SOURCE if WbemProperty.Name=‘CategoryString‘ then EventLogRecord.CategoryString := ShowProp(WbemProperty); //EVENT_GATEGORY if WbemProperty.Name=‘EventCode‘ then EventLogRecord.EventCode := WbemProperty.Get_Value; //EVENT_ID if WbemProperty.Name=‘User‘ then EventLogRecord.User := ShowProp(WbemProperty); //EVENT_USER_NAME if WbemProperty.Name=‘ComputerName‘ then EventLogRecord.ComputerName :=ShowProp(WbemProperty); if WbemProperty.Name=‘Message‘ then EventLogRecord._Message :=ShowProp(WbemProperty); end; with FEventsList do begin prgGauge.AddProgress(1); Application.ProcessMessages; if not isBreak then AddObject(EventLogRecord._Type, TObject(EventLogRecord)); end; PropEnum:=nil; WbemProperty:=nil; WbemPropertySet:=nil; isBreak:=false; end; Enum:=nil; WbemObjectSet:=nil; WbemObject:=nil; finally prgGauge.Hide; end;end;procedure TfrmMain.RefreshList(const SourceName: string);var ListItem: TListItem; i: Integer;begin btnClose.Enabled := False; btnRefresh.Enabled := False; Self.Enabled := False; lvEventsList.Items.BeginUpdate; lvEventsList.Items.Clear; lvEventsList.Items.EndUpdate; Application.ProcessMessages; ReadEventMessages; if Assigned(FEventsList) then begin with lvEventsList do begin Items.BeginUpdate; ViewStyle := vsReport; for i:=0 to FEventsList.Count-1 do begin //======================================= ListItem := Items.Add; with ListItem.SubItems, TEventLogRecord(FEventsList.Objects[i]) do begin ListItem.Caption := FEventsList.Strings[i]; ListItem.ImageIndex := EventTypeToIndex(EventType); Add(DateToStr(TimeGenerated)); Add(TimeToStr(TimeGenerated)); Add(SourceName); Add(CategoryString); Add(IntToStr(EventCode)); Add(User); Add(ComputerName); ListItem.Data := TEventLogRecord(FEventsList.Objects[i]); end; //======================================= end; Items.EndUpdate; end; end; btnClose.Enabled := True; btnRefresh.Enabled := True; Self.Enabled := True;end;procedure TfrmMain.lvEventsListDblClick(Sender: TObject);const TabChar = #10; EnterChar = #13;var Description : String; TabPos : Integer; EnterPos : Integer;begin frmDescEvent := TfrmDescEvent.Create(Self); with frmDescEvent do try Description := TEventLogRecord(lvEventsList.Selected.Data)._Message; memDescription.Lines.Clear; if Length(Description) > 1 then begin while (Pos(TabChar, Description) > 0) or (Pos(EnterChar, Description) > 0) do begin TabPos := Pos(TabChar, Description); EnterPos:= Pos(EnterChar, Description); if EnterPos < TabPos then begin memDescription.Lines.Add(System.Copy(Description, 1, EnterPos-1)); System.Delete(Description, 1, EnterPos); if Description[1] = TabChar then System.Delete(Description, 1, 1); end else begin memDescription.Lines.Add(System.Copy(Description, 1, TabPos-1)); System.Delete(Description, 1, TabPos); end; end; end; ShowModal; finally Free; end;end;procedure TfrmMain.lvEventsListKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);begin if Key = VK_RETURN then lvEventsListDblClick(nil);end;procedure TfrmMain.DoKeyPress(Sender: TObject; var Key: Char);begin TForm(Sender).Close;end;procedure TfrmMain.FormKeyPress(Sender: TObject; var Key: Char);begin if Key = Chr(VK_ESCAPE) then Application.Minimize;end;function TfrmMain.SelectLog: string;begin Result := ‘SYSTEM‘; Case cboLogs.ItemIndex of 0: Result := ‘APPLICATION‘; 1: Result := ‘SECURITY‘; 2: Result := ‘SYSTEM‘; else Result := ‘SYSTEM‘; end;end;procedure TfrmMain.FormShow(Sender: TObject);begin cboLogs.ItemIndex := 2; cboIndex := cboLogs.ItemIndex; RefreshList(‘SYSTEM‘); if lvEventsList.Items.Count > 0 then lvEventsList.Selected := lvEventsList.Items[0];end;procedure TfrmMain.btnRefreshClick(Sender: TObject);begin RefreshList(SelectLog); if lvEventsList.Items.Count > 0 then lvEventsList.Selected := lvEventsList.Items[0];end;procedure TfrmMain.cboLogsChange(Sender: TObject);begin if cboLogs.ItemIndex <> cboIndex then begin btnRefreshClick(Sender); cboIndex := cboLogs.ItemIndex; end;end;end.