VPF::Мышиный hook - Форум программистов

sanek198

Дата 8.12.2007, 18:19 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 27
Регистрация: 28.7.2007

Репутация: нет
Всего: нет

Доброго времени суток!
Нашел на одном сайте пример хука на мышь. Все работает, но почему-то WParam всегда равно нулю и хук не реагирует на мышиное колесо если в фокусе нет ни одного окна. Что не так? Буду очень признателен за любую помощь.

Вот исходный код:

Код


library HookMouse; 

uses
  Windows,
  Messages;

const
CM_MANDA_DATOS = WM_USER + $1000;

type 
TCompartido = record 
   Receptor, 
   wHitTestCode, 
   x,y, 
   Ventana : hwnd; 
end; 
PCompartido   =^TCompartido; 


var 
HookDeMouse  : HHook;
FicheroM     : THandle; 
Compartido   : PCompartido; 


function CallBackDelHook( Code    : Integer; 
                          wParam  : WPARAM; 
                          lParam  : LPARAM 
                          )       : LRESULT; stdcall; 

var 
  DatosMouse     : PMouseHookStruct; 
  Intentos       : integer; 

{This is the CallBack function called by he Hook} 
begin
Result := 0;
{if there is a new mouse event...}
if code=HC_ACTION then
begin
  {if the mapfile exists}
  FicheroM:=OpenFileMapping(FILE_MAP_WRITE,False,'ElReceptor');
   {If dont, send nothing to receiver application} 
  if FicheroM<>0 then 
  begin
    Compartido:=MapViewOfFile(FicheroM,FILE_MAP_ALL_ACCESS,0,0,SizeOf(Compartido));  
    DatosMouse:=Pointer(lparam);     
    Compartido^.Ventana:=DatosMouse^.hwnd;
    Compartido^.x:=DatosMouse^.pt.x;
    Compartido^.y:=DatosMouse^.pt.y;
    {Say to receiver that there is a new event} 
    PostMessage(Compartido^.Receptor,CM_MANDA_DATOS,wParam,lParam); 

    UnmapViewOfFile(Compartido); 
    CloseHandle(FicheroM); 
  end; 
end; 
{call to next hook of the chain} 
Result := CallNextHookEx(HookDeMouse, Code, wParam, lParam);
end; 

procedure HookOn; stdcall; 
{procedure for install the hook}
begin 
  HookDeMouse:=SetWindowsHookEx(WH_MOUSE, @CallBackDelHook, HInstance , 0);
end;

// stops this type of watch 
procedure HookOff;  stdcall; 
begin 
{procedure to uninstall the hook} 
  UnhookWindowsHookEx(HookDeMouse); 
end; 

exports 
{Export the procedures} 
HookOn, 
HookOff; 

begin 
end.

Код


unit Unit1;

interface

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

const 
  NombreDLL       = 'HookMouse.dll';
  CM_MANDA_DATOS  = WM_USER + $1000; 


type 
TCompartido = record 
   Receptor, 
   wHitTestCode, 
   x,y,
   Ventana         : hwnd;
end; 
PCompartido   =^TCompartido; 
THookMouse=procedure; stdcall;
type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Memo1: TMemo;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
      FicheroM       : THandle; 
    Compartido     : PCompartido; 
    HandleDLL      : THandle; 
    HookOn, 
    HookOff        : THookMouse;
      procedure LlegaDelHook(var message: TMEssage); message  CM_MANDA_DATOS;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
 r,h:Integer;
implementation

{$R *.dfm}



procedure TForm1.LlegaDelHook(var message: TMessage);
var 
  DatosMouse     : PMouseHookStruct; 
  NombreVentana  : array [0..200] of char; 
  Accion         : string; 
