Implement Windows ' mouse hook function with Delphi

Source: Internet
Author: User
Tags windows insider

Delphi is a Pascal-based Windows programming tool with a very powerful function. However in Delphi's help
File, the description of Windows API functions follows the format of the VC, as with VCs, the use of many API functions
Without giving an example, it is vague to some of the API functions inside the system, which brings inconvenience to programmers.
The author only in Windows programming in the mouse hook function (hook) Implementation, for example to illustrate.
The mouse hook function can also be called a mouse message filter, which is a callback (callback) function,
System calls. If the address of the mouse hook function is installed with Setwindowshook or SetWindowsHookEx, each
When you move the mouse over the screen, the system gives control to the mouse hook function, which allows us to have the opportunity to
The mouse hook function intercepts various mouse messages and displays them before they are delivered to the application queue.
Change them or pass directly to the next default mouse hook function. Note that the mouse hook function intercepts the system-level
messages, rather than window messages within a single application queue, the system sends mouse messages to each application queue
You can use the mouse hook function to intercept.
VC Spy and Delphi Winspy are installed hook function to intercept a variety of system-level messages, which
Includes mouse hook function, keyboard hook function, window hook function and so on. We can install the mouse hook function to
Clone a own spy, when the mouse moves, we immediately get the system (including non-preemptive Windows3.1 and
Preemptive Windows95) control, in the mouse hook function within the real-time interception of mouse messages, showing the location of the mouse
and status as well as the mouse under the window's handle, title bar, window class, window process address and so on. Of course, it can be like "English-Chinese"
and "PowerWord" like in the mouse hook function call InvalidateRect (), InvalidateRgn () to get the screen
The words under the mouse on the screen. (For more information on screen capture, please see the author's "in-depth Windows insider adventure" Chinese computer News
1998, issue 81st).

The original code and detailed comments for the main program spy and its dynamic connection library Mousedll are as follows:
{*****************************************************
File:mousedll. DPR[email protected]1998/11/18
〉dll:mousedll. Dll
Export:sethook used to install the mouse hook function mouseproc
Unhook lifting the installation of the mouse hook function mouseproc
Mouseproc Mouse hook function itself
*****************************************************}
Library Mousedll;

Uses
Mousep in ' Mousep. PAS ' {Form1};
Exports
Sethook,
Unhook,
Mouseproc;
{$R *. RES}
Begin
End.


{*************************************************************
File:Mousep.pas [email protected]
Implementation of Sethook Unhook Mouseproc 3 output functions
*************************************************************}
Unit mousep;

Interface

Uses
Sysutils, Wintypes, Winprocs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Stdctrls;

{You can also have a variable of form type in a DLL}
Type
TForm1 = Class (Tform)
Label1:tlabel; {Show wparam}
Label2:tlabel; {Show LParam}
Label3:tlabel; {show x, y}
Label4:tlabel; {Show HWND}
Label5:tlabel; {Show window text}
Label6:tlabel;
Label7:tlabel; {Show Window class}
Private
{Private declarations}
Public
{Public declarations}
End

function Sethook:bool;export;
function Unhook:bool;export;
function Mouseproc (code:integer;w:integer;l:longint): Bool;export;

Var
  Form1:tform1;
  Idhook:longint;
  Formok:bool;
