在應用程式中跟蹤MOUSE的座標 |
|
|
|
jackkcg
站務副站長  發表：891 回覆：1050 積分：848 註冊：2002-03-23 發送簡訊給我 |
在應用程式中跟蹤MOUSE的座標 第一步，建一DLL，DELPHI中NEW-》DLL SAVE AS GETKEY library getKey; uses
SysUtils,
Windows,
HookMain in hookmain.pas; 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 Exception.Create(創建公用資料的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 Exception.Create(創建公用資料的映射關係不成功!);
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^)[2],wParam,lParam );
SendMessage(mydata(pMem^).data1[1],mydata(pMem^).data1[2],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^)[2] := MessageID; //填資料區
mydata(pmem^).data1[1]:=sender;
mydata(pmem^).data1[2]:=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 GetKey.DLL;
function CloseGetKeyHook: BOOL; external GetKey.DLL; procedure TForm1.ExitClick(Sender: Tobject);
begin
close;
end; procedure TForm1.uncaptureClick(Sender: Tobject);
begin
if CloseGetKeyHook then //ShowMessage(結束記錄...);
show.caption:=結束記錄...;
end; procedure TForm1.captureClick(Sender: Tobject);
begin
// if OpenGetKeyHook(self.Handle,MessageID) then ShowMessage(開始記錄...); if OpenGetKeyHook(Form1.Handle,MessageID) then
//ShowMessage(開始記錄...);
show.caption:=開始記錄...;
num := 0; end; procedure TForm1.WndProc(var Message: Tmessage);
var x,y:integer;
begin
if Message.Msg = MessageID then
begin
// Panel1.Caption := IntToStr(Num);
x:=PMouseHookStruct( message.lparam)^.pt.x ;
y:=PMouseHookStruct( message.lparam)^.pt.y ; panel1.caption:=x= inttostr(x) y= inttostr(y);
inc(Num);
counter.Caption := IntToStr(Num);
end
else Inherited;
end; end. *********************************************************
哈哈&兵燹
最會的2大絕招 這個不會與那個也不會 哈哈哈 粉好 Delphi K.Top的K.Top分兩個字解釋Top代表尖端的意思,希望本討論區能提供Delphi的尖端新知
K.表Knowlege 知識,就是本站的標語:Open our mind to make knowledge together!
希望能大家敞開心胸,將知識寶庫結合一起
------
********************************************************** 哈哈&兵燹 最會的2大絕招 這個不會與那個也不會 哈哈哈 粉好 Delphi K.Top的K.Top分兩個字解釋Top代表尖端的意思,希望本討論區能提供Delphi的尖端新知 K.表Knowlege 知識,就是本站的標語:Open our mind |
|
cmf
尊榮會員 發表：84 回覆：918 積分：1032 註冊：2002-06-26 發送簡訊給我 |
讚讚讚讚讚讚讚讚讚讚讚讚讚讚讚讚讚讚讚讚讚
讚讚讚讚讚一讚讚讚讚讚一讚讚讚讚讚讚讚讚讚
讚讚讚讚讚一一讚讚讚讚一一讚一一讚讚讚讚讚
讚讚讚讚讚一讚讚讚讚讚一讚讚一讚讚讚讚讚讚
讚讚讚讚讚一讚讚讚讚一讚讚一讚讚一讚讚讚讚
讚讚讚一一一一一讚讚一一一一一一一一讚讚讚
讚讚讚讚讚一讚讚讚一一讚讚讚一讚讚讚讚讚讚
讚讚讚讚讚一讚讚一讚一讚讚讚一讚讚讚讚讚讚
讚讚讚讚讚一讚讚讚讚一一一一一一一讚讚讚讚
讚讚讚讚讚一讚一讚讚一讚讚讚一讚讚讚讚讚讚
讚讚讚讚讚一一讚讚讚一讚讚讚一讚讚讚讚讚讚
讚讚讚一一一讚讚讚讚一一一一一一一讚讚讚讚
讚讚讚一讚一讚讚讚讚一讚讚讚一讚讚讚讚讚讚
讚讚讚讚讚一讚讚讚讚一讚讚讚一讚讚讚讚讚讚
讚讚讚讚讚一讚讚讚讚一讚讚讚一讚一讚讚讚讚
讚讚讚一一一讚讚讚讚一一一一一一一一讚讚讚
讚讚讚讚一讚讚讚讚讚一讚讚讚讚讚讚讚讚讚讚
讚讚讚讚讚讚讚讚讚讚讚讚讚讚讚讚讚讚讚讚讚
------
︿︿ |
發表時間：2003-09-14 01:33:25
IP:61.64.xxx.xxx 未訂閱
系統時間：2024-05-20 10:07:32
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |