15 February, 2007

Global mouse hook in Delphi

Hello everyone!

On my primary job I have changed my mouse. At home I have A4Tech optical mouse with a scroll but on my job I have Genius mouse (optical and with a scroll as well). At home I use my scroll also as a middle button and when I press it the window which is under cursor getting minimized. It was easy to achieve this behavior because software which comes with my A4Tech mouse supports this functionality. Another case is my Genius mouse at work. Software which bundled with it does not allow to minimize the window under the cursor when the scroll button is pressed. Pity!

But solution always can be found! I decided to write a global mouse hook on Delphi which will intercept middle (scroll) button click (WM_NCMBUTTONDOWN and WM_MBUTTONDOWN messages), check if any top level window is under the cursor and if yes then minimize that window.

The code is pretty simple.

We need two projects: one - which runs the hook and then kills it; the other - the hook itself (it is supposed to be a DLL because it is a global hook). Nothing difficult (at least if you what is DLL and how to use them)!

Here is the mouse hook (WH_MOUSE) implementation:

library MiddleButton;

uses
Windows,
Messages;

const
MemMapFile
= 'Igor_thief';
type
PDLLGlobal
= ^TDLLGlobal;
TDLLGlobal
= packed record
HookHandle: HHOOK;
end;

var
GlobalData: PDLLGlobal;
MMF: THandle;

{$R *.res}

function HookProc(Code: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
CurrWND: THandle;
begin
if Code < 0 then
begin
Result :
= CallNextHookEx(GlobalData^.HookHandle, Code, wParam, lParam);
exit;
end; // if

if (wParam = WM_NCMBUTTONDOWN) or (wParam = WM_MBUTTONDOWN) then
begin
CurrWND :
= PMouseHookStruct(lParam)^.hwnd;
CurrWND :
= GetAncestor(CurrWND, GA_ROOTOWNER);
SendMessage(CurrWND, WM_SYSCOMMAND, SC_MINIMIZE,
0);
end; // if

Result :
= CallNextHookEx(GlobalData^.HookHandle, Code, wParam, lParam);
end;

procedure CreateGlobalHeap;
begin
MMF:
= CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0,
SizeOf(TDLLGlobal), MemMapFile);

if MMF = 0 then begin
MessageBox(
0, 'CreateFileMapping -', '', 0);
exit;
end;

GlobalData:
= MapViewOfFile(MMF, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(TDLLGlobal));
if GlobalData = nil then begin
// не смогди создать отображение
CloseHandle(MMF);
MessageBox(
0, 'MapViewOfFile -', '', 0);
end;
end;

procedure DeleteGlobalHeap;
begin
if GlobalData<>nil then
UnmapViewOfFile(GlobalData);

if MMF<> INVALID_HANDLE_VALUE then
CloseHandle(MMF);
end;

procedure RunHook; stdcall;
begin
GlobalData^.HookHandle:
= SetWindowsHookEx(WH_MOUSE, @HookProc, HInstance, 0);
if GlobalData^.HookHandle = INVALID_HANDLE_VALUE then
begin
MessageBox(
0, 'Error :)' , '' , MB_OK);
Exit;
end;
end;

procedure KillHook; stdcall;
begin
if (GlobalData<>nil) and (GlobalData^.HookHandle<>INVALID_HANDLE_VALUE) then
UnhookWindowsHookEx(GlobalData^.HookHandle);
end;

procedure DLLEntry(dwReason: DWORD);
begin
case dwReason of
DLL_PROCESS_ATTACH: CreateGlobalHeap;
DLL_PROCESS_DETACH: DeleteGlobalHeap;
end;
end;

exports
KillHook,
RunHook;

begin
DLLProc:
= @DLLEntry;
DLLEntry(DLL_PROCESS_ATTACH);
end.
And here is an implementation of the hook launcher:
unit RunMiddleButton;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;

