Необходимо для получения уведомления об изменении атрибутов или содержимого указанного ключа реестра.
unit RegMonitorThread;
interface
uses
Classes, Windows, Messages, Registry, SysUtils;
const
WM_REGCHANGE = WM_USER + 1973;
{ Нужно переопределить функцию API -
вместо BOOL будем использовать DWORD. }
function RegNotifyChangeKeyValue(
hKey: HKEY; bWatchSubtree: DWORD; dwNotifyFilter: DWORD;
hEvent: THandle; fAsynchronus: DWORD): Longint; stdcall;
external 'advapi32.dll' name 'RegNotifyChangeKeyValue';
type
TChangeData = record
Key : string;
RootKey : HKey;
end;
TRegMonitorThread = class(TThread)
private
FReg: TRegistry;
FEvent: Integer;
fChangeData : TChangeData;
fKey: string;
fRootKey: HKey;
fWatchSub: boolean;
fFilter: integer;
fWnd: THandle;
procedure InitThread;
procedure SetFilter(const Value: integer);
function GetFilter: integer;
function GetChangeData: TChangeData;
public
constructor Create;
destructor Destroy; override;
property Key: string read fKey write fKey;
property RootKey: HKey read fRootKey write fRootKey;
property WatchSub: boolean read fWatchSub write fWatchSub;
property Filter: integer read GetFilter write SetFilter;
property Wnd: THandle read fWnd write fWnd;
property ChangeData : TChangeData read GetChangeData;
protected
procedure Execute; override;
end;
implementation
{ TRegMonitorThread }
constructor TRegMonitorThread.Create;
begin
// Execute не будет вызываться, только после Resume
inherited Create(True);
FReg := TRegistry.Create;
end;
destructor TRegMonitorThread.Destroy;
begin
FReg.Free;
inherited;
end;
procedure TRegMonitorThread.InitThread;
begin
FReg.RootKey := RootKey;
if not FReg.OpenKeyReadOnly(Key) then
begin
raise Exception.Create('Не могу открыть ключ реестра ' + Key);
end;
FEvent := CreateEvent(nil, True, False, 'RegMonitorChange');
RegNotifyChangeKeyValue(FReg.CurrentKey, 1, Filter, FEvent, 1);
end;
procedure TRegMonitorThread.Execute;
begin
InitThread;
while not Terminated do
begin
if WaitForSingleObject(FEvent, INFINITE) = WAIT_OBJECT_0 then
begin
fChangeData.RootKey := RootKey;
fChangeData.Key := Key;
SendMessage(Wnd, WM_REGCHANGE, RootKey, LongInt(PChar(Key)));
ResetEvent(FEvent);
RegNotifyChangeKeyValue(FReg.CurrentKey, 1, Filter, FEvent, 1);
end;
end;
end;
procedure TRegMonitorThread.SetFilter(const Value: integer);
begin
if fFilter <> Value then
begin
fFilter := Value;
end;
end;
function TRegMonitorThread.GetFilter: integer;
begin
if fFilter = 0 then begin
fFilter:=
REG_NOTIFY_CHANGE_NAME or
REG_NOTIFY_CHANGE_ATTRIBUTES or
REG_NOTIFY_CHANGE_LAST_SET or
REG_NOTIFY_CHANGE_SECURITY;
end;
Result := fFilter;
end;
function TRegMonitorThread.GetChangeData: TChangeData;
begin
Result := fChangeData;
end;
end.
Пример приложения:
Добавьте компонент TMemo (Memo1) на форму Delphi (Form1).
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls, RegMonitorThread;
type
TForm1 = class(TForm)
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
procedure WMREGCHANGE(
var Msg : TMessage); message WM_REGCHANGE;
public
{ Public declarations }
end;
var
Form1: TForm1;
RegMonitorThread : TRegMonitorThread;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
RegMonitorThread := TRegMonitorThread.Create;
with RegMonitorThread do
begin
FreeOnTerminate:=True;
Wnd := Form1.Handle;
Key := 'Software\ADP';
RootKey := HKEY_LOCAL_MACHINE;
WatchSub := True;
Resume;
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
RegMonitorThread.Terminate;
end;
procedure TForm1.WMREGCHANGE(var Msg: TMessage);
begin
Memo1.Lines.Add('-------------------------------------------');
Memo1.Lines.Add('Реестр был изменен ' + DateTimeToStr(Now));
Memo1.Lines.Add(IntToStr(RegMonitorThread.ChangeData.RootKey) +
' - ' + RegMonitorThread.ChangeData.Key);
end;
end.
|