begin 
  with Compartido^ do 
  begin 
     {Mouse coordinates} 
    Label1.caption:='['+IntToStr(x)+':'+IntToStr(y)+']'; 
  end; 
   {Window Name} 
  GetWindowText(Compartido^.Ventana,@NombreVentana,200);
  Label2.Caption:=NombreVentana; 

  case Message.wParam of 
    WM_LBUTTONDBLCLK     : Accion:='WM_LBUTTONDBLCLK  '; 
    WM_LBUTTONDOWN  : Accion:='WM_LBUTTONDOWN    '; 
    WM_LBUTTONUP         : Accion:='WM_LBUTTONUP      '; 
    WM_MBUTTONDBLCLK     : Accion:='WM_MBUTTONDBLCLK  ';
    WM_MBUTTONDOWN       : Accion:='WM_MBUTTONDOWN    ';
    WM_MBUTTONUP         : Accion:='WM_MBUTTONUP      '; 
    WM_MOUSEMOVE         : Accion:='WM_MOUSEMOVE      ';
    WM_NCHITTEST         : Accion:='WM_NCHITTEST      ';
    WM_NCLBUTTONDBLCLK   : Accion:='WM_NCLBUTTONDBLCLK'; 
    WM_NCLBUTTONDOWN     : Accion:='WM_NCLBUTTONDOWN  '; 
    WM_NCLBUTTONUP       : Accion:='WM_NCLBUTTONUP    ';
    WM_NCMBUTTONDBLCLK   : Accion:='WM_NCMBUTTONDBLCLK';
    WM_NCMBUTTONDOWN     : Accion:='WM_NCMBUTTONDOWN  '; 
    WM_NCMBUTTONUP       : Accion:='WM_NCMBUTTONUP    '; 
    WM_NCMOUSEMOVE       : Accion:='WM_NCMOUSEMOVE    ';
    WM_NCRBUTTONDBLCLK   : Accion:='WM_NCRBUTTONDBLCLK';
    WM_NCRBUTTONDOWN     : Accion:='WM_NCRBUTTONDOWN  ';
    WM_NCRBUTTONUP       : Accion:='WM_NCRBUTTONUP    ';
    WM_RBUTTONDBLCLK     : Accion:='WM_RBUTTONDBLCLK  ';
    WM_RBUTTONDOWN       : Accion:='WM_RBUTTONDOWN    ';
    WM_RBUTTONUP         : Accion:='WM_RBUTTONUP      ';
    WM_MOUSEWHEEL        : Accion:='WM_MOUSEWHEEL     ';
  end; 
  Memo1.Lines.Append(Accion); 

  end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
{Uninstall the Hook}
if Assigned(HookOff) then HookOff;

{Free the DLL}
if HandleDLL<>0 then
  FreeLibrary(HandleDLL);

{Close the memfile and the View}
if FicheroM<>0 then
begin
   UnmapViewOfFile(Compartido);
   CloseHandle(FicheroM);
end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  HandleDLL:=LoadLibrary( PChar(ExtractFilePath(Application.Exename)+
                               NombreDLL ) );
  if HandleDLL = 0 then raise Exception.Create('No se pudo cargar la DLL');

  @HookOn :=GetProcAddress(HandleDLL, 'HookOn');
  @HookOff:=GetProcAddress(HandleDLL, 'HookOff'); 

  if not assigned(HookOn) or
     not assigned(HookOff)  then
     raise Exception.Create('Cannot find the required DLL functions'); 

  {Creamos el fichero de memoria} 
  FicheroM:=CreateFileMapping(INVALID_HANDLE_VALUE,
                              nil,
                              PAGE_READWRITE,
                              0, 
                              SizeOf(Compartido),
                              'ElReceptor');

   {Si no se creo el fichero, error} 
   if FicheroM=0 then
     raise Exception.Create('/Error while create file'); 
   Compartido:=MapViewOfFile(FicheroM,FILE_MAP_ALL_ACCESS,0,0, SizeOf(Compartido));
   Compartido^.Receptor:=Handle;
  HookOn;
end;

end.

MetalFan

Дата 8.12.2007, 19:05 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 16
Всего: 128

код содрал гдето, хоть бы вник как он работает.
удивительно, что AV хук не вызывает.

Цитата(sanek198 @ 8.12.2007, 18:19

)

Compartido : PCompartido;
....
MapViewOfFile(FicheroM,FILE_MAP_ALL_ACCESS,0,0,SizeOf(Compartido));

