Læse fra Event Loggen.

prøv den her :

unit cmpEventLog;

interface

uses
  Windows, SysUtils, Classes, ConTnrs;

type
  TCachedEvent = class
    fEvent: pointer;
    fEventLen: DWORD;

    constructor create(AEvent: pointer; aEventLen: DWORD);
    destructor Destroy; override;
  end;

  TWholeLogCallback = function(count: DWORD; param: DWORD): boolean;

  TSIDCacheItem = class
  private
    fSID: PSID;
    fAccount: string;
    fDomain: string;
    fUse: SID_NAME_USE;
  public
    constructor Create(ASID: PSID; const AAccount, ADomain: string; AUse: SID_NAME_USE);
    destructor Destroy; override;
  end;

  TSIDCache = class
  private
    fItems: TObjectList;
    fCacheLen: Integer;
  public
    constructor Create;
    destructor Destroy; override;
    function Lookup(SID: PSID; var Domain, Account: string; var use: SID_NAME_USE): boolean;
    property CacheLen: Integer read fCacheLen write fCacheLen;
  end;

  TNTEventLog = class(TComponent)
  private
    fHandle: THandle;
    fLog: string;
    fServer: string;
    fSource: string;
    fOpen: boolean;

    fReadBackwards: boolean;
    fCurrentRecordNo: Integer;
    fCurrentRecord: pointer;
    fCurrentRecordLen: DWORD;
    fCache: TStringList;
    fCacheSize: Integer;

    dllModule: THandle;
    lastDLLName: string;
    fSIDCache: TSIDCache;

    fComputerName: string;

    procedure SetServer(const value: string);
    procedure SetSource(const value: string);
    procedure SetLog(const value: string);
    procedure SetCacheSize(value: Integer);
    function GetEventCount: Integer;

    function GetEventSource: string;
    function GetEventComputer: string;
    function GetEventID: DWORD;
    function GetEventStringCount: DWORD;
    function GetEventSID: PSID;
    function GetEventString(index: Integer): string;
    function GetEventMessageText: string;
    function GetEventTime: TDateTime;

    procedure SeekRecord(n: Integer);
    function GetFromCache(n: Integer): boolean;
    procedure AddCurrentRecordToCache;
    function GetEventCategory: Integer;
    function GetEventType: Integer;
    function GetEventUser: string;

  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Open;
    procedure Close;
    procedure ClearCache;
    property EventCount: Integer read GetEventCount;
    procedure ReadEvent(n: Integer);

    property EventSource: string read GetEventSource;
    property EventComputer: string read GetEventComputer;
    property EventID: DWORD read GetEventID;
    property EventStringCount: DWORD read GetEventStringCount;
    property EventSID: PSID read GetEventSID;
    property EventUser: string read GetEventUser;
    property EventString[index: Integer]: string read GetEventString;
    property EventMessageText: string read GetEventMessageText;
    property EventTime: TDateTime read GetEventTime;
    procedure ReadWholeLog(log: TList; bufLen: DWORD; callback: TWholeLogCallback = nil; param: DWORD = 0);
    procedure SetFromCachedEvent(data: TCachedEvent);
    property EventCategory: Integer read GetEventCategory;
    property EventType: Integer read GetEventType;

  published
    property Server: string read fServer write SetServer;
    property Source: string read fSource write SetSource;
    property Log: string read fLog write SetLog;
    property CacheSize: Integer read fCacheSize write SetCacheSize default 64;
  end;

procedure Register;

implementation

uses Registry;

const
  EVENTLOG_SEQUENTIAL_READ = $0001;
  EVENTLOG_SEEK_READ = $0002;
  EVENTLOG_FORWARDS_READ = $0004;
  EVENTLOG_BACKWARDS_READ = $0008;

type
  TEventLogRecord = packed record
    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
    //
    // Then follow:
    //
    // WCHAR SourceName[]
    // WCHAR Computername[]
    // SID  UserSid
    // WCHAR Strings[]
    // BYTE  Data[]
    // CHAR  Pad[]
    // DWORD Length;
    //
  end;
  PEventLogRecord = ^TEventLogRecord;

