Delphi-PRAXiS - Delphi Windows Ereignisnachrichten

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;