Solved

Hook in Delphi

Posted on 1998-11-10
15
531 Views
Last Modified: 2010-08-05
I'm a newer in Experts-Exchange. So I haven't got a lot of points to evaluate this question. But I want to write a program that hook Window Mouse Messages. If it's anybody can help, please, show me how to do.
Thanks and best regards.
0
Comment
Question by:pvhoa
  • 5
  • 3
  • 2
  • +4
15 Comments
 
LVL 20

Expert Comment

by:Madshi
Comment Utility
Do you want to hook messages in YOUR application or in another one?
If it's only your app, use Application.OnMessage, else use SetWindowsHookEx(WH_GETMESSAGE,...) or SetWindowsHookEx(WH_MOUSE,...).

Regards, Madshi.
0
 

Author Comment

by:pvhoa
Comment Utility
Thanks,

But I need to have a global hook. And as I know, in C++ global hook need to be installed in a DLL. But I want to know there are any independent way in Delphi or not. Please, if any one can help.

VHOA
0
 
LVL 1

Expert Comment

by:venks
Comment Utility
There is a Hook component in RX Library Ver 2.5 availble from Torry's Delphi Pages (www.torry.ru).You can give it a try
regards
venks
0
 
LVL 8

Expert Comment

by:ZifNab
Comment Utility
Hi pvhoa,

here is code I've got from the web. I can't help you further if you don't give specific code. Maybe you can't, but then this example will help you further.