procedure Register;
begin
  RegisterComponents('NT', [TNTEventLog]);
end;

constructor TNTEventLog.Create(AOwner: TComponent);
var
  cnLen: DWORD;
begin
  inherited Create(AOwner);
  fLog := 'Application';
  fSource := '';
  fCache := TStringList.Create;
  fCacheSize := 64;
  fCache.Capacity := fCacheSize;
  fSIDCache := TSIDCache.Create;

  cnLen := MAX_COMPUTERNAME_LENGTH + 1;
  SetLength(fComputerName, cnLen + 1);
  GetComputerName(PChar(fComputerName), cnLen);
  fComputerName := PChar(fComputerName);
end;

destructor TNTEventLog.Destroy;
begin
  if dllModule <> 0 then
    FreeLibrary(dllModule);
  Close;
  fCache.Free;
  fSIDCache.Free;
  inherited;
end;

procedure TNTEventLog.Open;
begin
  if not fOpen then
  begin
    fHandle := OpenEventLog(PChar(Server), PChar(Log));
    if fHandle = 0 then
      RaiseLastWin32Error;
    fOpen := True;
    fCurrentRecordNo := -2
  end
end;

procedure TNTEventLog.Close;
begin
  if fOpen then
  begin
    if fHandle <> 0 then
    begin
      CloseEventLog(fHandle);
      fHandle := 0
    end;
    ClearCache;
    ReallocMem(fCurrentRecord, 0);
    fOpen := False
  end
end;

procedure TNTEventLog.SetServer(const value: string);
var
  oldOpen: boolean;
begin
  if fServer <> value then
  begin
    oldOpen := fOpen;
    Close;
    fServer := value;
    if oldOpen then
      Open
  end
end;

procedure TNTEventLog.SetSource(const value: string);
var
  oldOpen: boolean;
begin
  if fSource <> value then
  begin
    oldOpen := fOpen;
    Close;
    fSource := value;
    if oldOpen then
      Open
  end
end;

procedure TNTEventLog.SetLog(const value: string);
var
  oldOpen: boolean;
begin
  if fLog <> value then
  begin
    oldOpen := fOpen;
    Close;
    fLog := value;
    if oldOpen then
      Open
  end
end;

function TNTEventLog.GetEventCount: Integer;
var
  count: DWORD;
begin
  if fOpen then
    GetNumberOfEventLogRecords(fHandle, count)
  else
    count := 0;

  result := Integer(count)
end;

function TNTEventLog.GetFromCache(n: Integer): boolean;
var
  idx: Integer;
  cachedEvent: TCachedEvent;
begin
  idx := fCache.IndexOf(IntToStr(n));
  if idx <> -1 then
  begin
    cachedEvent := TCachedEvent(fCache.Objects[idx]);
    ReallocMem(fCurrentRecord, cachedEvent.fEventLen);
    Move(cachedEvent.fEvent^, fCurrentRecord^, cachedEvent.fEventLen);
    fCurrentRecordNo := n;
    fCurrentRecordLen := cachedEvent.fEventLen;
    if idx > 0 then
    begin
      fCache.Delete(idx);
      fCache.InsertObject(0, IntToStr(n), cachedEvent)
    end;
    result := True
  end
  else
    result := False;
end;

procedure TNTEventLog.SeekRecord(n: Integer);
var
  offset, flags: DWORD;
  bytesRead, bytesNeeded: DWORD;
  dummy: char;
  recNo: Integer;

begin
  GetOldestEventLogRecord(fHandle, offset);
  recNo := n + Integer(offset);

  flags := EVENTLOG_SEEK_READ;
  if fReadBackwards then
    flags := flags or EVENTLOG_BACKWARDS_READ
  else
    flags := flags or EVENTLOG_FORWARDS_READ;

  ReadEventLog(fHandle, flags, recNo, @dummy, 0, bytesRead, bytesNeeded);
  if GetLastError = ERROR_INSUFFICIENT_BUFFER then
  begin
    ReallocMem(fCurrentRecord, bytesNeeded);
    if not ReadEventLog(fHandle, flags, recNo, fCurrentRecord, bytesNeeded, bytesRead, bytesNeeded) then
      RaiseLastWin32Error;
  end
  else
    RaiseLastWin32Error;
  fCurrentRecordLen := bytesRead;
  fCurrentRecordNo := n;
  AddCurrentRecordToCache;
