суббота, 22 мая 2010 г.

Хук на среднюю кнопу мыши без DLL

Сегодня мы вам покажем вариант установки хука на колесико мыши без использования внешней библиотеки (DLL). Для этого нам понадобится всего лишь задействовать функции SetWindowsHookEx() и UnhookWindowsHookEx() (см. MSDN). Для работы с сообщения создадим виртуальное окно через AllocateHWnd(). Объявим структуру TMouseHookStructLL...

Полный код приложения:
program raxp_WH_MOUSE_LL;

uses Messages, Windows, classes;

type
  sample = class
  public
    constructor Create;
    destructor Destroy; override;
    procedure WndProc(var Msg:TMessage);
  end;
type
  TMouseHookStructLL = packed record
    p: TPoint;
    mouseData: DWORD;
    flag: DWORD;
    time: DWORD;
    dwExtraInfo: DWORD;
  end;
  PMouseHookStructLL = ^TMouseHookStructLL;
const WH_MOUSE_LL = 14;
var
  Msg: tmsg;
  smp: sample;
  FWND, h: HWND;
  //
  _hdc: hDC;

function MouseProc(n: Integer; wParam, lParam: Longint): lResult; stdcall;
var _x, _y: integer;
    x, y, text: string;
begin
 _x:= PMouseHookStructLL(lParam)^.p.X;
 _y:= PMouseHookStructLL(lParam)^.p.Y;
 if wParam = WM_MBUTTONDOWN then begin
  str(_x, x);
  str(_y, y);
  text:= 'Жмакнул колесиком по координатам: ' + x + ',' + y;
  TextOut(_hdc, _x, _y, pansichar(text), length(text));
 end;
 if wParam = WM_RBUTTONDOWN then begin
  Ellipse(_hdc, _x, _y, _x + 50, _y + 50);
 end;
 if wParam = WM_LBUTTONDOWN then begin
  Rectangle(_hdc, _x, _y, _x + 100, _y + 150);
 end;
 //
 Result:= CallNextHookEx(h, n, wParam, lParam)
end;

procedure sample.WndProc(var Msg:TMessage);
begin
 case dword(Msg.lparam) of
  WM_MBUTTONDOWN : ;
  WM_LBUTTONUP   : ;
  WM_RBUTTONUP   : ;
 end
end;

constructor sample.Create;
Begin
 inherited Create;
 FWnd:= AllocateHWnd(WndProc);
 //
 _hdc:= GetDC(0);
 //
 h:= SetWindowsHookEx(WH_MOUSE_LL, @MouseProc, HInstance, 0)
End;
destructor sample.Destroy;
Begin
 ReleaseDC(0, _hdc);
 //
 deAllocateHWnd(fwnd);
 inherited Destroy
End;
// END СЕРВИС МОДУЛЬ ----------------------------------------------------------


begin
 smp:= sample.Create;
 try while GetMessage(Msg, 0, 0, 0) do begin
  TranslateMessage(Msg);
  DispatchMessage(Msg)
 end
 finally UnhookWindowsHookEx(h); smp.Free end
end.
забрать добро

Комментариев нет:

Отправить комментарий

В комментариях уважайте собеседника, внимательно читайте посты и не додумывайте. Просьбы и предложения из разряда: «можно ваш Skype/Viber/телефон», «напишите мне в vk/FB», а также другие им подобные — игнорируются. Выход новых версий ПО, внешняя ссылка, переставшая работать с течением времени и т.п. не является основанием для претензий. Желающие спокойно подискутировать и высказаться — Welcome. Желающие спонсировать блог — Donate. Нарушение этих простых правил ведет к бану и удалению комментариев без предупреждения.