关于钩子函数(30分)

  • 主题发起人 主题发起人 jonjon
  • 开始时间 开始时间
J

jonjon

Unregistered / Unconfirmed
GUEST, unregistred user!
我写了一个钩子函数,在本窗体上捕获鼠标信息,离开窗体就停止捕获。
在回到窗体上时就不捕获了,这是为什么呀?
 
本窗体上捕获鼠标信息,离开窗体就停止捕获???
 
那回到窗口,你必须要激活啊!
 
怎么激活啊!
 
你把代码帖出来看看,才能知道是什么原因?
 
=================================================单元1===========================================
unit Unit1;

interface

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

const
MessageID=WM_User+100;

type
TForm1 = class(TForm)
Panel1: TPanel;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Panel2: TPanel;
GroupBox1: TGroupBox;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure WndProc(var Message:TMessage);override;
end;

var
Form1: TForm1;
num:integer;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenGetKeyHook(Form1.Handle,MessageID) then {挂接钩子过程}
Memo1.Lines.Add('开始记录');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if CloseGetKeyHook then {接触钩子过程挂接}
begin
Memo1.Lines.Add('结束记录');
Memo1.Lines.Add(' ');
end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
close;
end;

procedure TForm1.WndProc(var Message:TMessage);
begin
if Message.Msg=MessageID then
begin
with Memo1.Lines do
case Message.WParam of
WM_LBUTTONDOWN:
begin
Add('在('+ IntToStr(GetX) + ','+ IntToStr(GetY ) + ')按下左键!');
end;
WM_LBUTTONUP:
begin
Add('在('+ IntToStr(GetX) + ','+ IntToStr(GetY ) + ')释放左键!');
end;
WM_LBUTTONDBLCLK:
begin
Add('在('+ IntToStr(GetX) + ','+ IntToStr(GetY ) + ')双击左键!');
end;
WM_RBUTTONDOWN:
begin
Add('在('+ IntToStr(GetX) + ','+ IntToStr(GetY ) + ')按下右键!');
end;
WM_RBUTTONUP:
begin
Add('在('+ IntToStr(GetX) + ','+ IntToStr(GetY ) + ')释放右键!');
end;
WM_RBUTTONDBLCLK:
begin
Add('在('+ IntToStr(GetX) + ','+ IntToStr(GetY ) + ')双击左键!');
end;
WM_MBUTTONDOWN:
begin
Add('在('+ IntToStr(GetX) + ','+ IntToStr(GetY ) + ')按下中键!');
end;
WM_MBUTTONUP:
begin
Add('在('+ IntToStr(GetX) + ','+ IntToStr(GetY ) + ')释放中键!');
end;
WM_MBUTTONDBLCLK:
begin
Add('在('+ IntToStr(GetX) + ','+ IntToStr(GetY ) + ')双击中键!');
end;
WM_NCMouseMove,WM_MOUSEMOVE:
begin
Add('鼠标移动到('+ IntToStr(GetX) + ','+ IntToStr(GetY ) + ')!');
end;
end;
end;
Inherited;
end;

end.

==============================================单元2==================================================
unit Unit2;

interface
uses Windows,Messages,Dialogs,SysUtils;

type
TShareData=record
data1:array[1..2] of DWORD;
data2:TMOUSEHOOKSTRUCT;
end;

const
VirtualFileName = 'ShareDllData';
DataSize = sizeof (TShareData);
var
InstalledHook:HHook;
ShareData : TShareData;
function HookHandler(iCode:Integer;wParam:WPARAM;lParam:LPARAM):
LRESULT;stdcall;export;
function OpenGetKeyHook(sender:HWND;MessageID:WORD):BOOL;
function CloseGetKeyHook:BOOL;
function GetX:integer;
function GetY:integer;

implementation
function HookHandler(iCode:Integer;wParam:WPARAM;lParam:LPARAM):LRESULT;
begin
ShareData.data2:=pMOUSEHOOKSTRUCT(lParam)^;
SendMessage(ShareData.data1[1],
ShareData.data1[2],wParam,0);
Result:=CallNextHookEx(InstalledHook,iCode,wParam,lParam);
end;