type
TfrmMain
= class(TForm)
btnRunHook: TButton;
btnKillHook: TButton;
procedure btnRunHookClick(Sender: TObject);
procedure btnKillHookClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

procedure RunHook; stdcall; external 'MiddleButton.dll' name 'RunHook';
procedure KillHook; stdcall; external 'MiddleButton.dll' name 'KillHook';

var
frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.btnRunHookClick(Sender: TObject);
begin
RunHook;
end;

procedure TfrmMain.btnKillHookClick(Sender: TObject);
begin
KillHook;
end;

end.

If you don't know what is HOOK and how it works at all then you shoulf go and read MSDN.
Good luck! Study hard!

14 comments:

Anonymous said...

nice
I need a dll that would let you know when someone pressed the Right mouse button?

Would that be hard for you to make?

iSkomorokh said...

I am glad you liked my approach. It would not be hard to implement your task. I can do it at any time.

Anonymous said...

I really like this post! Now I have a template to build my own hooks. I'll post a link to ya post :-) thx

iSkomorokh said...

Bob, I am very glad that you liked the post. BTW, I use this code as a hook template too. It's very good that my code sample is useful. That's inspires me to write more. I am going to extend this post a little bit later. Will show how to communicate between hook and your own stand alone application using user messages (interprocess communication).

Thanks for linking to my blog!

Anonymous said...

Very nice. How can I use it to capture a text (a word) out of my Delphi application?

iSkomorokh said...

Marcos
Very nice. How can I use it to capture a text (a word) out of my Delphi application?


Sorry but this is beyond of this article. Actually, I don't have time to write about this now. May be later I'll show such a sample. Currently very busy with one project. As you see I even don't have time to write new posts :( So, later.

Anonymous said...

im trying the same for a keyboard hook. This is my code:

library WireForge;

{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }

uses
SysUtils, Windows,Messages;


var
KBHook: HHOOK;
{$R *.res}
function KBHookProc(Code: integer; wParam: WParam; lParam: LParam): LRESULT; stdcall;
end;
procedure CreateHook; stdcall;
begin
KBHook:=SetWindowsHookEx(WH_KEYBOARD,@KBHookProc, Hinstance, 0);
end;

procedure DestroyHook; stdcall;
begin
UnhookWindowsHookEx(KBHook);
end;

exports CreateHook,DestroyHook;


begin
end.

-----------------------------
I get the following errors:

[Error] WireForge.DPR(32): EXPORTS allowed only at global scope

[Error] WireForge.DPR(36): ';' expected but '.' found

[Error] WireForge.DPR(39): Declaration expected but end of file found

Anonymous said...

Great article! This site also has some great Delphi tutorials for a more advanced look at business applications including encryption, Excel and Word COM and much more.

Take a look:

Delphi Tutorials

Anonymous said...

Thanks for the nice post!

vlais said...

Igor,
like your approach!
Little help needed.
Can you wrote a code that will during app installation change system mouse behavior in theese way:
We all know that double left mouse click select a word under mouse in almost every MS/Windows apps (WORD, BROWSER, ETC). I just want to add COPYTOCLIPBOARD after that. Want to make babylon like application. I can sniff clipboard, but how to easy put the word in it. Need system mouse beghavior change. Or just read the text under the mouse in every application. My app will be in bckgnd and wait for word to translate it.
Help, please
Thanks in advance
sinisa.vlais@gmail.com

iSkomorokh said...

Sinisa, I can write such code, but unfortunately I don't have time for this right now. Maybe I'll do this later. Keep in touch.

Unknown said...

Wonderful
It works very well with the exception of some programs written in Visual C++
What can be modified to work with such programs?

Thank you

Unknown said...

Awesome. Thanks for sharing all about Delphi.

Pol said...

Based on your code I created "Alt+Up on Middle Click in IDE" program. So Delphi editor navigates to symbol definition when you middle click, just like it does when you ctrl+click. Thanks again!
http://pol84.tumblr.com/post/24073283460/code-navigation-on-middle-click-in-delphi-ide