в 4 байта пытаешься писать 20

Добавлено через 1 минуту и 59 секунд
это как минимум. есть и другие ошибки

--------------------

There are always someone smarter than you...

Knom

Дата 14.12.2007, 16:33 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 4
Регистрация: 20.10.2007

Репутация: нет
Всего: нет

Тоже интересует данный вопрос, перерыл кучу инфы - результат нулевой. Колесо работает, но результат для UP и DN одинаковый или 0, перепробовал множество вариантов.

Чтобы абстрагироваться от ошибок "содранного кода" - вот самый элементарный хук, интересует что надо вписать в
WM_MOUSEWHEEL: ShowMessage( IntToStr(SmallInt(HiWord(wParam))));

Нужно чтобы форма находилась в свёрнутом состоянии и перехватывала НАПРАВЛЕНИЕ колеса мыши через хук, заранее спасибо.

хук

Код


library mhook;

uses
  windows, messages, dialogs, sysutils;

var
  theHook: THandle;

{-------------------------------------}

function MouseHook(nCode, wParam, lParam: integer): Lresult; stdcall;
begin
  if nCode < 0 then
  begin
    Result := CallNextHookEx(theHook, nCode, wParam, lParam);
    Exit;
  end;

  case wParam of
    WM_MOUSEWHEEL: ShowMessage( IntToStr(SmallInt(HiWord(wParam))));
  end;

  result := CallNextHookEx(theHook, nCode, wParam, lParam);
end;

{-------------------------------------}

procedure mStart;
begin
  theHook := SetWindowsHookEx(WH_MOUSE, @mouseHook, hInstance, 0);
  if theHook = 0 then
    messageBox(0, 'Error!', 'Error!', mb_ok);
end;

{-------------------------------------}

procedure mRemove;
begin
  UnhookWindowsHookEx(theHook);
end;

{-------------------------------------}

exports
  mStart index 1 name 'mStart',
  mRemove index 2 name 'mRemove';

{-------------------------------------}

begin
end.

форма

Код


unit Unit1;

interface

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

procedure mStart; external 'mhook.dll' name 'mStart';
procedure mRemove; external 'mhook.dll' name 'mRemove';

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

{------------------------------------}

implementation

{$R *.dfm}

{------------------------------------}

procedure TForm1.Button1Click(Sender: TObject);
begin
  mStart;
end;

{------------------------------------}

procedure TForm1.Button2Click(Sender: TObject);
begin
  mRemove;
end;

{------------------------------------}

end.

MetalFan

Дата 14.12.2007, 17:06 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 16
Всего: 128

откуда очередной бредовый код взят?

--------------------

There are always someone smarter than you...

Knom

Дата 14.12.2007, 17:41 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 4
Регистрация: 20.10.2007

Репутация: нет
Всего: нет

Что тебе конкретно не нравится? Это ОЧЕНЬ маленький и 100% работающий код, очень точно отражающий суть проблемы. Могу выложить 10+ различных вариантов "нормального" кода, но всё сводится к одному и тому же, а именно к обработке:
  case wParam of
    WM_MOUSEWHEEL: "код обработки колеса мыши";
  end;

MetalFan

Дата 14.12.2007, 18:20 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 16
Всего: 128

так может имеет смысл WH_MOUSE_LL использовать?

Это сообщение отредактировал(а) MetalFan - 14.12.2007, 18:28

--------------------

There are always someone smarter than you...

Knom

Дата 14.12.2007, 18:30 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 4
Регистрация: 20.10.2007

Репутация: нет
Всего: нет

если использовать WH_GETMESSAGE, то не обрабатывается:
  case wParam of
    WM_MOUSEWHEEL: ShowMessage('колёсико');
  end;