function OpenGetKeyHook(sender:HWND;MessageID:WORD):BOOL;
begin
Result:=False;
if InstalledHook = 0 then
begin
ShareData.data1[1]:=sender;
ShareData.data1[2]:=MessageID ;
InstalledHook := SetWindowsHookEx(WH_mouse,HookHandler,HInstance,0);
Result:=InstalledHook<>0;
end;
end;

function CloseGetKeyHook:BOOL;
begin
if InstalledHook<>0 then
begin
UnhookWindowshookEx(InstalledHook);
InstalledHook:=0;
end;
Result:=InstalledHook=0;
end;

function GetX:integer;
begin
GetX := ShareData.data2.pt.x;
end;

function Gety:integer;
begin
Gety := ShareData.data2.pt.y;
end;

end.
 
我也是这个问题,关注,
InstalledHook := SetWindowsHookEx(WH_mouse,HookHandler,HInstance,0);
改为
InstalledHook := SetWindowsHookEx(WH_mouse,@HookHandler,HInstance,0);
 
to:ff_ff
你下面这个方法不行
InstalledHook := SetWindowsHookEx(WH_mouse,HookHandler,HInstance,0);
改为
InstalledHook := SetWindowsHookEx(WH_mouse,@HookHandler,HInstance,0);
 
我试了一下有这样的结果如下:
DLL里用内存共享的方法,就可以取所有窗体上的值。
DLL里用普通的变存值的话,只取本窗体上的值,离开本窗体就不取值了,再回到本窗体就又开始取值了。
 
GetDesktopWindow用这个函数行不?它返回顶层窗口的句柄,也不用内存共享的方法
给你一个鼠标钩子的例程, 在窗口的任何位置点击都会messagebeep();
这是DLL的
library GMousehook;

uses
SysUtils,
Classes,
WinTypes,
WinProcs,
Messages;

var
{holds various global values}
IsHooked: Boolean;
HookHandle: HHook;
DesktopWin: HWND;

{this is the procedure called every time a mouse message is processed}
function HookProc(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
{if the user clicked the left mouse button, output a sound}
if (wParam = WM_LBUTTONDOWN) then
MessageBeep(MB_ICONASTERISK);

{call the next hook in the chain. note that leaving this out would
effectively remove this message}
Result := CallNextHookEx(HookHandle, Code, wParam, lParam);
end;

function SetHook: Boolean; stdcall;
begin
Result := FALSE;

{make sure the hook is not already set}
if IsHooked then
Exit;

{get a handle to the desktop window}
DesktopWin := GetDesktopWindow;

{set this hook as a system level hook}
HookHandle := SetWindowsHookEx(WH_MOUSE, HookProc, HInstance, 0);

{indicate if the hook was set right}
Result := HookHandle <> 0;
end;

function RemoveHook: Boolean; stdcall;
begin
Result := FALSE;

{remove the hook}
if (not IsHooked) and (HookHandle <> 0) then
Result := UnhookWindowsHookEx(HookHandle);

{reset the global variable}
IsHooked := FALSE;
end;

exports
SetHook name 'SetHook',
RemoveHook name 'RemoveHook',
HookProc name 'HookProc';

begin
IsHooked := FALSE;
end.

这是窗体的
unit MouseHookDemoU;

interface

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

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

function SetHook: Boolean; stdcall;
function RemoveHook: Boolean; stdcall;

var
Form1: TForm1;

implementation

{$R *.dfm}

function SetHook; external 'GMouseHook.dll' name 'SetHook';
function RemoveHook; external 'GMouseHook.dll' name 'RemoveHook';

procedure TForm1.Button1Click(Sender: TObject);
begin
{set the hook}
if SetHook then
ShowMessage('Global Mouse Hook Set, Click on Desktop')
else
ShowMessage('Global Mouse Hook Not Set');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
{remove the hook}
if RemoveHook then
ShowMessage('Global Mouse Hook Removed, Click on Desktop')
else
ShowMessage('Global Mouse Hook Not Removed');
end;

end.
 
接受答案了.
 
后退
顶部