5 respuestas en este tema

[escafandra]

En cierta ocasión tuve que monitorizar el cambio en una clave del Registro de Windows para mantenerla como necesitaba, lo hice con una app sin GUI y en C, se me ha ocurrido compartirlo con vosotros en delphi con algunos cambios.

 

La unión de esto con lo publicado en Monitorizando el Shell sólo con la API nos permite hacer herramientas poderosas de monitorización

 

He escrito una unit basada en un Thread estilo VCL basado en la API RegNotifyChangeKeyValue, que notifica de los cambios en una determinada clave y con un determinado filtro. El resto del código es API pura. El hecho de usar un thread es porque bloquea el hilo principal de la app.

 

Esta es la unit:

delphi

unit RegMon;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes;
 
 
function MainKeyToStr(MainKey: HKEY): String;
 
const
  WM_REGCHANGED = WM_USER + 1;
 
  HKeys: array [0..8-1] of PCHAR = (
    'HKEY_CLASSES_ROOT',
    'HKEY_CURRENT_USER',
    'HKEY_LOCAL_MACHINE',
    'HKEY_USERS',
    'HKEY_PERFORMANCE_DATA',
    'HKEY_CURRENT_CONFIG',
    'HKEY_DYN_DATA',
    nil
  );
 
type
  TRegMon = class(TThread)
  private
    FWnd: HWND;
    FFilter: DWORD;
    FhMainKey: HKEY;
    FSubkey: String;
    hEvent: THANDLE;
  protected
    procedure Execute; override;
  public
    constructor Create(Wnd: HWND; hMainKey: HKEY; Subkey: String; Filter: DWORD);
    destructor  Destroy; override;
    procedure Terminate;
  end;
 
 
implementation
 
 
function MainKeyToStr(MainKey: HKEY): String;
begin
  Result:= HKeys[MainKey - $80000000];
end;
 
constructor TRegMon.Create(Wnd: HWND; hMainKey: HKEY; Subkey: String; Filter: DWORD);
begin
  FWnd:= Wnd;
  if Filter = 0 then
    Filter:= REG_NOTIFY_CHANGE_NAME or REG_NOTIFY_CHANGE_ATTRIBUTES or
             REG_NOTIFY_CHANGE_LAST_SET or REG_NOTIFY_CHANGE_SECURITY;
 
  FFilter:= Filter;
  FhMainKey:= hMainKey;
  FSubkey:= SubKey;
  hEvent:= CreateEvent(nil, FALSE, FALSE, nil);;
  FreeOnTerminate:= true;
  inherited Create(true);
end;
 
destructor TRegMon.Destroy;
begin
  SetEvent(hEvent);
  CloseHandle(hEvent);
  inherited;
end;
 
procedure TRegMon.Terminate;
begin
  inherited Terminate;
  SetEvent(hEvent);
end;
 
procedure TRegMon.Execute;
var
  Key: HKEY;
begin
  while not Terminated do
  begin
    if ERROR_SUCCESS = RegOpenKeyEx(FhMainKey, PCHAR(FSubkey), 0, KEY_NOTIFY, Key) then
    begin
      if hEvent <> 0 then
        if ERROR_SUCCESS = RegNotifyChangeKeyValue(Key, TRUE, FFilter, hEvent, TRUE) then
          if (WaitForSingleObject(hEvent, INFINITE) = WAIT_OBJECT_0) and not Terminated then
            PostMessage(FWnd, WM_REGCHANGED, FhMainKey, LongInt(PCHAR(FSubkey)));
      RegCloseKey(Key);
    end;
    Sleep(200);
  end;
end;
 
end.

Cuando se detecta un cambio en el registro, se envía un mensaje a la ventana que creó el hilo. No es posible especificar el cambio así que toca analizarlo al recibir el mensaje.

 

El thread se autodestruye al terminar (FreeOnTerminate:= true) con lo que no debe usarse Free.

 

 

Un ejemplo de uso sería este:

delphi

procedure TForm1.FormCreate(Sender: TObject);
var
  Filter: DWORD;
begin
  Filter:= REG_NOTIFY_CHANGE_NAME or
           REG_NOTIFY_CHANGE_ATTRIBUTES or
           REG_NOTIFY_CHANGE_LAST_SET or
           REG_NOTIFY_CHANGE_SECURITY;
 
  RegMon:= TRegMon.Create(Handle, HKEY_CURRENT_USER, 'Software\Prueba', Filter);
end;
 
