home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 April / Chip_2002-04_cd1.bin / zkuste / delphi / kolekce / d56 / NT.ZIP / NTRegisterEventSource.pas < prev    next >
Pascal/Delphi Source File  |  1999-06-21  |  2KB  |  74 lines
  1. unit NTRegisterEventSource;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
  7.  
  8. type
  9.   TNTRegisterEventSource = class(TComponent)
  10.   private
  11.     { Private declarations }
  12.     FTypeFlags:Integer;
  13.     FFileName:String;
  14.     FCategory:String;
  15.     FServer:String;
  16.   protected
  17.     { Protected declarations }
  18.   public
  19.     { Public declarations }
  20.   published
  21.     { Published declarations }
  22.     property TypeFlags:Integer read FTypeFlags write FTypeFlags default 0;
  23.     property FileName:String read FFileName write FFileName;
  24.     property Category:String read FCategory write FCategory;
  25.     property Server:String read FServer write FServer;
  26.     function Execute:Boolean;
  27.   end;
  28.  
  29. procedure Register;
  30.  
  31. implementation
  32.  
  33. function TNTRegisterEventSource.Execute:Boolean;
  34. var
  35.    MyKey:HKEY;
  36.    dwData:DWORD;
  37.    AppPath:Array[0..250] Of Char;
  38. begin
  39.      // create key for this app in the event-log
  40.      If RegCreateKey(HKEY_LOCAL_MACHINE,PChar('SYSTEM\CurrentControlSet\Services\EventLog\' + FCategory + '\' + ExtractFileName(FFileName)),MyKey)<>ERROR_SUCCESS Then
  41.      Begin
  42.           Result:=False;
  43.           Exit;
  44.      End;
  45.  
  46.      // Set the Event ID message-file name
  47.      StrPCopy(AppPath,FFileName);
  48.  
  49.      // Add the Event ID message-file name to the subkey
  50.      If RegSetValueEx(MyKey,PChar('EventMessageFile'),0,REG_EXPAND_SZ,@AppPath,StrLen(AppPath)+ 1)<>ERROR_SUCCESS Then
  51.      Begin
  52.           Result:=False;
  53.           Exit;
  54.      End;
  55.  
  56.      // Set the supported types flags
  57.      dwData:=FTypeFlags;
  58.  
  59.      If RegSetValueEx(MyKey,PChar('TypesSupported'),0,REG_DWORD,@dwData,SizeOf(DWORD))<>ERROR_SUCCESS Then
  60.      Begin
  61.           Result:=False;
  62.           Exit;
  63.      End;
  64.      RegCloseKey(MyKey);
  65.      Result:=True;
  66. end;
  67.  
  68. procedure Register;
  69. begin
  70.   RegisterComponents('NT Tools - EventLog', [TNTRegisterEventSource]);
  71. end;
  72.  
  73. end.
  74.