这个全局mouse hook (鼠标钩子)为什么不能实现(100分)

luckysun · 2002-10-31

也算是老问题，一个监测鼠标空闲时间的钩子程序，我已经做成DLL了，可是还是不能实现全局 请问是哪个地方不对？ 全部代码下载：http://luckysun.y365.com/myhook.zip 我从没有编过程序，这个是按照一个VCL修改的，麻烦各位了! dll部分代码 library MouseHook; uses   MouseIdle in 'MouseIdle.pas'; exports   LastActivity, IdleTime, IdleMinutes, CreateHooks, RemoveHooks; begin   WhMouse := 0;   procSaveExit := ExitProc;   ExitProc := @MouseHookExit; end. *********************************** unit MouseIdle; interface uses   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls; var   GLastActivity: TDateTime;   whMouse: HHook;   procSaveExit: Pointer; procedure CreateHooks; export; procedure RemoveHooks; export; procedure SetLastActivity(const t: TDateTime); procedure MouseHookExit; far; function LastActivity: TDateTime; export; //最后停止移动的时刻 function IdleTime: TDateTime; export;     //空闲的时间 function IdleMinutes: Integer; export;    //空闲的分钟数 implementation function MouseHookCallBack(Code: integer; Msg: WPARAM;   MouseHook: LPARAM): LRESULT; stdcall; export; begin //  Result := 0;   if Code >= 0 then     GLastActivity := Now;   Result := CallNextHookEx(whMouse, Code, Msg, MouseHook); end; function HookActive: Boolean; begin   Result := whMouse <> 0; end; procedure CreateHooks; export; begin   if not HookActive then   begin     whMouse := SetWindowsHookEx(WH_MOUSE, MouseHookCallBack, HInstance, 0);     GLastActivity := now;   end; end; procedure RemoveHooks; export; begin   if HookActive then   try     UnhookWindowsHookEx(whMouse);   finally     whMouse := 0;   end; end; function LastActivity: TDateTime; export; begin   Result := GLastActivity; end; procedure SetLastActivity(const t: TDateTime); begin   GLastActivity := t; end; function IdleTime: TDateTime; export; begin   Result := Now - GLastActivity; end; function IdleMinutes: Integer; export; begin   Result := Trunc(IdleTime * 1440.1); end; procedure MouseHookExit; begin   // 如果忘了解除 HOOK, 自动代理解除的动作   if WhMouse <> 0 then RemoveHooks;   ExitProc := procSaveExit; end; end.

jsxjd · 2002-10-31

94. 利用HOOK建立鼠标增强程序 在Windows系统中提供了一种系统消息挂钩的(Message hook)功能，使用消息挂钩，可以实时监视处理系统中的各种消息。很多鼠标增强软件就是利用消息挂钩来拦截所有的鼠标消息进行处理的。 要设置鼠标消息挂钩，一般先建立一个使用鼠标消息挂钩的动态连接库(DLL)文件，然后就可以在其它程序中使用这个DLL文件处理鼠标消息。 下面的程序介绍通过鼠标消息挂钩监视鼠标消息，从而实现类似于一些鼠标增强软件一样的使窗口上下左右滚动的功能。 1．建立动态连接库 选择菜单 File|New ，选择DLL产生一个DLL模版，保存为 MHook.Dpr //MHook.Dpr源程序 library MHook; uses SysUtils,Classes,hkproc in 'hkproc.pas'; exports EnableMouseHook, DisableMouseHook; begin hNextHookProc:=0; procSaveExit:=ExitProc; ExitProc:=@HotKeyHookExit; end. 再选择菜单 File|New ，选择Unit建立一个Pas文件，保存为 HKProc.pas //HKProc.pas源程序 unit hkproc; interface uses Windows,Messages; const Move_Up = 0; Move_Down=1; Move_Left=2; Move_Right=3; var hNextHookProc:HHook; procSaveExit

ointer; M_Direct:Integer; LPoint:TPoint; NowWindow:Integer; function MouseProc(iCode:Integer;wParam:WPARAM;lParam

ointer): LRESULT; stdcall;export; function EnableMouseHook(WndHandle:integer):BOOL;export; function DisableMouseHook:BOOL;export; function GetDirect(FPoint : TPoint;LPoint : TPoint):integer; procedure HotKeyHookExit;far; implementation //GetDirect函数根据光标的移动决定窗口滚动的方向。 function GetDirect(FPoint : TPoint;LPoint : TPoint):integer; var iWidth,iHeight:integer; begin iWidth:=LPoint.x-FPoint.x; iHeight:=lPoint.y-FPoint.y; Result:=-1; if ((iWidth=0)or(iHeight=0))then exit; if ((abs(iWidth) div abs(iHeight))>=2) then if iWidth<0 then //Move to left Result:=Move_Left else Result:=Move_Right else if ((abs(iHeight) div abs(iWidth))>=2) then if iHeight<0 then //Move to top Result:=Move_Up else Result:=Move_Down; end; function MouseProc(iCode:Integer;wParam:WPARAM; lParam

