鼠标钩子

dll

--------------------------------

unit mouseHookdll;


interface


uses  Winapi.Windows, Winapi.Messages, System.SysUtils,System.SysConst,UnitHookConst;


var
  hmappingfile:THandle;
  pshmem:PShareMem;
  firstProcess:boolean;
  nexthook:hhook;




function starthook(sender:HWND;messageid:word):bool;stdcall;
function stophook:bool;stdcall;
procedure getrbutton;stdcall;


implementation


procedure getrbutton;stdcall;
begin
  pshmem^.IfRbutton:=true;
end;


function hookHandler(icode:integer;wparam:WPARAM;lparam:LPARAM):LRESULT; stdcall;export;
begin
  result:=0;
  if icode<0 then
    callnexthookex(nexthook,icode,wparam,lparam);
  case wparam of
  WM_LBUTTONDOWN :
    begin


    end;
  WM_LBUTTONUP:
    begin


    end;
  WM_LBUTTONDBLCLK:
    begin


    end;
  WM_RBUTTONDOWN:
    begin
      if pshmem^.IfRbutton then
      begin
         pshmem^.IfRbutton:=false;
         pshmem^.data2:=pmousehookstruct(lparam)^;
         getwindowtext( pshmem^.data2.hwnd,pshmem^.buffer,1024);
         sendmessage(pshmem^.data1[1],pshmem^.data1[2]+1,wparam,integer(@(pshmem^.data2)));
      end;


    end;
  WM_NCMOUSEMOVE,WM_MOUSEMOVE:
    begin
      pshmem^.data2:= pmousehookstruct(lparam)^;
      getwindowtext( pshmem^.data2.hwnd,pshmem^.buffer,1024);
      sendmessage(pshmem^.data1[1],pshmem^.data1[2],wparam,integer(@(pshmem^.data2)));
    end;
  end;     //case end


end;


function starthook(sender:HWND;messageid:word):bool;stdcall;
begin
  result:=false;
  if nexthook<>0 then  exit;
  pshmem^.data1[1]:=sender;
  pshmem^.data1[2]:=messageid;
  nexthook:=setwindowshookex(wh_mouse,hookhandler,hinstance,0);
  result:=nexthook<>0;
end;


function stophook:bool;stdcall;     //暂停
begin
  if nexthook<>0 then
  begin
    unhookwindowshookex(nexthook);
    nexthook:=0;
  end;
  result:=(nexthook=0);
end;
exports
   starthook, stophook, getrbutton;
//进程初始化
initialization
  hMappingFile := OpenFileMapping(FILE_MAP_WRITE,False,MappingFileName);
  if hMappingFile=0 then
  begin
    hMappingFile := CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,SizeOf(TShareMem),MappingFileName);
    FirstProcess:=true;
  end
  else  FirstProcess:=false;
  if hMappingFile=0 then  exception.Create('不能建立共享内存');
  pShMem :=  MapViewOfFile(hMappingFile,FILE_MAP_WRITE or FILE_MAP_READ,0,0,0);
  if pShMem = nil then
  begin
    CloseHandle(hMappingFile);
    Exception.Create('不能映射共享内存!');
  end;
  if FirstProcess then
  begin
     pShmem^.IfRbutton := false;
  end;
  NextHook:=0;
finalization
   UnMapViewOfFile(pShMem);
   CloseHandle(hMappingFile);


end.

测试的程序

--------------------------------------

unit mousetest;


interface


uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,UnitHookConst;


type
  TForm6 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    Button2: TButton;
    Edit3: TEdit;
    Panel1: TPanel;
    Edit4: TEdit;
    Label1: TLabel;
    Edit5: TEdit;
    Edit6: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure wndproc(var messages:TMessage);override;
  end;


var
  Form6: TForm6;
  hmappingFile:THandle;
  pshmem :PShareMem;
const
  message_id=WM_USER+100;
implementation


{$R *.dfm}
function starthook(sender:HWND;MessageID:word):bool;stdcall;external 'mouseDll.dll';
function stophook:bool;stdcall;external 'mouseDll.dll';
procedure getrbutton;  stdcall;external 'mouseDll.dll';


procedure TForm6.Button1Click(Sender: TObject);
begin
  if button1.Caption='开始' then
  begin
    if starthook(form6.Handle,message_id) then   //开始截取，传递本窗口句柄，及信息id,当处理指定鼠标信息时，系统钩子向本程(form6.handle)发送信息(messageid)
       button1.Caption:='停止';
  end else
  begin
    if stophook then
      button1.Caption:='开始';
  end;


end;


procedure TForm6.Button2Click(Sender: TObject);
begin
  if button1.Caption<>'开始' then
  begin
    edit4.Text:='';
    edit5.Text:='';
    edit6.Text:='';
    getrbutton;
  end;


end;


procedure TForm6.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if button1.Caption='开始' then
  begin


  end else
  begin
    if stophook then
      button1.Caption:='开始';


  end;


end;


procedure TForm6.FormCreate(Sender: TObject);
begin
    pshmem:=nil;
end;


procedure TForm6.WndProc(var messages: TMessage);
var
  x,y:integer;
  s:array[0..255] of char;
begin
  if pshmem=nil then
  begin
    hMappingFile := OpenFileMapping(FILE_MAP_WRITE,False,MappingFileName);
    if hMappingFile=0 then Exception.Create('不能建立共享内存!');
    pShMem :=  MapViewOfFile(hMappingFile,FILE_MAP_WRITE or FILE_MAP_READ,0,0,0);
    if pShMem = nil then
    begin
        CloseHandle(hMappingFile);
        Exception.Create('不能映射共享内存!');
    end;
  end;
  if pShMem = nil then exit;
  if Messages.Msg = message_id then
  begin
    x:=pShMem^.data2.pt.x;
    y:=pShMem^.data2.pt.y;
    edit3.text:='HWND:'+inttostr(pShMem^.data2.hwnd);
    panel1.caption:='x='+inttostr(x)+' y='+inttostr(y);
    edit2.text:='WindowsText:'+string(pShMem^.buffer);
    getClassName(pShMem^.data2.hwnd,s,255);
    edit1.text:='ClassName:"'+string(s)+'"';
  end
  else if Messages.Msg = message_id+1 then
  begin
    edit4.text:=inttostr(pShMem^.data2.hwnd);
    edit5.text:='WindowsText:'+string(pShMem^.buffer);
    getClassName(pShMem^.data2.hwnd,s,255);
    edit6.text:='ClassName:"'+string(s)+'"';
  end
  else Inherited;


end;


end.