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

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

　　第一步 建一DLL DELPHI中NEW 》DLL SAVE AS GETKEY

library getKey;

usesSysUtils Windows HookMain in hookmain pas;

exportsOpenGetKeyHook CloseGetKeyHook GetPublicP;

beginNextHook := ;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 [ ] of DWORD;type mydata=recorddata :array [ ] of DWORD;data :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 $FFFF pChar(_IOBuffer)); if hObject = then Raise Exception Create(创建公用数据的Buffer不成? ; pMem := MapViewOfFile(hObject FILE_MAP_WRITE SizeOf(mydata));// or SizeOf(DataBuf) ???? // 创建SizeOf(DataBuf)的数据区if not Assigned(pMem) then begin UnMapMem; Raise Exception Create(创建公用数据的映射关系不成功!); end; end; Procedure DLLMain(dwReason:Dword); far; begin Case dwReason of DLL_PROCESS_ATTACH : begin pMem := nil; hObject := ; 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;beginResult := ;If iCode $#@ ; Then Result := CallNextHookEx(NextHook iCode wParam lParam);

// This is probably closer to what you would want to do Case wparam ofWM_LBUTTONDOWN:beginend;WM_LBUTTONUP:beginend;WM_LBUTTONDBLCLK:beginend;WM_RBUTTONDOWN:beginmessagebeep( );end;WM_RBUTTONUP:beginend;WM_RBUTTONDBLCLK:beginend;WM_MBUTTONDOWN:beginend;WM_MBUTTONUP:beginend;WM_MBUTTONDBLCLK:beginend;WM_NCMouseMove WM_MOUSEMOVE:beginmydata(pmem^) data :=pMOUSEHOOKSTRUCT(lparam)^;// messagebeep( );//SendMessage(DataBuf(pMem^)[ ] DataBuf(pMem^)[ ] wParam lParam );SendMessage(mydata(pMem^) data [ ] mydata(pMem^) data [ ] wParam integer(@(mydata(pmem^) data )) );end;end; //发送消息end;

function OpenGetKeyHook(sender : HWND;MessageID : WORD) : BOOL; export;beginResult := False;if NextHook $#@ ;$#@ ; then Exit; //已经安装了本钩子// DataBuf(pMem^)[ ] := Sender; //填数据区// DataBuf(pMem^)[ ] := MessageID; //填数据区mydata(pmem^) data [ ]:=sender;mydata(pmem^) data [ ]:=messageid;

NextHook := SetWindowsHookEx(WH_mouse HookHandler Hinstance );Result := NextHook $#@ ;$#@ ; ; end;

function CloseGetKeyHook: BOOL; export; begin if NextHook $#@ ;$#@ ; then begin UnhookWindowshookEx(NextHook); //把钩子链链接到下一个钩子处理上 NextHook := ; end; Result := NextHook = ; end;

end

　　第三步 测试DLL 建一PROJECT 关键在于override WndProc

unit Unit ;

interface

usesWindows Messages SysUtils Classes Graphics Controls Forms Dialogs StdCtrls ExtCtrls;

typeTForm = class(Tform)uncapture: Tbutton;capture: Tbutton;Exit: Tbutton;Panel : Tpanel;show: Tlabel;

Label : 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;

varForm : TForm ;var num : integer; const MessageID = WM_User + ;implementation

{$R * DFM}function OpenGetKeyHook(sender : HWND;MessageID : WORD) : BOOL; external GetKey DLL; function CloseGetKeyHook: BOOL; external GetKey DLL;

procedure TForm ExitClick(Sender: Tobject);beginclose;end;

procedure TForm uncaptureClick(Sender: Tobject);beginif CloseGetKeyHook then //ShowMessage(结束记录 );show caption:=结束记录 ;end;

procedure TForm captureClick(Sender: Tobject);begin// if OpenGetKeyHook(self Handle MessageID) then ShowMessage(开始记录 );

if OpenGetKeyHook(Form Handle MessageID) then//ShowMessage(开始记录 );show caption:=开始记录 ;num := ;

end;

procedure TForm WndProc(var Message: Tmessage);var x y:integer;beginif Message Msg = MessageID thenbegin// Panel Caption := IntToStr(Num);x:=PMouseHookStruct( message lparam)^ pt x ;y:=PMouseHookStruct( message lparam)^ pt y ;

panel caption:=x=+inttostr(x)+ y=+inttostr(y);inc(Num);counter Caption := IntToStr(Num);endelse Inherited;end;