Ловушка для мыши на Delphi

Нам нужно два проекта: один выполняет ловушку, затем уничтожает ее, второй - ловушка непосредственно (это может быть DLL), потому что это глобальная ловушка.

Код ловушки мыши (WH_MOUSE)

library MiddleButton;

uses
Windows, 
Messages;

const
MemMapFile = 'Igor_thief';
type
PDLLGlobal = ^TDLLGlobal;
TDLLGlobal = packed record
  HookHandle: HHOOK;
end;

var
GlobalData: PDLLGlobal;
MMF: THandle;

{$R *.res}

function HookProc(Code: integer; wParam: WPARAM;
        lParam: LPARAM): LRESULT; stdcall;
var
CurrWND: THandle;
begin
if Code < 0 then
begin
  Result := CallNextHookEx(GlobalData^.HookHandle,
            Code, wParam, lParam);
  exit;
end; // if

if (wParam = WM_NCMBUTTONDOWN) or (
      wParam = WM_MBUTTONDOWN) then
begin
  CurrWND := PMouseHookStruct(lParam)^.hwnd;
  CurrWND := GetAncestor(CurrWND, GA_ROOTOWNER);
  SendMessage(CurrWND, WM_SYSCOMMAND, SC_MINIMIZE, 0);
end; // if

Result := CallNextHookEx(GlobalData^.HookHandle,
      Code, wParam, lParam);
end;

procedure CreateGlobalHeap;
begin
MMF:= CreateFileMapping(INVALID_HANDLE_VALUE, nil,
    PAGE_READWRITE, 0, 
    SizeOf(TDLLGlobal), MemMapFile);

if MMF = 0 then begin
  MessageBox(0, 'CreateFileMapping -', '', 0);
  exit;
end;

GlobalData:= MapViewOfFile(MMF, FILE_MAP_ALL_ACCESS, 0, 0,
       SizeOf(TDLLGlobal));
if GlobalData = nil then begin
// не смогди создать отображение
  CloseHandle(MMF);
  MessageBox(0, 'MapViewOfFile -', '', 0);
end;
end;

procedure DeleteGlobalHeap;
begin
if GlobalData <> nil then
  UnmapViewOfFile(GlobalData);

if MMF <> INVALID_HANDLE_VALUE then
  CloseHandle(MMF);
end;

procedure RunHook; stdcall;
begin
GlobalData^.HookHandle:= SetWindowsHookEx(WH_MOUSE,
      @HookProc, HInstance, 0);
if GlobalData^.HookHandle = INVALID_HANDLE_VALUE then
begin
  MessageBox(0, 'Error :)' , '' , MB_OK);
  Exit;
end;
end;

procedure KillHook; stdcall;
begin
if (GlobalData <> nil) and (GlobalData^.HookHandle <>
        INVALID_HANDLE_VALUE) then
  UnhookWindowsHookEx(GlobalData^.HookHandle);
end;

procedure DLLEntry(dwReason: DWORD); 
begin
case dwReason of
  DLL_PROCESS_ATTACH: CreateGlobalHeap;
  DLL_PROCESS_DETACH: DeleteGlobalHeap;
end;
end;

exports
KillHook,
RunHook;

begin
DLLProc:= @DLLEntry;
DLLEntry(DLL_PROCESS_ATTACH);
end.

Выполнение

unit RunMiddleButton;

interface

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

type
TfrmMain = class(TForm)
  btnRunHook: TButton;
  btnKillHook: TButton;
  procedure btnRunHookClick(Sender: TObject);
  procedure btnKillHookClick(Sender: TObject);
private
  { Private declarations }
public
  { Public declarations }
end;

procedure RunHook; stdcall;
      external 'MiddleButton.dll' name 'RunHook'; 
procedure KillHook; stdcall;
      external 'MiddleButton.dll' name 'KillHook'; 

var
frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.btnRunHookClick(Sender: TObject);
begin
  RunHook;
end;

procedure TfrmMain.btnKillHookClick(Sender: TObject);
begin
  KillHook;
end;

end.