Implementation
 {*********************************************************************
  Declaration of the installation function SetWindowsHookEx (),
  in Delphi if the function Setwindowshook () is not required to be declared.
  Microsoft says function Setwindowshook has been deprecated in Windows3.1 and is still reserved for compatibility with Windows3.0.
  Actually the function Setwindowshook is still available in Windows3.1 and Windows95.
 {*********************************************************************}
 function SetWindowsHookEx (id:integer;proc:tfarproc;hinst,htask:thandle):
          longint;far;external ' user ';
{$R *. DFM}

{Install mouse hook function Mouseproc}
function Sethook:bool;
Var
Hinst:thandle; {The Dynamic Connection library's own module handle}
Proc:tfarproc; {The address of the mouse hook function Mouseproc}
Begin
{Create Form1} in the Dynamic connection library
If Formok=false then form1:=tform1.create (application) else exit;
Formok:=true; {After installing Form1, set Formok, do not install Form1}
{Application of the Dynamic Connection library refers to: calling the main program of the Dynamic Connection library}
Form1.show;

{Do not let the system menu double-click to close Form1}
Form1. Bordericons:=form1. Bordericons-[bisystemmenu];

Hinst:=getmodulehandle (' Mousedll ');
{Get Mousedll.dll's module handle, which is the dynamic Connection library's own module handle}

Proc:=getprocaddress (hinst, ' mouseproc ');
Idhook:=setwindowshookex (wh_mouse,proc,hinst,0);
{After installing the mouse hook with the Wh_mouse parameter, the system automatically calls the Mouseproc hook when moving the mouse.}
If Idhook =0 then sethook:=false else sethook:=true;
End

{Remove the mouse hook function Mouseproc installation}
function Unhook:bool;
Begin
If Formok=true then form1.free else exit; {Check if Form1 is closed}
Formok:=false; {Form1 is turned off, setting formok=0}
If Idhook=0 then exit;
UnhookWindowsHookEx (Idhook);
Unhook:=true;
End

{Mouseproc is not called by the application, but is called by the system after the mouse is moved}
function Mouseproc (code:integer;w:integer;l:longint): bool;
Var
P:^tmousehookstruct;
Poff:word;
Pseg:word;
Pmemo:pchar;
Begin
If Code<0 then BEGIN
Mouseproc:=true;
CallNextHookEx (idhook,0,w,l);
End
If Code=hc_noremove then form1.caption:= ' Hc_noremove ';
form1.caption:= ' Mouse hook ';
Mouseproc:=false;
{Display the wparam parameter from the system, W is the identifier of various mouse messages}
form1.label1.caption:= ' wparam= ' +inttostr (w);
{Display the lparam parameter from the system, L is the address of the MOUSEHOOKSTRUCT structure}
form1.label2.caption:= ' lparam= ' +inttostr (l);

Poff:=loword (l); {Get the low 16 bits of L}
Pseg:=hiword (l); {Get high 16 bits of L}
P:=ptr (Pseg,poff); {composition pointer to MOUSEHOOKSTRUCT structure}

{Displays the x, y coordinates of the mouse on the screen}
form1.label3.caption:= ' pt.x= ' +inttostr (p^.pt.x)
+ ' pt.y= ' +inttostr (P^.PT.Y);
{Display the window's handle under the mouse on the screen}
form1.label4.caption:= ' hwnd= ' +inttostr (P^.hwnd);

Pmemo:=stralloc (20);
GetWindowText (P^.HWND,PMEMO,20-1);
{Displays the title bar of the mouse window below}
Form1.label5.caption:=strpas (Pmemo);

GetClassName (P^.HWND,PMEMO,20-1);
{Displays the class of the mouse window below}
Form1.label6.caption:=strpas (Pmemo);

Strdispose (Pmemo);

End
End.

The main program original code is as follows:
{*******************************************
Maintry. DPR [email protected]
******************************************}
Program Maintry;

Uses
Forms,
Tryp in ' Tryp. PAS ' {Form1};

{$R *. RES}

Begin
Application.createform (TForm1, Form1);
Application.Run;
End.

{*********************************************
TRYP. PAS [email protected]
********************************************}

Unit TRYP;

Interface

Uses
Sysutils, Wintypes, Winprocs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Stdctrls;

Type
TForm1 = Class (Tform)
Button1:tbutton; {Install Sethook button}
Button2:tbutton; {Release Unhook button}
Label1:tlabel; {Show installation, release succeeded}
Procedure Button1Click (Sender:tobject);
Procedure Button2click (Sender:tobject);
Private
{Private declarations}
Public
{Public declarations}
End

Var
Form1:tform1;

Implementation
function sethook:bool;far;external ' Mousedll ';
function unhook:bool;far;external ' Mousedll ';
{Automatically load module mousedll.dll after declaration}
{$R *. DFM}

Procedure Tform1.button1click (Sender:tobject);
Begin
If Sethook then label1.caption:= ' Set hook ok '; {Install mouse hook function}
End

Procedure Tform1.button2click (Sender:tobject);
Begin
If Unhook then label1.caption:= ' unhook OK '; {Remove mouse hook function}
End

End.

http://blog.csdn.net/diligentcatrich/article/details/6934092

Implement Windows ' mouse hook function with Delphi

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.