ointer):LRESULT; stdcall;export; var pMouse:^MOUSEHOOKSTRUCT; l:integer; begin //如果用户按下鼠标右键同时Scroll Lock键为按下状态则滚动窗口。 if ((wParam=WM_RBUTTONDOWN) and Boolean(GetKeyState(145))) then begin pMouse:=lParam; l:=GetDirect(lPoint,pMouse.pt); if l>=0 then M_Direct:=l; lPoint:=pMouse.pt; NowWindow:=WindowFromPoint(lPoint); if M_Direct=Move_Up then SendMessage(NowWindow,WM_VSCROLL,SB_PAGEUP,0) else if M_Direct=Move_Down then SendMessage(NowWindow,WM_VSCROLL,SB_PAGEDOWN,0) else if M_Direct=Move_Left then SendMessage(NowWindow,WM_HSCROLL,SB_PAGELEFT,0) else if M_Direct=Move_Right then SendMessage(NowWindow,WM_HSCROLL,SB_PAGERIGHT,0); Result:=1; exit; end else if ((wParam=WM_RBUTTONUP) and Boolean(GetKeyState(145))) then Result:=1 else begin Result:=0; if iCode<0 then begin Result:=CallNextHookEx(hNextHookProc,iCode,wParam,integer(lParam)); Exit; end; end; end; function EnableMouseHook(WndHandle:integer):BOOL;export; begin GetCursorPos(lPoint); Result:=False; if hNextHookProc<>0 then exit; //设置Mouse hook hNextHookProc:=SetWindowsHookEx(WH_MOUSE,@MouseProc,Hinstance,0); Result:=hNextHookProc<>0; end; function DisableMouseHook:BOOL;export; begin if hNextHookProc<>0 then begin UnHookWindowsHookEx(hNextHookProc); hNextHookProc:=0; end; Result:=hNextHookProc=0; end; procedure HotKeyHookExit; begin if hNextHookProc<>0 then DisableMouseHook; ExitProc:=procSaveExit; end; end. 在菜单中选择 Project|Build MHook建立DLL文件。 2．建立程序调用动态连接库 在这里我们还是使用Delphi建立程序，当然也可以使用诸如VB等调用动态连接库。在菜单中选 File|New Application建立一个新程序，将工程文件保存为Project1.dpr //project1的源程序 program Project1; uses Forms, Sample1 in 'Sample1.pas' {Form1}; {$R *.RES} begin Application.Initialize; //隐藏窗口 Application.ShowMainForm := False; Application.CreateForm(TForm1, Form1); Application.Run; end. 将Form1的源程序文件保存成Sample1.pas //Form1的源程序 unit Sample1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Menus, ImgList,ShellApi, ExtCtrls; const WM_ICONMESSAGE=WM_USER+$100; type TForm1 = class(TForm) procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormCreate(Sender: TObject); private procedure WMBarIcon(var Message:TMessage);message WM_ICONMESSAGE; public end; function EnableMouseHook(WndHandle:integer):BOOL;external 'MHook.DLL'; function DisableMouseHook:BOOL;external'MHook.DLL'; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.WMBarIcon (var Message:TMessage); begin //用户双击任务栏图标则关闭程序 if Message.LParam = WM_LBUTTONDBLCLK then close; end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); var lpData

NotifyIconData; begin //删除任务栏图标 lpData := new(PNotifyIconDataA); lpData.cbSize := 88;//SizeOf(PNotifyIconDataA); lpData.Wnd := Form1.Handle; lpData.hIcon := Form1.Icon.Handle; lpData.uCallbackMessage := WM_ICONMESSAGE; lpData.uID :=0; lpData.szTip := '鼠标演示'; lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP; Shell_NotifyIcon(NIM_DELETE,lpData); dispose(lpData); //解除Mouse hook DisableMouseHook; end; procedure TForm1.FormCreate(Sender: TObject); var lpData

NotifyIconData; begin EnableMouseHook(Form1.Handle); Form1.Visible := False; lpData := new(PNotifyIconDataA); lpData.cbSize := 88;//SizeOf(PNotifyIconDataA); lpData.Wnd := Form1.Handle; lpData.hIcon := Form1.Icon.Handle; lpData.uCallbackMessage := WM_ICONMESSAGE; lpData.uID :=0; lpData.szTip := '鼠标演示'; lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP; Shell_NotifyIcon(NIM_ADD,lpData); dispose(lpData); end; end. 运行程序，按下Scroll Lock键使其有效，将光标移动到文本窗口中（如IE、Word），移动鼠标，点击鼠标右键，窗口就可以依上一次移动的方向滚动。 利用上面的原理，将程序做一些改动，就可以象专业的鼠标增强程序一样做出例如缩放窗口，运行程序等很多鼠标增强效果来。上面的程序在Windows95,Delphi4.0下运行通过。

luckysun · 2002-10-31

对不起，这个程序我看过了，而且一般sendmessage的值都可以传过去，可是当 主程序要从DLL中取得一个值，当主程序不为当前窗口时就无法获得，麻烦你看 一下我的程序有什么不对的地方。

ctx62 · 2002-10-31

luckysun · 2002-11-08

还是没有人知道吗？

这个全局mouse hook (鼠标钩子)为什么不能实现(100分)

luckysun

Unregistered / Unconfirmed

jsxjd

Unregistered / Unconfirmed

luckysun

Unregistered / Unconfirmed

ctx62

Unregistered / Unconfirmed

luckysun

Unregistered / Unconfirmed

Similar threads