欢迎来到学术参考网

在应用程序中跟踪MOUSE的坐标

发布时间:2015-07-09 11:08

第一步,建一DLL,DELPHI中NEW-》DLL SAVE AS GETKEY
library getKey;
uses
SysUtils,
Windows,
HookMain in ;
exports
OpenGetKeyHook,
CloseGetKeyHook,
GetPublicP;
begin
NextHook := 0;
procSaveExit := ExitProc;
DLLproc := @DLLMain;
ExitProc := @HookExit;
DLLMain(DLL_PROCESS_ATTACH);
end.
第二步,建一UNIT ,HOOK MAIN。关键在于CreateFileMapping 和 消息 WM_NCMouseMove, WM_MOUSEMOVE:
unit HookMain;
interface
uses Windows, Messages, Dialogs, SysUtils;
//type DataBuf = Array [1..2] of DWORD;
type mydata=record
data1:array [1..2] of DWORD;
data2:TMOUSEHOOKSTRUCT;
end;
var hObject : Thandle;
pMem : Pointer;
NextHook: Hhook;
procSaveExit: Pointer;
function HookHandler(iCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; export;
function OpenGetKeyHook(sender : HWND;MessageID : WORD) : BOOL; export;
function CloseGetKeyHook: BOOL; export;
function GetPublicP : Pointer;stdcall; export;
Procedure DLLMain(dwReason:Dword); far;
procedure HookExit; far;
implementation
Procedure UnMapMem;
begin
if Assigned(pMem) then
begin
UnMapViewOfFile(pMem);
pMem := Nil
end;
end;
Procedure MapMem;
begin
hObject := CreateFileMapping($FFFFFFFF,Nil,Page_ReadWrite,0,$FFFF,pChar(_IOBuffer));
if hObject = 0 then Raise (创建公用数据的Buffer不成? ;
pMem := MapViewOfFile(hObject,FILE_MAP_WRITE,0,0,SizeOf(mydata));
// 1 or SizeOf(DataBuf)
// 创建SizeOf(DataBuf)的数据区
if not Assigned(pMem) then
begin
UnMapMem;
Raise (创建公用数据的映射关系不成功!);
end;
end;
Procedure DLLMain(dwReason:Dword); far;
begin
Case dwReason of
DLL_PROCESS_ATTACH :
begin
pMem := nil;
hObject := 0;
MapMem; //以下的公有数据,如tHWND,tMessageID将直接使用本Buf.
End;
DLL_PROCESS_DETACH : UnMapMem;
DLL_THREAD_ATTACH,
DLL_THREAD_DETACH :; //缺省
end;
end;
procedure HookExit; far;
begin
CloseGetKeyHook;
ExitProc := procSaveExit;
end;
function GetPublicP : Pointer;export;
begin //这里引出了公用数据区的指针,你可以在你的应用程序中自由操作它。但建议去掉此接口。
Result := pMem;
end;
function HookHandler(iCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; export;
begin
Result := 0;
If iCode $#@60; 0
Then Result := CallNextHookEx(NextHook, iCode, wParam, lParam);

// This is probably closer to what you would want to do...
Case wparam of
WM_LBUTTONDOWN:
begin
end;
WM_LBUTTONUP:
begin
end;
WM_LBUTTONDBLCLK:
begin
end;
WM_RBUTTONDOWN:
begin
messagebeep(1);
end;
WM_RBUTTONUP:
begin
end;
WM_RBUTTONDBLCLK:
begin
end;
WM_MBUTTONDOWN:
begin
end;
WM_MBUTTONUP:
begin
end;
WM_MBUTTONDBLCLK:

begin
end;
WM_NCMouseMove, WM_MOUSEMOVE:
begin
mydata(pmem^).data2:=pMOUSEHOOKSTRUCT(lparam)^;
// messagebeep(1);
//SendMessage(DataBuf(pMem^)[1],DataBuf(pMem^),wParam,lParam );
SendMessage(mydata(pMem^).data1[1],mydata(pMem^).data1,wParam,integer(@(mydata(pmem^).data2)) );
end;
end; //发送消息
end;
function OpenGetKeyHook(sender : HWND;MessageID : WORD) : BOOL; export;
begin
Result := False;
if NextHook $#@60;$#@62; 0 then Exit; //已经安装了本钩子
// DataBuf(pMem^)[1] := Sender; //填数据区
// DataBuf(pMem^) := MessageID; //填数据区
mydata(pmem^).data1[1]:=sender;
mydata(pmem^).data1:=messageid;
NextHook := SetWindowsHookEx(WH_mouse, HookHandler, Hinstance, 0);
Result := NextHook $#@60;$#@62; 0;
end;
function CloseGetKeyHook: BOOL; export;
begin
if NextHook $#@60;$#@62; 0 then
begin
UnhookWindowshookEx(NextHook); //把钩子链链接到下一个钩子处理上.
NextHook := 0;
end;
Result := NextHook = 0;
end;
end.
第三步,测试DLL,建一PROJECT。关键在于override WndProc
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TForm1 = class(Tform)
uncapture: Tbutton;
capture: Tbutton;
Exit: Tbutton;
Panel1: Tpanel;
show: Tlabel;
Label1: Tlabel;
counter: Tlabel;
procedure ExitClick(Sender: Tobject);
procedure uncaptureClick(Sender: Tobject);
procedure captureClick(Sender: Tobject);
private
{ Private declarations }
public
{ Public declarations }
procedure WndProc(var Message: Tmessage); override;
end;
var
Form1: TForm1;
var num : integer;
const MessageID = WM_User + 100;
implementation
{$R *.DFM}
function OpenGetKeyHook(sender : HWND;MessageID : WORD) : BOOL; external ;
function CloseGetKeyHook: BOOL; external ;
procedure ick(Sender: Tobject);
begin
close;
end;
procedure ureClick(Sender: Tobject);
begin
if CloseGetKeyHook then //ShowMessage(结束记录...);
n:=结束记录...;
end;
procedure eClick(Sender: Tobject);
begin
// if OpenGetKeyHook(,MessageID) then ShowMessage(开始记录...);
if OpenGetKeyHook(,MessageID) then
//ShowMessage(开始记录...);
n:=开始记录...;
num := 0;

end;
procedure c(var Message: Tmessage);
var x,y:integer;
begin
if = MessageID then
begin
// n := IntToStr(Num);
x:=PMouseHookStruct( )^.pt.x ;
y:=PMouseHookStruct( )^.pt.y ;
n:=x=+inttostr(x)+ y=+inttostr(y);
inc(Num);
n := IntToStr(Num);
end
else Inherited;
end;
end.

上一篇:找出计算机上当前登录入网的用户

下一篇:IP多媒体子系统——IMS技术与应用