end;

function TNTEventLog.GetEventMessageText: string;
var
  messagePath: string;
  count, i: Integer;
  p: Pchar;
  args, pArgs: ^PCHAR;
  st: string;

  function FormatMessageFrom(const dllName: string): boolean;
  var
    buffer: PChar;
    fullDLLName: array[0..MAX_PATH] of char;
  begin
    result := False;
    ExpandEnvironmentStrings(PChar(dllName), fullDllName, MAX_PATH);
    if lastdllName <> fullDLLName then
    begin
      if dllModule <> 0 then
        FreeLibrary(dllModule);
      dllModule := LoadLibraryEx(fullDLLName, 0, LOAD_LIBRARY_AS_DATAFILE);
      lastdllName := fullDLLName
    end;

    if dllModule <> 0 then
    try
      if FormatMessage(
        FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_HMODULE or FORMAT_MESSAGE_ARGUMENT_ARRAY,
        pointer(dllModule),
        EventID,
        0,
        PChar(@buffer),
        0,
        args) > 0 then
      begin
        st := buffer;
        LocalFree(THandle(buffer));

        result := True
      end
    finally
    end
  end;

begin
  st := '';
  count := EventStringCount;
  GetMem(args, count * sizeof(PChar));
  try
    pArgs := args;
    p := PEventLogRecord(fCurrentRecord)^.StringOffset + PChar(fCurrentRecord);
    for i := 0 to count - 1 do
    begin
      pArgs^ := p;
      Inc(p, lstrlen(p) + 1);
      Inc(pArgs)
    end;

    with TRegistry.Create do
    try
      RootKey := HKEY_LOCAL_MACHINE;
      OpenKey(Format('SYSTEM\CurrentControlSet\Services\EventLog\%s\%s', [Log, EventSource]), False);
      messagePath := ReadString('EventMessageFile');

      if messagePath = '' then
      begin
        st := 'Message not found.  Insertion strings:';
        for i := 0 to Count - 1 do
        begin
          st := st + EventString[i];
          if i < count - 1 then
            st := st + ', '
        end
      end
      else
        repeat
          i := Pos(';', MessagePath);
          if i <> 0 then
          begin
            if FormatMessageFrom(Copy(MessagePath, 1, i)) then
              break;
            MessagePath := Copy(MessagePath, i + 1, MaxInt);
          end
          else
            FormatMessageFrom(MessagePath)
        until i = 0
    finally
      Free
    end
  finally
    FreeMem(args)
  end;
  result := st
end;

procedure TNTEventLog.ReadEvent(n: Integer);
begin
  if (n <> fCurrentRecordNo) and (not GetFromCache(n)) then
    SeekRecord(n)
end;

function TNTEventLog.GetEventSource: string;
begin
  result := PChar(fCurrentRecord) + sizeof(TEventLogRecord);
end;

function TNTEventLog.GetEventComputer: string;
var
  p: PChar;
begin
  p := PChar(fCurrentRecord) + sizeof(TEventLogRecord);
  result := p + lstrlen(p) + 1;
end;

function TNTEventLog.GetEventID: DWORD;
begin
  result := PEventLogRecord(fCurrentRecord)^.EventID;
end;

function TNTEventLog.GetEventStringCount: DWORD;
begin
  result := PEventLogRecord(fCurrentRecord)^.NumStrings;
end;

function TNTEventLog.GetEventSID: PSID;
var
  rec: PEventLogRecord;
begin
  rec := PEventLogRecord(fCurrentRecord);
  if rec^.UserSidLength <> 0 then
    result := PSID(PChar(fCurrentRecord) + rec^.userSIDOffset)
  else
    result := nil;
end;

function TNTEventLog.GetEventString(index: Integer): string;
var
  p: PChar;
