Windows Log

uses registry; 

const 

  cCustomLog = 

   'System\CurrentControlSet\Services\EventLog\Custom'; 

type 

  pArray = ^tArray; 

  tArray = array[0..16383] of char; 

procedure TForm1.Write_MULTI_SZ_Strings(const valueName: 

  string; strings: TStrings); 

var 

  buffer: pArray; 

  i, size: integer; 

  TempKey: HKEY; 

begin 

  size := 0; 

  for i := 0 to strings.count - 1 do 

    size := size + length(strings) + 1; 

  inc(size); 

  GetMem (buffer, size); 

  fillchar(buffer^, 0, size); 

  try 

    size := 0; 

    for i := 0 to strings.count - 1 do begin 

      move(strings[1],buffer^[size],length(strings)); 

      inc(size, length(strings)+1); 

    end; 

    inc(size); 

    if RegOpenKeyEx(HKEY_LOCAL_MACHINE, cCustomLog, 

      0, KEY_WRITE, TempKey) = ERROR_SUCCESS then 

    try 

      if RegSetValueEx(TempKey, PChar(valueName), 

        0, REG_MULTI_SZ, buffer, size) <> ERROR_SUCCESS then 

        raise Exception.Create( 

          'Unable to write MULTI_SZ value'); 

    finally 

      RegCloseKey(TempKey); 

    end; 

  finally 

    FreeMem (buffer) 

  end 

end; 

procedure TForm1.Create_EventLog; 

var 

  size: integer; 

  s: string; 

  TempKey: HKEY; 

  fDisposition: pointer; 

  fStrings: TStringlist; 

begin 

  fDisposition := nil; 

  if RegOpenKeyEx(HKEY_LOCAL_MACHINE, cCustomLog, 

    0, KEY_READ, TempKey) <> ERROR_SUCCESS then begin 

      if RegCreateKeyEx(HKEY_LOCAL_MACHINE, cCustomLog, 

        0, nil, REG_OPTION_NON_VOLATILE, KEY_WRITE, nil, 

        TempKey, fDisposition) = ERROR_SUCCESS then begin 

        s := '%SystemRoot%\system32\elsx.dll'; 

        size := length(s); 

        RegSetValueEx (TempKey, 'DisplayNameFile', 

          0, REG_EXPAND_SZ, pchar(s), size); 

          // MessageTable string ID in elsx.dll 

          // Used by Event Viewer 

        size := 100; 

        RegSetValueEx (TempKey, 'DisplayNameID', 

          0, REG_DWORD, @size, sizeof(size)); 

        s := '%SystemRoot%\System32\config\CstEvent.Evt'; 

        size := length(s); 

        RegSetValueEx (TempKey, 'File', 0, REG_EXPAND_SZ, 

          pchar(s), size); 

        size := $80000; // 512kb maximum log file size 

          //$40000  =  256kb (262144) bytes 

        RegSetValueEx (TempKey, 'MaxSize', 0, REG_DWORD, 

          @size, sizeof(size)); 

        s := 'Custom'; 

        size := length(s); 

        RegSetValueEx (TempKey, 'PrimaryModule', 0, REG_SZ, 

          pchar(s), size); 

        // number of seconds to keep messages before 

        // automatically overwriting 

        // Overwrite messages 7 or more days old 

        size := 604800; 

          // 604800 = 60/secs * 60/mins * 24/hrs * 7/days 

          // $00000000 - means Overwrite as needed 

          // $ffffffff - means never Overwrite 

        RegSetValueEx (TempKey, 

          'Retention',0,REG_DWORD,@size, sizeof(size)); 

        RegCloseKey(TempKey); 

        fStrings := TStringlist.create; 

        // define a known message source 

        fStrings.add('UsgSoapServer'); 

        Write_MULTI_SZ_Strings('Sources', fStrings); 

        fStrings.free; 

        if RegCreateKeyEx(HKEY_LOCAL_MACHINE, 

          cCustomLog+'\UsgSoapServer', 

          0, nil, REG_OPTION_NON_VOLATILE, KEY_WRITE, 

          nil, TempKey, fDisposition) = ERROR_SUCCESS 

          then begin 

          s := '%SystemRoot%\system32\elsx.dll'; 

          size := length(s); 

          RegSetValueEx (TempKey, 'CategoryMessageFile', 0, 

            REG_EXPAND_SZ, pchar(s), size); 

          RegSetValueEx (TempKey, 'EventMessageFile', 0, 

            REG_EXPAND_SZ, pchar(s), size); 

          size := 4; 

          RegSetValueEx (TempKey, 'CategoryCount', 0, 

            REG_DWORD, @size, sizeof(size)); 

          size := 2; 

          RegSetValueEx (TempKey, 'TypesSupported', 0, 

            REG_DWORD, @size, sizeof(size)); 

          RegCloseKey(TempKey); 

        end; 

      end; 

    end 

  else 

    RegCloseKey(TempKey); 

end; 

procedure TForm1.Button1Click(Sender: TObject); 

begin 

  Create_EventLog; 

  // Log a event message just to prove that it works... 

  with TEventLogger.create('UsgSoapServer') do 

  try 

    LogMessage('Stop', EVENTLOG_SUCCESS, $02, $67); 

  finally 

    free; 

  end; 

end;