Перехват записи в памяти процесса по определённому адресу

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;


function AddVectoredExceptionHandler(FirstHandler: CARDINAL; VectoredHandler: POINTER): POINTER; stdcall; external 'Kernel32.dll' name 'AddVectoredExceptionHandler';


type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;




type
  PEXCEPTION_RECORD = ^EXCEPTION_RECORD;
  EXCEPTION_RECORD = packed record
                     ExceptionCode: DWORD;
                     ExceptionFlags: DWORD;
                     ExceptionRecord: PEXCEPTION_RECORD;
                     ExceptionAddress: POINTER;
                     NumberParameters: DWORD;
                     ExceptionInformation: ULONG_PTR ;
                     end;



type
  PEXCEPTION_POINTERS = ^EXCEPTION_POINTERS;
  EXCEPTION_POINTERS = packed record
                       ExceptionRecord: PEXCEPTION_RECORD;
                       ContextRecord: PCONTEXT;
                       end;




const
  CALL_LAST = 0;
  CALL_FIRST = 1;
  EXCEPTION_CONTINUE_SEARCH = $0;
  EXCEPTION_EXECUTE_HANDLER = $1;
  EXCEPTION_CONTINUE_EXECUTION = $FFFFFFFF;




var
  Form1: TForm1;
  SI: SYSTEM_INFO;
  MemAddr, MemAddr2: POINTER;
  lpflOldProtect, WriteEvent: CARDINAL;



implementation

{$R *.dfm}


   // ФУНКЦИЯ ПОТОКА ОЖИДАЮЩЕГО КОГДА ПРОИЗОЙДЁТ ЗАПИСЬ И ЗАПРЕЩАЮЩЕГО ЕЁ
function MyWaitThread(Data: POINTER): INTEGER; stdcall;
var
A: PAnsiString;
begin
   A := Data;
   repeat
   WaitForSingleObject(WriteEvent, INFINITE);
   Sleep(1);
   VirtualProtect(MemAddr, SI.dwPageSize, PAGE_READONLY, @lpflOldProtect);
   Form1.Memo1.Lines.Add(A^);
   Form1.Memo1.Lines.Add('Запись запрещена!');
   until 2 < 1;

end;



  // ОБРАБОТЧИК ИСКЛЮЧЕНИЙ ПОВЕРХ СИСТЕМНОГО
function MyVectoredHandler(ExceptionInfo: PEXCEPTION_POINTERS): INTEGER; stdcall;
begin
   if (ExceptionInfo.ExceptionRecord.ExceptionCode = EXCEPTION_ACCESS_VIOLATION) and (ExceptionInfo.ContextRecord.Eax = CARDINAL(MemAddr))then
   begin
      VirtualProtect(MemAddr, SI.dwPageSize, PAGE_READWRITE, @lpflOldProtect);
      SetEvent(WriteEvent);
      result := EXCEPTION_CONTINUE_EXECUTION;
      end
   else
   result := EXCEPTION_CONTINUE_SEARCH;
end;


 // КНОПКА ВЫЗЫВАЕТ ИСКЛЮЧЕНИЕ И ОНО ОБРАБАТЫВАЕТСЯ МОИМ ОБРАБОТЧИКОМ
procedure TForm1.Button1Click(Sender: TObject);
var
A: PAnsiString;
begin
   A := MemAddr;
   A^ := 'TeSt STRing';
end;


  // КНОПКА ВЫЗЫВАЕТ ИСКЛЮЧЕНИЕ,  НО МОЙ ОБРАБОТЧИК ЕГО НЕ ОБРАБАТЫВАЕТ
procedure TForm1.Button2Click(Sender: TObject);
var
A: PAnsiChar;
begin
   A := MemAddr2;  // Тут программа ведёт себя стандартно,  
   A^ := 'S';      // т.е. появляется сообщение  Access Violation
end;




procedure TForm1.FormCreate(Sender: TObject);
var
PrevHandler: POINTER;
HThread, TId: CARDINAL;
begin
   Memo1.Clear;
   GetSystemInfo(SI);
   MemAddr := NIL;
   MemAddr2 := NIL;
   MemAddr := VirtualAlloc(NIL, SI.dwPageSize * 10, MEM_COMMIT, PAGE_READONLY); // Выделение памяти только для чтения
   MemAddr2 := VirtualAlloc(NIL, SI.dwPageSize * 10, MEM_COMMIT, PAGE_READONLY); // Ещё
   if not Assigned(MemAddr) or not Assigned(MemAddr2) then ShowMessage('Ошибка при выделении памяти:  ' + IntToStr(GetLastError)) else
   begin

      WriteEvent := CreateEvent(NIL, FALSE, FALSE, 'Write');
      if WriteEvent = 0 then ShowMessage('Ошибка в создании объекта события:  ' + IntToStr(GetLastError));
      HThread := CreateThread(NIL, 0, Addr(MyWaitThread), MemAddr, 0, TId);
      if HThread = 0 then ShowMessage('Ошибка при создании потока:  ' + IntToStr(GetLastError));
       // Установка обработчика исключений
      PrevHandler := AddVectoredExceptionHandler(CALL_FIRST, Addr(MyVectoredHandler));
      if not Assigned(PrevHandler) then ShowMessage('Ошибка при установке обработчика исключений:  ' + IntToStr(GetLastError));

      Edit1.Text := IntToHex(CARDINAL(MemAddr), 8) + '   ' + IntToHex(CARDINAL(MemAddr2), 8);
      end;

end;



procedure TForm1.FormDestroy(Sender: TObject);
begin
   VirtualFree(MemAddr, SI.dwPageSize * 10, 0);
   VirtualFree(MemAddr2, SI.dwPageSize * 10, 0);
end;



end.