begin
  if index < Integer(EventStringCount) then
  begin
    p := PChar(fCurrentRecord) + PEventLogRecord(fCurrentRecord)^.StringOffset;
    while index > 0 do
    begin
      Inc(p, lstrlen(p) + 1);
      Dec(index);
    end;
    result := p
  end
  else
    result := ''
end;

(*----------------------------------------------------------------------------*
| function time_tToDateTime () : TDateTime                                  |
|                                                                            |
| Converts a C style time_t integer (seconds since 1/1/1970) to a Delphi    |
| TDateTime.                                                                |
*----------------------------------------------------------------------------*)

function TimeTToDateTime(t: Integer): TDateTime;
var
  sysTime, sysTime1: TSystemTime;

begin
  DateTimeToSystemTime(EncodeDate(1970, 1, 1) + (t / 86400), sysTime);
  SystemTimeToTzSpecificLocalTime(nil, sysTime, sysTime1);
  Result := SystemTimeToDateTime(sysTime1);
end;

function TNTEventLog.GetEventTime: TDateTime;
begin
  result := TimeTToDateTime(PEventLogRecord(fCurrentRecord)^.TimeGenerated);
end;

procedure TNTEventLog.ClearCache;
var
  i: Integer;
begin
  for i := 0 to fCache.Count - 1 do
    fCache.Objects[i].Free;

  fCache.Clear
end;

{ TCachedEvent }

constructor TCachedEvent.create(AEvent: pointer; aEventLen: DWORD);
begin
  fEventLen := AEventLen;
  ReallocMem(fEvent, fEventLen);
  if fEventLen > 0 then
    Move(AEvent^, fEvent^, fEventLen)
end;

destructor TCachedEvent.Destroy;
begin
  ReallocMem(fEvent, 0);
  inherited Destroy
end;

procedure TNTEventLog.AddCurrentRecordToCache;
begin
  if fCache.Count >= fCacheSize then
  begin
    fCache.Objects[fCacheSize - 1].Free;
    fCache.Delete(fCacheSize - 1)
  end;
  fCache.InsertObject(0, IntToStr(fCurrentRecordNo), TCachedEvent.Create(fCurrentRecord, fCurrentRecordLen))
end;

procedure TNTEventLog.SetCacheSize(value: Integer);
begin
  if value <> fCacheSize then
  begin
    ClearCache;
    fCacheSize := value;
    fCache.Capacity := value
  end
end;

procedure TNTEventLog.ReadWholeLog(log: TList; bufLen: DWORD; callback: TWholeLogCallback; param: DWORD);
var
  startRec, flags, l: DWORD;
  buffer: PChar;
  bytesRead, nr: DWORD;
  p: PEventLogRecord;
  e: TCachedEvent;
begin
  GetOldestEventLogRecord(fHandle, startRec);
  flags := EVENTLOG_SEEK_READ or EVENTLOG_FORWARDS_READ;

  GetMem(buffer, bufLen);
  log.Clear;
  try
    if Assigned(callback) then
      callback(log.Count, param);
    while ReadEventLog(fHandle, flags, startRec, buffer, bufLen, bytesRead, nr) do
    begin
      flags := EVENTLOG_SEQUENTIAL_READ or EVENTLOG_FORWARDS_READ;
      l := 0;

      while l < bytesRead do
      begin
        p := PEventLogRecord(buffer + l);
        e := TCachedEvent.Create(p, p^.Length);
        log.Add(e);
        Inc(l, p^.Length);
      end;
      if Assigned(callback) then
        if not callback(log.Count, param) then
          break;
    end
  finally
    FreeMem(buffer)
  end
end;

procedure TNTEventLog.SetFromCachedEvent(data: TCachedEvent);
begin
  ReallocMem(fCurrentRecord, data.fEventLen);
  Move(data.fEvent^, fCurrentRecord^, data.fEventLen);
  fCurrentRecordNo := -1;
  fCurrentRecordLen := data.fEventLen;
end;

function TNTEventLog.GetEventCategory: Integer;
begin
  result := PEventLogRecord(fCurrentRecord)^.EventCategory
