鼠標鉤 - 冷凍程序

我下載了一個鼠標鉤樣本，沒有工作。所以我剝去了所有不必要的東西，並想知道它有什麼不對。當我啓動程序時，它和Delphi都會凍結，我必須通過taskmgr關閉它。鼠標鉤 - 冷凍程序

應用：

type 
... 
    procedure ms(var message: tmessage); message WM_USER+1234; 

    end; 

var 
    MainHookTestForm: TMainHookTestForm; 

implementation 
procedure HookMouse; stdcall; external 'MouseHook.DLL'; // Added stdcalls; 
procedure UnHookMouse; stdcall; external 'MouseHook.DLL'; 

{$R *.dfm}  

procedure TMainHookTestForm.FormCreate(Sender: TObject); 
begin 
    HookMouse; 
end; 

procedure TMainHookTestForm.FormDestroy(Sender: TObject); 
begin 
    UnHookMouse; 
end; 

procedure TMainHookTestForm.ms(var message: tmessage); 
begin 
    Label1.Caption:=format('%d - %d',[message.LParam, message.WParam]); // Edited 
end;

庫：

library MouseHook; 
uses 
    Forms, 
    Windows, 
    Messages; 

var Hook: HHOOK; 
{$R *.res} 

function HookProc(nCode: Integer; MsgID: WParam; Data: LParam): LResult; stdcall; 
var 
    mousePoint: TPoint; 
begin 
    mousePoint := PMouseHookStruct(Data)^.pt; 
    PostMessage(FindWindow('TMainHookTestForm', 'Main'), WM_USER+1234, mousePoint.X, mousePoint.Y); // Edited class name 
    Result := CallNextHookEx(Hook,nCode,MsgID,Data); 
end; 

procedure HookMouse; stdcall; 
begin 
    if Hook = 0 then Hook:=SetWindowsHookEx(WH_MOUSE,@HookProc,HInstance,0); 
end; 

procedure UnHookMouse; stdcall; 
begin 
    UnhookWindowsHookEx(Hook); 
    Hook:=0; 
end; 

exports 
    HookMouse, UnHookMouse; 

begin 
end.

我想這是因爲它得到簡單。凍結髮生在HookMouse的調用中，執行此行時，整個IDE會凍結，我無法進一步調試。但在這個程序中我看不到任何錯誤。

我使用XE2，有沒有什麼幫助。感謝您的故障排除

編輯：我編輯的HookMouse和UnhookMouse呼叫與stdcall;，並找到窗口類的名稱。這似乎是現在的工作很好，它顯示了正確的價值觀，但只有當鼠標光標是不是在應用程序窗口 - 當我把鼠標移動到窗口，它改變了HourGlass和標籤標題停止更新。什麼會造成這種情況？

來源

2012-01-13 Martin Melka

嘗試運行樣品管理員 - 我記得我的VB6窗鉤應用在Windows 7 – 2012-01-13 15:33:28

得到靠不住我運行一個管理員帳戶，但即使rightclicking的exe和運行管理沒有幫助 – 2012-01-13 15:42:23

不知道是否有幫助，但因爲你宣佈'HookMouse'伴t他'stdcall'指令，嘗試從DLL中導入函數時包含它，即'procedure HookMouse; STDCALL;外部'MouseHook.DLL';' – Pateman 2012-01-13 15:46:01

你有幾個問題，你的代碼

1.You缺少stdcall調用約定：

procedure HookMouse; stdcall; external 'MouseHook.DLL'; 
procedure UnHookMouse; stdcall; external 'MouseHook.DLL';

2.You正在改變標題中的主要形式。所以FindWindow（在DLL中）將只能找到一次窗口。您可以使用TMemo進行調試：

procedure TMainHookTestForm.ms(var message: tmessage); 
begin 
    Memo1.Lines.Add(format('%d - %d',[message.LParam, message.WParam])); 
end;

2.1。類名MainHookTestForm不正確。應該是：

FindWindow('TMainHookTestForm', 'Main')

注意牛逼 MainHookTestForm

3.in的HookProc必須使用：

if nCode = HC_ACTION then 
begin 
    mousePoint := PMouseHookStruct(Data)^.pt;  
    PostMessage(FindWindow('TMainHookTestForm', 'Main'), WM_USER+1234, mousePoint.X, mousePoint.Y); 
end; 

Result := CallNextHookEx(Hook,nCode,MsgID,Data);

來源

2012-01-13 17:17:38 kobik

我玩過一段代碼，所以我改變了一些東西。我會相應地更新這個問題。我會嘗試3）雖然 – 2012-01-13 17:22:14

至少評論你的代碼在哪裏你改變它，** **後我發佈了答案。您的類名稱在DLL FindWodow中仍然不正確：應該是：** T ** MainHookTestForm – kobik 2012-01-13 18:03:47

對不起，請查看我答案最底部的編輯部分。 – 2012-01-14 19:52:01

鼠標鉤 - 冷凍程序

回答

相關問題