едитед: а вообще я просто тупо все WH_ уже перепробовал (

Добавлено @ 18:34
ставил:
const
  WH_MOUSE_LL=14;

и ничего (

насчёт WH_MOUSE_LL: в слово "ничего" я вложил смысл ) , что выводится та же инфа что и для WH_MOUSE, не могу отловить отличие ВВЕРХ и ВНИЗ, понимаю конечно что делаю что-то не так и где-то в возвращаемом значении есть отличие в каком-то бите, но что и где?

Это сообщение отредактировал(а) Knom - 14.12.2007, 18:39

MetalFan

Дата 14.12.2007, 18:54 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 16
Всего: 128

это работает:
приложение:

Код


const
  WM_HOOKWHEEL = WM_APP + 1;
type
  TForm1 = class(TForm)
...
    procedure WMWheelNotify( var AMsg: TMessage ); message WM_HOOKWHEEL;
...

  function SetHook( ANotifyHandle: DWORD ): Boolean; external 'tempdll.dll';
  function RemoveHook: Boolean; external 'tempdll.dll';

procedure TForm1.btnHookClick(Sender: TObject);
begin
  if SetHook( Self.Handle ) then
    ShowMessage('Ok!')
  else
    RaiseLastWin32Error;
end;

procedure TForm1.btnUnhookClick(Sender: TObject);
begin
  RemoveHook;
end;

procedure TForm1.WMWheelNotify(var AMsg: TMessage);
begin
  Caption := IntToStr( ShortInt(AMsg.wParam) );
end;

DLL:

Код


library Tempdll;

uses
  SysUtils,
  Windows,
  Messages;

var
  gHook: DWORD = 0;
  gHandle: DWORD = 0;

const
  WH_MOUSE_LL    = 14;
type
  LPMSLLHOOKSTRUCT = ^MSLLHOOKSTRUCT;
  {$EXTERNALSYM LPMSLLHOOKSTRUCT}
  tagMSLLHOOKSTRUCT = record
    pt: TPOINT;
    mouseData: DWORD;
    flags: DWORD;
    time: DWORD;
    dwExtraInfo: DWORD;
  end;
  {$EXTERNALSYM tagMSLLHOOKSTRUCT}
  MSLLHOOKSTRUCT = tagMSLLHOOKSTRUCT;
  {$EXTERNALSYM MSLLHOOKSTRUCT}
  TMsllHookStruct = MSLLHOOKSTRUCT;
  PMsllHookStruct = LPMSLLHOOKSTRUCT;

function MouseHook(nCode, wParam, lParam: integer): Lresult; stdcall;
var
  lMHS: LPMSLLHOOKSTRUCT;
begin
  if nCode < 0 then
  begin
    Result := CallNextHookEx(0, nCode, wParam, lParam);
    Exit;
  end;
  lMHS := Pointer( lParam );
  case wParam of
    WM_MOUSEWHEEL:
    begin
      PostMessage( gHandle, WM_APP+1, HiWord(lMHS^.mouseData), 0 );
    end;
  end;
  result := CallNextHookEx(0, nCode, wParam, lParam);
end;

  function SetHook( ANotifyHandle: DWORD ): Boolean;
  begin
    Result := (gHook = 0) and (ANotifyHandle = 0);
    gHook := SetWindowsHookEx(WH_MOUSE_LL, @MouseHook, HInstance, 0);
    result := gHook <> 0;
    gHandle := ANotifyHandle;
  end;

  function RemoveHook: boolean;
  begin
    Result := UnhookWindowsHookEx(gHook);
  end;

  exports SetHook, RemoveHook;

begin
end.

Цитата(MSDN)

...
mouseData
If the message is WM_MOUSEWHEEL, the high-order word of this member is the wheel delta. The low-order word is reserved. A positive value indicates that the wheel was rotated forward, away from the user; a negative value indicates that the wheel was rotated backward, toward the user. One wheel click is defined as WHEEL_DELTA, which is 120.

Это сообщение отредактировал(а) MetalFan - 14.12.2007, 18:54

--------------------

There are always someone smarter than you...

Knom

Дата 14.12.2007, 20:16 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 4
Регистрация: 20.10.2007

Репутация: нет
Всего: нет

Работает !!! Большое спасибо и РЕСПЕКТ, а я два дня мучался smile

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: WinAPI и системное программирование \| Следующая тема »