end;

function TNTEventLog.GetEventType: Integer;
begin
  result := PEventLogRecord(fCurrentRecord)^.EventType;
end;

{ TSIDCache }

constructor TSIDCache.Create;
begin
  fItems := TObjectList.Create;
  fCacheLen := 30;
end;

destructor TSIDCache.Destroy;
begin
  fItems.Free;
  inherited;
end;

function TSIDCache.Lookup(SID: PSID; var Domain, Account: string;
  var use: SID_NAME_USE): boolean;
var
  item: TSidCacheItem;
  accountNameLen: DWORD;
  domainNameLen: DWORD;
  i, idx: Integer;

begin
  idx := -1;
  item := nil;
  for i := fItems.Count - 1 downto 0 do
    if EqualSid(SID, TSidCacheItem(fItems[i]).fSID) then
    begin
      idx := i;
      item := TSidCacheItem(fItems[i]);
      break
    end;

  if Assigned(item) then
  begin
    domain := Item.fDomain;
    account := Item.fAccount;
    use := item.fUse;
    result := True;
    if idx < fItems.Count - 1 then
    begin
      fItems.OwnsObjects := False;
      try
        fItems.Delete(idx);
        fItems.Add(item)
      finally
        fItems.OwnsObjects := True
      end
    end
  end
  else
  begin
    accountNameLen := 256;
    domainNameLen := 256;

    SetLength(Account, accountNameLen);
    SetLength(Domain, domainNameLen);

    result := LookupAccountSID('', Sid, PChar(Account), accountNameLen, PChar(Domain), domainNameLen, use);

    if result then
    begin
      Account := PChar(Account);
      Domain := PChar(Domain);
      item := TSidCacheItem.Create(sid, Account, Domain, Use);
      fItems.Add(item);
      if fItems.Count > fCacheLen then
        fItems.Delete(0);
    end
    else
    begin
      Account := '';
      Domain := '';
      use := SidTypeInvalid
    end
  end
end;

{ TSIDCacheItem }

constructor TSIDCacheItem.Create(ASID: PSID; const AAccount,
  ADomain: string; AUse: SID_NAME_USE);
var
  len: DWORD;
begin
  if not IsValidSID(ASID) then
    raise Exception.Create('Invalid SID');

  len := GetLengthSid(ASID);
  GetMem(fSID, len);
  Move(ASID^, fSID^, len);

  fAccount := AAccount;
  fDomain := ADomain;
  fUse := AUse
end;

destructor TSIDCacheItem.Destroy;
begin
  FreeMem(fSID);
  inherited;
end;

function TNTEventLog.GetEventUser: string;
var
  domain, account: string;
  use: SID_NAME_USE;
  sid: PSID;
begin
  sid := EventSID;
  if Assigned(sid) then
    if fSIDCache.Lookup(EventSID, domain, account, use) then
    begin
      if ((use = sidTypeUser) or (use = sidTypeGroup)) and (domain <> fComputerName) then
        result := domain + '\' + account
      else
        result := account;
    end
    else
      result := 'n/a'
  else
    result := '-';
end;

end.


Jens B

Hvis så du vil vide hvormange gange

Fax Service har skrevet i event loggen på "DANA's" maskine så brug det her :

var
  i: Integer;
begin
  NTEventLog := TNTEventLog.Create(Self);
  NTEventLog.Server := 'DANA';
  NTEventLog.Open;
  for i := NTEventLog.EventCount - 1 downto 0  do
  begin
    NTEventLog.ReadEvent(i);
    if NTEventLog.EventSource = 'Fax Service' then
      ListBox1.Items.Add(IntToStr(i));
  end;

end;


Jens B

Husk skal bu bruge EventID som Error code skal du lige gøre det følgende kunst greb :

var
  ErrCode : Integer;
begin
  ErrCode := NTEventLog.EventID shr 16 shl 16;
end;

Jens B
end;

*for tårer i øjnene*

det var jo lige det jeg skulle bruge. ;)
også efter 3 min. (nu har jeg også kun brugt 2 dage, på at få det til at virke).

takker mange gange.