procedure TForm1.RegMonMsg(var Msg : TMessage);
begin
  MessageBox(Handle, PCHAR('Se cambió ' + MainKeyToStr(Msg.WParam) + '\' + String(PCHAR(Msg.LParam))), 'RegMon', MB_ICONEXCLAMATION);
end;
 
procedure TForm1.StartClick(Sender: TObject);
begin
  RegMon.Resume;
end;
 
procedure TForm1.TerminateClick(Sender: TObject);
begin
  RegMon.Terminate;
end;

Subo el código y una pequeña app de ejemplo.

 

 

 

Saludos.

Archivos adjuntos

•  RegMon.rar   159,48KB   5 descargas

[sir.dev.a.lot]

Excelente @Escafandra.

 

Puedes modificarlo para usar un Arreglo de Strings en SubKeys, me gustaria hacer la monitorizacion para varias SubKeys.

 

Gracias de Antemano

Saludos!

[escafandra]

Excelente @Escafandra.

 

Puedes modificarlo para usar un Arreglo de Strings en SubKeys, me gustaria hacer la monitorizacion para varias SubKeys.

 

Gracias de Antemano

Saludos!

 

 

Para lo que dices no hace falta cambiarlo, sólo tienes que crear una instancia de TRegMon por cada subclave:

delphi

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, RegMon;
 
type
  TForm1 = class(TForm)
    Start: TButton;
    Terminate: TButton;
    procedure StartClick(Sender: TObject);
    procedure TerminateClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    RegMon1: TRegMon;
    RegMon2: TRegMon;
    procedure RegMonMsg(var Msg : TMessage); message WM_REGCHANGED;
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
var
  Filter: DWORD;
begin
  Filter:= REG_NOTIFY_CHANGE_NAME or
           REG_NOTIFY_CHANGE_ATTRIBUTES or
           REG_NOTIFY_CHANGE_LAST_SET or
           REG_NOTIFY_CHANGE_SECURITY;
 
  RegMon1:= TRegMon.Create(Handle, HKEY_CURRENT_USER, 'Software\Prueba1', Filter);
  RegMon2:= TRegMon.Create(Handle, HKEY_CURRENT_USER, 'Software\Prueba2', Filter);
end;
 
procedure TForm1.RegMonMsg(var Msg : TMessage);
begin
  MessageBox(Handle, PCHAR('Se cambió ' + MainKeyToStr(Msg.WParam) + '\' + String(PCHAR(Msg.LParam))), 'RegMon', MB_ICONEXCLAMATION);
end;
 
procedure TForm1.StartClick(Sender: TObject);
begin
  RegMon1.Resume;
  RegMon2.Resume;
end;
 
procedure TForm1.TerminateClick(Sender: TObject);
begin
  RegMon1.Terminate;
  RegMon2.Terminate;
end;
 
 
end.

RegMonMsg te dirá que clave se ha modificado.

 

 

Saludos.

[sir.dev.a.lot]

Gracias @Escafrandra..

 

Tengo la Idea, ya yo lo adaptare.

 

Teneis algo para Manejar Google Calendar y OutLook Calendar, sus APIs o algunos codigos utiles para Compartir, hechos en Delphi ?

 

Saludos!

[escafandra]

Si la cantidad de subclaves no es conocida, puedes hacer un TStringList con objetos TRegMon por cada string:

delphi

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, RegMon;
 
type
 
  TForm1 = class(TForm)
    Start: TButton;
    Terminate: TButton;
    procedure StartClick(Sender: TObject);
    procedure TerminateClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    List: TStringList;
    procedure RegMonMsg(var Msg : TMessage); message WM_REGCHANGED;
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
var
  Filter: DWORD;
  i: integer;
begin
  Filter:= REG_NOTIFY_CHANGE_NAME or
           REG_NOTIFY_CHANGE_ATTRIBUTES or
           REG_NOTIFY_CHANGE_LAST_SET or
           REG_NOTIFY_CHANGE_SECURITY;
 
  List:= TStringList.Create;
  List.Add('Software\Prueba1');
  List.Add('Software\Prueba2');
  //...................
  for i:= 0 to List.Count-1 do
    List.Objects[i]:= TRegMon.Create(Handle, HKEY_CURRENT_USER, List.Strings[i], Filter);
end;
 
procedure TForm1.RegMonMsg(var Msg : TMessage);
begin
  MessageBox(Handle, PCHAR('Se cambió ' + MainKeyToStr(Msg.WParam) + '\' + String(PCHAR(Msg.LParam))), 'RegMon', MB_ICONEXCLAMATION);
end;
 
procedure TForm1.StartClick(Sender: TObject);
var
  i: integer;
begin
  for i:= 0 to List.Count-1 do
    (List.Objects[i] as TRegMon).Resume;
end;
 
procedure TForm1.TerminateClick(Sender: TObject);
var
  i: integer;
begin
  for i:= 0 to List.Count-1 do
    (List.Objects[i] as TRegMon).Terminate;
end;
 
 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  TerminateClick(self);
end;
 
end.

Ten en cuenta que una vez terminado un monitor, se autodestruye.  Si no quieres ese comportamiento hay que ajustar en cada RegMon.FreeOnTerminate:= false; y destruirlos explícitamente.

 

 

Saludos.

[sir.dev.a.lot]

Gracias, Si algo asi es lo que queria..

U R a Lifesaver.

Saludos!