Ir al contenido


Foto

Monitorizando el registro de Windows


  • Por favor identifícate para responder
5 respuestas en este tema

#1 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4.107 mensajes
  • LocationMadrid - España

Escrito 04 diciembre 2016 - 10:54

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
  1. unit RegMon;
  2.  
  3. interface
  4.  
  5. uses
  6. Windows, Messages, SysUtils, Classes;
  7.  
  8.  
  9. function MainKeyToStr(MainKey: HKEY): String;
  10.  
  11. const
  12. WM_REGCHANGED = WM_USER + 1;
  13.  
  14. HKeys: array [0..8-1] of PCHAR = (
  15. 'HKEY_CLASSES_ROOT',
  16. 'HKEY_CURRENT_USER',
  17. 'HKEY_LOCAL_MACHINE',
  18. 'HKEY_USERS',
  19. 'HKEY_PERFORMANCE_DATA',
  20. 'HKEY_CURRENT_CONFIG',
  21. 'HKEY_DYN_DATA',
  22. nil
  23. );
  24.  
  25. type
  26. TRegMon = class(TThread)
  27. private
  28. FWnd: HWND;
  29. FFilter: DWORD;
  30. FhMainKey: HKEY;
  31. FSubkey: String;
  32. hEvent: THANDLE;
  33. protected
  34. procedure Execute; override;
  35. public
  36. constructor Create(Wnd: HWND; hMainKey: HKEY; Subkey: String; Filter: DWORD);
  37. destructor Destroy; override;
  38. procedure Terminate;
  39. end;
  40.  
  41.  
  42. implementation
  43.  
  44.  
  45. function MainKeyToStr(MainKey: HKEY): String;
  46. begin
  47. Result:= HKeys[MainKey - $80000000];
  48. end;
  49.  
  50. constructor TRegMon.Create(Wnd: HWND; hMainKey: HKEY; Subkey: String; Filter: DWORD);
  51. begin
  52. FWnd:= Wnd;
  53. if Filter = 0 then
  54. Filter:= REG_NOTIFY_CHANGE_NAME or REG_NOTIFY_CHANGE_ATTRIBUTES or
  55. REG_NOTIFY_CHANGE_LAST_SET or REG_NOTIFY_CHANGE_SECURITY;
  56.  
  57. FFilter:= Filter;
  58. FhMainKey:= hMainKey;
  59. FSubkey:= SubKey;
  60. hEvent:= CreateEvent(nil, FALSE, FALSE, nil);;
  61. FreeOnTerminate:= true;
  62. inherited Create(true);
  63. end;
  64.  
  65. destructor TRegMon.Destroy;
  66. begin
  67. SetEvent(hEvent);
  68. CloseHandle(hEvent);
  69. inherited;
  70. end;
  71.  
  72. procedure TRegMon.Terminate;
  73. begin
  74. inherited Terminate;
  75. SetEvent(hEvent);
  76. end;
  77.  
  78. procedure TRegMon.Execute;
  79. var
  80. Key: HKEY;
  81. begin
  82. while not Terminated do
  83. begin
  84. if ERROR_SUCCESS = RegOpenKeyEx(FhMainKey, PCHAR(FSubkey), 0, KEY_NOTIFY, Key) then
  85. begin
  86. if hEvent <> 0 then
  87. if ERROR_SUCCESS = RegNotifyChangeKeyValue(Key, TRUE, FFilter, hEvent, TRUE) then
  88. if (WaitForSingleObject(hEvent, INFINITE) = WAIT_OBJECT_0) and not Terminated then
  89. PostMessage(FWnd, WM_REGCHANGED, FhMainKey, LongInt(PCHAR(FSubkey)));
  90. RegCloseKey(Key);
  91. end;
  92. Sleep(200);
  93. end;
  94. end;
  95.  
  96. 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
  1. procedure TForm1.FormCreate(Sender: TObject);
  2. var
  3. Filter: DWORD;
  4. begin
  5. Filter:= REG_NOTIFY_CHANGE_NAME or
  6. REG_NOTIFY_CHANGE_ATTRIBUTES or
  7. REG_NOTIFY_CHANGE_LAST_SET or
  8. REG_NOTIFY_CHANGE_SECURITY;
  9.  
  10. RegMon:= TRegMon.Create(Handle, HKEY_CURRENT_USER, 'Software\Prueba', Filter);
  11. end;
  12.  
  13. procedure TForm1.RegMonMsg(var Msg : TMessage);
  14. begin
  15. MessageBox(Handle, PCHAR('Se cambió ' + MainKeyToStr(Msg.WParam) + '\' + String(PCHAR(Msg.LParam))), 'RegMon', MB_ICONEXCLAMATION);
  16. end;
  17.  
  18. procedure TForm1.StartClick(Sender: TObject);
  19. begin
  20. RegMon.Resume;
  21. end;
  22.  
  23. procedure TForm1.TerminateClick(Sender: TObject);
  24. begin
  25. RegMon.Terminate;
  26. end;

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

 

 

 

Saludos.

Archivos adjuntos


  • 2

#2 sir.dev.a.lot

sir.dev.a.lot

    Advanced Member

  • Miembros
  • PipPipPip
  • 545 mensajes
  • Location127.0.0.1

Escrito 10 diciembre 2016 - 05:31

Excelente @Escafandra.

 

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

 

Gracias de Antemano

Saludos!


  • 1

#3 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4.107 mensajes
  • LocationMadrid - España

Escrito 10 diciembre 2016 - 05:49

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
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7. Dialogs, StdCtrls, RegMon;
  8.  
  9. type
  10. TForm1 = class(TForm)
  11. Start: TButton;
  12. Terminate: TButton;
  13. procedure StartClick(Sender: TObject);
  14. procedure TerminateClick(Sender: TObject);
  15. procedure FormCreate(Sender: TObject);
  16. private
  17. RegMon1: TRegMon;
  18. RegMon2: TRegMon;
  19. procedure RegMonMsg(var Msg : TMessage); message WM_REGCHANGED;
  20. public
  21. { Public declarations }
  22. end;
  23.  
  24. var
  25. Form1: TForm1;
  26.  
  27. implementation
  28.  
  29. {$R *.dfm}
  30.  
  31. procedure TForm1.FormCreate(Sender: TObject);
  32. var
  33. Filter: DWORD;
  34. begin
  35. Filter:= REG_NOTIFY_CHANGE_NAME or
  36. REG_NOTIFY_CHANGE_ATTRIBUTES or
  37. REG_NOTIFY_CHANGE_LAST_SET or
  38. REG_NOTIFY_CHANGE_SECURITY;
  39.  
  40. RegMon1:= TRegMon.Create(Handle, HKEY_CURRENT_USER, 'Software\Prueba1', Filter);
  41. RegMon2:= TRegMon.Create(Handle, HKEY_CURRENT_USER, 'Software\Prueba2', Filter);
  42. end;
  43.  
  44. procedure TForm1.RegMonMsg(var Msg : TMessage);
  45. begin
  46. MessageBox(Handle, PCHAR('Se cambió ' + MainKeyToStr(Msg.WParam) + '\' + String(PCHAR(Msg.LParam))), 'RegMon', MB_ICONEXCLAMATION);
  47. end;
  48.  
  49. procedure TForm1.StartClick(Sender: TObject);
  50. begin
  51. RegMon1.Resume;
  52. RegMon2.Resume;
  53. end;
  54.  
  55. procedure TForm1.TerminateClick(Sender: TObject);
  56. begin
  57. RegMon1.Terminate;
  58. RegMon2.Terminate;
  59. end;
  60.  
  61.  
  62. end.

RegMonMsg te dirá que clave se ha modificado.

 

 

Saludos.


  • 1

#4 sir.dev.a.lot

sir.dev.a.lot

    Advanced Member

  • Miembros
  • PipPipPip
  • 545 mensajes
  • Location127.0.0.1

Escrito 10 diciembre 2016 - 06:07

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!


  • 1

#5 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4.107 mensajes
  • LocationMadrid - España

Escrito 11 diciembre 2016 - 10:31

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


delphi
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7. Dialogs, StdCtrls, RegMon;
  8.  
  9. type
  10.  
  11. TForm1 = class(TForm)
  12. Start: TButton;
  13. Terminate: TButton;
  14. procedure StartClick(Sender: TObject);
  15. procedure TerminateClick(Sender: TObject);
  16. procedure FormCreate(Sender: TObject);
  17. procedure FormClose(Sender: TObject; var Action: TCloseAction);
  18. private
  19. List: TStringList;
  20. procedure RegMonMsg(var Msg : TMessage); message WM_REGCHANGED;
  21. public
  22. { Public declarations }
  23. end;
  24.  
  25. var
  26. Form1: TForm1;
  27.  
  28. implementation
  29.  
  30. {$R *.dfm}
  31.  
  32. procedure TForm1.FormCreate(Sender: TObject);
  33. var
  34. Filter: DWORD;
  35. i: integer;
  36. begin
  37. Filter:= REG_NOTIFY_CHANGE_NAME or
  38. REG_NOTIFY_CHANGE_ATTRIBUTES or
  39. REG_NOTIFY_CHANGE_LAST_SET or
  40. REG_NOTIFY_CHANGE_SECURITY;
  41.  
  42. List:= TStringList.Create;
  43. List.Add('Software\Prueba1');
  44. List.Add('Software\Prueba2');
  45. //...................
  46. for i:= 0 to List.Count-1 do
  47. List.Objects[i]:= TRegMon.Create(Handle, HKEY_CURRENT_USER, List.Strings[i], Filter);
  48. end;
  49.  
  50. procedure TForm1.RegMonMsg(var Msg : TMessage);
  51. begin
  52. MessageBox(Handle, PCHAR('Se cambió ' + MainKeyToStr(Msg.WParam) + '\' + String(PCHAR(Msg.LParam))), 'RegMon', MB_ICONEXCLAMATION);
  53. end;
  54.  
  55. procedure TForm1.StartClick(Sender: TObject);
  56. var
  57. i: integer;
  58. begin
  59. for i:= 0 to List.Count-1 do
  60. (List.Objects[i] as TRegMon).Resume;
  61. end;
  62.  
  63. procedure TForm1.TerminateClick(Sender: TObject);
  64. var
  65. i: integer;
  66. begin
  67. for i:= 0 to List.Count-1 do
  68. (List.Objects[i] as TRegMon).Terminate;
  69. end;
  70.  
  71.  
  72. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  73. begin
  74. TerminateClick(self);
  75. end;
  76.  
  77. 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.


  • 1

#6 sir.dev.a.lot

sir.dev.a.lot

    Advanced Member

  • Miembros
  • PipPipPip
  • 545 mensajes
  • Location127.0.0.1

Escrito 11 diciembre 2016 - 12:29

Gracias, Si algo asi es lo que queria..

U R a Lifesaver.

Saludos!


  • 1




IP.Board spam blocked by CleanTalk.