Can you elaborate more on how to use SetWindowsHookEx?  If possible,
>just enclosed a short piece of code.
OK, take the following and compile it into a dll.
When you call the SetHook function in the dll it sets a global
mouse hook - any mouse messages go to this hook first. If it's a
mousedown on the desktop there's a beep; whether it was a
mousedown on the desktop or not the HookProc calls the next
hook. When you call the UnHookHook function it unhooks the hook.
(I actually use the thing to pop up a menu when I
click on the desktop, if you're curious.)
You wanted a keyboard hook - it took me a while to
figure out how the mouse hook should go a while ago (then
another little while cleaning it up some just now; the original
was my very first Delphi project, what you see here is much
nicer.) If you look at the code below together with the
documentation for SetWindowsHookEx and MouseProc you
should be able to get a global keyboard hook going, I think maybe.
I just noticed that SetHook and UnHookHook are
functions that don't return anything in particular. So sue me.
(The idea is they'd return an error message or something.) The code:

library Hookdemo;
uses  Beeper in 'BEEPER.PAS';exports      

SetHook index 1,
UnHookHook index 2,      
HookProc index 3;

begin  
 HookedAlready:=False;
end.

{**************}
unit Beeper;
interface
uses Wintypes,Winprocs,Messages;
function SetHook:Boolean;export;
function UnHookHook:Boolean;export;
function HookProc(Code:integer; wParam: Word; lParam: Longint): Longint;export;

var HookedAlready:Boolean;
implementation
var  
 ourHook:HHook;  
 DeskTop:hwnd;

function SetHook:Boolean;
 begin
  if HookedAlready then exit;
  DeskTop:=GetDeskTopWindow;
  ourHook:=SetWindowsHookEx(WH_MOUSE,HookProc,HInstance,0);
  {I have smart callbacks turned on or this wouldn't quite work}
  HookedAlready:=True;
end;

function UnHookHook:Boolean;
begin
 UnHookWindowsHookEx(ourHook);
 HookedAlready:=False;
end;

function HookProc(Code:integer; wParam: Word; lParam: Longint): Longint;

begin
 if (wParam=WM_LBUTTONDOWN) and (PMouseHookStruct(lParam)^.hWnd=DeskTop)
     then MessageBeep(0);  
 result:=CallNextHookEx(ourHook,Code,wParam,lParam);
 {If you want to eat a message instead you simply
  leave out the CallNextHookEx part}
end;
end.

And in fact for this particular application subclassing
the desktop window (SetWindowLong) would probably make
more sense than using SetWindowsHookEx. But if you want a
global hook you need a hook, not a subclass.
Author: David Ullrich


Zif.

 
 
 

0
 

Author Comment

by:pvhoa
Comment Utility
Thank mr.ZifNab for your answer. Cause there are some errors in this code, so if it's possible, please, help me more. I tried to correct these errors but no result now. For the first, in function SetWindowsHookEx(WH_MOUSE,HookProc,HInstance,0), we need put address of HookProc function, that means @HookProc instead. But after build all, when I tried to run program in Windows98, my machine is going to crash imediately after calling this function CallNextHookEx(ourHook,Code,wParam,lParam). And these parameters wParam and lParam, cause some unknown resons, don't match real Mouse Messages parameters at all.

Regard subclassing, I didn't try it. But I want to say again thanks to mr. ZifNab. If it's any progress from me, I will post comments imediately.

VHOA
0
 
LVL 20

Expert Comment

by:Madshi
Comment Utility
(1) HookProc has to be stdcall.
(2) You can't simply leave out CallNextHookEx, cause you MUST call it, when "code<0".
(3) Look at the documentation of SetWindowsHookEx. wParam is the identifier of the mouse message. lParam is a pointer to a mouseHookStruct.
(4) Subclassing works only for your own application. SetWindowLong doesn't work with windows that are created by other processes.

Regards, Madshi.
0
 
LVL 8

Expert Comment

by:ZifNab
Comment Utility
sorry pvhoa, that I couldn't answer you earlier. I'm just back from a trip. I've some work to do now... :-(. Soon I'll look at this q'n again. If problems still occur, let me know... first reject my answer, so that others can look at it too.
0
How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

 

Author Comment

by:pvhoa
Comment Utility
Adjusted points to 200
0
 
LVL 4

Expert Comment

by:dwwang
Comment Utility
This site contains a so-called Global mouse hook:
http://www.delphidevelopers.com/delphi/files/mousehook.zip
0
 

Author Comment

by:pvhoa
Comment Utility
Mr. dwwang,

I test this program in Win98 env., and the same thing - Access violation in addr...

May be it's Win98 bug?

Please, try this in Windows 98 and tell me some more if it's possible.

Thanks.
0
 
LVL 5

Expert Comment

by:ronit051397
Comment Utility
pvhoa, post your EMail and I'll send you an example.
0
 

Author Comment

by:pvhoa
Comment Utility
My E-mail: pvhoa@hotmail.com
0
 
LVL 5

Expert Comment

by:ronit051397
Comment Utility
pvhoa, did it helped you?
0
 
LVL 8

Expert Comment

by:ZifNab
Comment Utility
0
 
LVL 1

Accepted Solution

by:
slautin earned 200 total points
Comment Utility
please, look my sample for keys hook.
Interception of all events is executed by means of calling the function SetWindowsHookEx. Given function registers in hook system for determined type of events/messages.
Main is that procedure must always be present in WINDOWS memories. So hook place in DLL and load this DLL from the program. While one program uses DLL, that can be not unloaded from the memory. In the example a hook intercepts a striking the keys "+" and "-", and will send a message to your form (caption 'XXX').
Certainly, example possible to remake under mouse!!!


library skey;

uses wintypes, winprocs, messages;

const

//user messages
wm_ns_Event = wm_user+133; //next event
wm_ps_Event = wm_user+134; //prev event
hookhandle : hHook = 0;

var
    saveEProc : pointer;

function key_hook (code: integer, wparam : word;
   lparam:longint) : longint; export;
var
  H : HWND;
begin
if code >- 0 then
  begin
  if ((wparam = VK_ADD) or (wparam = VK_SUBTRACT)) and
     (lparam and $40000000 = 0) then
     begin
     H := FindWindow('TForm1','XXX');
     if wparam=VK_ADD then
        SendMessage(H, wm_ns_Event,0,0)
     else
        SendMessage(H, wm_ps_Event,0,0);
     end;
     result := 0;
  end
else
  result := CallNextHookEx(hookhandle, code, wparam, lparam);
end;

//when unloading it is necessary to remove hook

procedure localexitproc : far;
begin
 if hookhadle <> 0 then
    begin
    UnhookWindowsHookEx(hookhandle);
    exitproc := SaveExitProc;
    end;
end;

// DLL initialization
begin

hookhandle := SetWindowsHookEx(wh_Keyboard, Key_Hook, hInstance, 0);
if hookhandle = 0 then
    MessageBox(0,'Error!', mb_Ok);
else
    begin
    saveEProc := ExitProc;
    ExitProc := @localexitproc;
    end;
end;

//------------------------

unit Unit1;

//user messages
const

//user messages
wm_ns_Event = wm_user+133; //next event
wm_ps_Event = wm_user+134; //prev event

type
   TForm1 = class (TForm)
   label1:TLabel;
private WM_NextMSG (var M : TMessage)
      message wm_ns_Event;
private WM_PrevMSG (var M : TMessage)
      message wm_ps_Event;
end;

var
 .....
 p : pointer;

implementation

function key_hook : longint; far; external 'skey';

procedure TForm1.WM_NextMSG (var M : TMessage)
begin
    label1.Caption := 'Next message';
end;

procedure TForm1.WM_PrevMSG (var M : TMessage)
begin
    label1.Caption := 'Prev message';
end;

procedure TForm1.FormCreate(sender : TObject)
begin
   p:= @key_hook;
end;

end.

0

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

Suggested Solutions

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
When you create an app prototype with Adobe XD, you can insert system screens -- sharing or Control Center, for example -- with just a few clicks. This video shows you how. You can take the full course on Experts Exchange at http://bit.ly/XDcourse.
You have products, that come in variants and want to set different prices for them? Watch this micro tutorial that describes how to configure prices for Magento super attributes. Assigning simple products to configurable: We assigned simple products…

744 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now