Windows Ereignisnachrichten

[Gast]

Also ... mehr gibts nun wirklich nicht!

Ich erwarte die Nennung meines Nicks in der Aboutbox, sowie die Angabe meiner URL ( http://assarbad.net )! Ansonsten gelten die Bedingungen der BSDL

Delphi-Quellcode:

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;