是不是delphi不能写鼠标HOOK?(50分)

  • 主题发起人 主题发起人 guoyan
  • 开始时间 开始时间
G

guoyan

Unregistered / Unconfirmed
GUEST, unregistred user!
我写了一个鼠标HOOK,但只要一运行,象帝国时代,
二战特种兵等全屏大型游戏就不能玩(帝国时代玩一分钟就退出)
但普通窗口程序还是可以运行调试了好几天也不行,
象下面的程序段,HookHandler中就是什么也不放
也不行,是不是delphi不能写鼠标HOOK。(delphi3 ,4都实过)
急盼答案 guoyan@163.net



function HookHandler(iCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; export;
begin
Result := 0;
If iCode < 0 Then begin
Result := CallNextHookEx(NextHook, iCode, wParam, lParam);
exit;
end;

end;

function EnablemouseHook(sender : HWND;MessageID : WORD;) : BOOL; export;
begin
Result := False;

if NextHook <> 0 then Exit;
mydata(pmem^).data1[1]:=sender;
mydata(pmem^).data1[2]:=messageid;

NextHook := SetWindowsHookEx(WH_mouse, HookHandler, HInstance, 0);
Result := NextHook <> 0;
end;
 
在有关mouse hook callback function的说明中有一个remark:
The hook procedure must not install a JournalPlaybackProc callback function.
怎么解释? (抱歉本人英语很差) 是不是安装了WH_JOURNALPLAYBACK就不能装mousehook
的意思呀?
 
能写,给你个原代码
一.实现方法

  DELPHI提供了强大的可视化集成开发环境,它使得在Windows下的应用程序开发变得更加广泛,因此我们将
用DELPHI编写一个动态链接库,然后在主程序中加以调用以实现系统挂钩的设置。具体步骤如下:

  * 用DELPHI创建一个使用键盘挂钩的动态链接库HK.DLL

  * 用DELPHI编写一个使用上述DLL的可执行文件HOOK.EXE

  二.实现步骤

  1.创建动态链接库

  * 选择FILE菜单中的NEW选项,选择DLL产生一个新的模板,保存为HK.DPR

  library HK .

  uses

   SysUtils,

   Classes,

   hkproc in 'hkproc.pas'; //挂钩函数在文件中的定义

   exports //DLL的输出函数

   EnableHotKeyHook,

   DisableHotKeyHook;

  

  begin

   hNextHookProc :=0;

   Assign(f,'c:/code.txt');//将捕获的键值存入C盘的“code.txt”文件中

   Reset(f); //初始化“code.txt”文件

   procSaveExit := ExitProc; //DLL释放时解除挂钩

   ExitProc := @HotKeyHookExit;

  end.

  * 选择FILE菜单中的NEW选项,选择UNIT生成HKPROC.PAS

  unit hkproc;

  interface

  uses

   Windows,Messages;

  var

   f :file of char;

  c:char;

  i :integer;

  j :integer;

   hNextHookProc : HHook;

   procSaveExit : Pointer;

  function KeyboardHookHandler(iCode : Integer;

   wParam : WPARAM;

   lParam : LPARAM) : LRESULT; stdcall export;

  function EnableHotKeyHook : BOOL export

  function DisableHotKeyHook : BOOL; export

  procedure HotKeyHookExit far

  implementation

  function KeyboardHookHandler(iCode : Integer;

   WParam : WPARAM;

   lParam : LPARAM) : LRESULT stdcall export;

  const

   _KeyPressMask = $80000000

  begin

   Result :=0;

   if iCode <0 then

   begin

   Result :=CallNextHookEx(hNextHookProc,iCode,

   wParam,lParam);

   Exit;

   end;

   if((lParam and _KeyPressMask)=0) then

   begin

   i:=getkeystate($10); //返回Shift键的状态

   j:=getkeystate($14); //返回Caps Lock键的状态

   if((j and 1)=1 )then //判断CapsLock是否按下

   begin

   //判断Shift 是否按下

   if ((i and _KeyPressMask)=_KeyPressMask) then

   begin

   if (wparam<65) then //判断是字母键还是数字键

   begin

   c:=chr(wparam-16);

   end

   else

   begin

   c:= chr(wparam+32);

   end;

   end

   else

   begin

   if (wparam<65) then

   begin

   c:=chr(wparam);

   end

   else

   begin

   c:=chr(wparam);

   end;

   end;

   end

   else

   begin

   if ((i and _KeyPressMask)=_KeyPressMask) then

   begin

   if (wparam<65) then

   begin

   c:=chr(wparam-16);

   end

   else

   begin

   c:= chr(wparam);

   end;

   end

   else

   begin

   if (wparam<65) then

   begin

   c:=chr(wparam);

   end

   else

   begin

   c:=chr(wparam+32);

   end;

   end;

   end;

   seek(f,FileSize(f));

   write(f,c); //将捕获的键码存入文件

   end;

  end;

  

  function EnableHotKeyHook:BOOL;export;

  begin

  Result:=False;

  if hNextHookProc <> 0 then exit;

  hNextHookProc:=SetWindowsHookEx(WH_KEYBOARD,

  KeyboardHookHandler,Hinstance,0);

  Result:=hNextHookProc <>0

  end;

  

  function DisableHotKeyHook:BOOL; export;

  begin

   if hNextHookPRoc <> 0 then

   begin

   UnhookWindowshookEx(hNextHookProc);

   hNextHookProc:=0;

   Messagebeep(0);

   Messagebeep(0);

   end;

   Result:=hNextHookPRoc=0;

  end;

  

  procedure HotKeyHookExit;

  begin

   if hNextHookProc <> 0 then DisableHotKeyHook;

   close(f); //关闭文件并自动解除挂钩

   ExitProc:=procSaveExit;

  end;

  end.

  * 将程序编译后生成一个名为HK.DLL的动态链接库文件并存入“c:/hook”目录下。

  

   2.创建调用DLL的EXE程序HOOK.EXE

  * 选择FILE菜单中的NEW选项,在New Items窗口中,选择Application选项。在窗体Form中,加入两个按
键,一个定义为挂钩,另一个定义为解脱,同时加入一个文本框以提示挂钩的设置状况。将Unit1存为
“c:/hook/hk.pas”,其相应的代码如下:

  

  unit hk;

  interface

  

  uses

   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

   StdCtrls;

  

  type

   TForm1 = class(TForm)

   Button1: TButton;

   Button2: TButton;

   Edit1: TEdit;

   procedure Button1Click(Sender: TObject);

   procedure Button2Click(Sender: TObject);

  

   private

   { Private declarations }

   public

   { Public declarations }

   end;

  

  var

   Form1: TForm1;

  

  implementation

  

  {$R *.DFM}

  

  function EnableHotKeyHook : BOOL;external 'HK.dll';

  //声明HOOK . DLL中的两函数

  function DisableHotKeyHook :BOOL;external 'HK.dll';

  

  procedure TForm1.Button1Click(Sender: TObject);

  begin

   if EnableHotKeyHook() then

   begin

   edit1.text :='设置挂钩'

   end

  end;

  

  procedure TForm1.Button2Click(Sender: TObject);

  begin

   if DisableHotKeyHook() then

   begin

   edit1.Text :='挂钩解脱'

   end

  end;

  end.

  * 选取Views菜单中的Project Source,将Project1存为“c:/hook/hook.dpr”,其代码如下:

  

  program hook;

  uses

   Forms,

   hk in 'hk.pas' {Form1};

  {$R *.RES}

  

  begin

   Application.Initialize;

   Application.CreateForm(TForm1, Form1);

   Application.Run;

  end.

  

  * 编译生成HOOK.EXE 程序并存入“c:/hook”目录下。预先用“记事本”在“c:/hook”目录下建立
CODE.TXT文件,运行HOOK程序并单击“挂钩”键,文本框提示“设置系统挂钩”,这时启动写字板等应用程
序,所键入的字母和数字将被记录在CODE.TXT文件中。

  单击“解脱”键,文本框显示“挂钩解脱”,程序将停止对键盘的捕获。
// 限制
procedure TForm1.Button1Click(Sender: TObject);
var
rtButton2: TRect;
begin
rtButton2 := Button2.BoundsRect;
MapWindowPoints(handle, 0, rtButton2, 2); // 座标换算
ClipCursor(@rtButton2); // 限制鼠标移动区域
end;

// 还原
procedure TForm1.Button2Click(Sender: TObject);
var
rtScreen: TRect;
begin
rtScreen := Rect(0, 0, Screen.Width, Screen.Height);
ClipCursor(@rtScreen);
end;
 
鼠标hook可以写,我一直没有搞动 的是
lmd里有一个可以跟踪鼠标的控件,似乎
不是用HOOK写的,不知道那位大虾可以告
诉我他的原理
 
跟踪鼠标的方法太麻烦,Hook可能好一些。
 
Dnchen:
你可以到tqz的主页上搞一个lmd的原代码包来看看.
 
guoyan:

这个问题已经很长时间没有人参加讨论,为保持版面
整洁,节约网友时间,请提问者采取必要处理措施。
关于本版管理细则,请参见<a href="http://www.gislab.ecnu.edu.cn/delphibbs/DispQ.asp?LID=111927">这个</a>问题。如两天
内提问者没有响应,我将采取强制措施。

如有管理建议,请到<a href="http://www.gislab.ecnu.edu.cn/delphibbs/DispQ.asp?LID=111927">这里</a>提出。谢谢!
 
多人接受答案了。
 

Similar threads

后退
顶部