cpmousehook.pas

键盘钩子程序及控件, C++ Builder 和DELPHI可用

{*****************************************************************************
 * UnitName:  CPMouseHook
 * Version:   1.3
 * Created:   09/06/2004
 * Updated:   03/05/2005
 * Purpose:   Global Mouse Hook Unit and DLL.
 * Developer: BITLOGIC Software
 * Email:     [e-mail]
 * WebPage:   http://www.bitlogic.co.uk
 *****************************************************************************}

 {*****************************************************************************

  03/05/2005 Updated to Version 1.3

  Added TMouseHookFilters type for setting Hook Filter properties:
  Added Property HidePointer: boolean value to Hide/Disable the Mouse Pointer.
  Added Property InvertPointer: boolean value to Invert/Mirror the Mouse Pointer direction.
  Added Property WrapPointer: boolean value to Wrap the Mouse Pointer at Screen Border.
  Added Property BlockLeftButton: boolean value to Disable the Left Mouse Button.
  Added Property BlockRightButton: boolean value to Disable the Right Mouse Button.
  Added Property BlockMiddleButton: boolean value to Disable the Middle Mouse Button.
  Added Property BlockWheel: boolean value to Disable the Mouse Wheel.
  Added Property SwapButtons: boolean value to Swap the Left and Right Mouse Buttons.
  Added property ScreenMickeyX: Extended readonly Absolute X Screen coordinate of Pointer.
  Added property ScreenMickeyY: Extended readonly Absolute Y Screen coordinate of Pointer;
  Added DLL Function TFncHookInvertPointer
  Added DLL Function TFncHookWrapPointer
  Updated DLL Function TFncHookStart

  29/01/2005 Updated to Version 1.2

  Hard-coded DeallocateHwnd within the unit and also updated the DeallocateHwnd
  procedure which I think could be the cause of some AV's when using the Hook
  within a WinNT Service.

  Added function UpdateHook: boolean;

  The Function UpdateHook will notify the Hook of any changes made to the published
  properties (DisableMouse). This will allow you to update the settings without
  having to stop and start the Hook. To use this function you simply set the new
  properties then call UpdateHook.

  15/09/2004 Updated to Version 1.1

  Added new variable (LicenceCode: string) to MouseHook_Start function

  The Hook DLL is now automatically loaded with the Start_MouseHook function and
  unloaded with the Stop_MouseHook function. The loading of the DLL was removed
  from the TCPMouseHook.OnCreate event to prevent problems if the DLL was missing.

  The Hook DLL is now loaded dynamically using the LoadLibrary function and
  functions into the DLL are obtained by GetProcAddress. This was implemented
  to prevent error message if DLL could not be found.

  Added new property (HookLibLoaded: Boolean) to indicate if the DLL and functions
  successfully loaded. The MouseHook will not start if this is False.

  Added new property (LicenceCode: string) for the DLL Licence check. For trial
  use this property can be left blank. Licenced users should set this property
  with your Licence Code for non-trial use.

*****************************************************************************}

unit CPMouseHook;

interface

uses Windows, Messages, Classes, Forms;

const
  HOOKLIBNAME = 'mousehook.dll';
  WM_MOUSEHOOKMSG: DWORD = WM_USER+200;
  LLMHF_INJECTED = $00000001;
  SCREEN_MICKEYS = 65535;

type
 TMouseHookFilters = record
   DisableMouse: boolean;
   HidePointer: boolean;
   InvertPointer: boolean;
   WrapPointer: boolean;
   BlockLeftButton: boolean;
   BlockRightButton: boolean;
   BlockMiddleButton: boolean;
   BlockWheel: boolean;
   SwapButtons: boolean;
   end;

TMouseStates = packed record
  x: integer;
  y: integer;
  dx: word;
  dy: word;
  Window: Hwnd;
  HitTestCode: Cardinal;
  ExtraInfo: Cardinal;
  ButtonInfo: integer;
  end;

type
 { DLL Function MouseHook_Start }
 TFncHookStart = function(LicenceCode: string; WinHandle : HWND; MsgToSend : DWORD; HookFilters: TMouseHookFilters): boolean; stdcall;
 { DLL Function MouseHook_Stop }
 TFncHookStop = function: boolean; stdcall;
 { DLL Function MouseHook_GetData }
 TFncHookGetData = function: PMouseHookStruct; stdcall;
 { DLL Function MouseHook_UpdateHook }
 TFncHookUpdateHook = function(HookFilters: TMouseHookFilters): boolean; stdcall;
 { DLL Function MouseHook_InvertPointer }
 TFncHookInvertPointer = function(InvertX,InvertY: boolean; var CurrentDX,CurrentDY,PreviousDX,PreviousDY: word; WrapPointer: boolean) : boolean; stdcall;
 { DLL Function MouseHook_WrapPointer }
 TFncHookWrapPointer = function(WrapX,WrapY: boolean; var CurrentDX,CurrentDY: word) : boolean; stdcall;

TMouseHookedEvent = procedure(Sender: TObject; AMouseStates: TMouseStates) of object;

type
  TCPMouseHook = class(TComponent)
  private
   FHookLibLoaded: boolean;
   FLicenceCode: string;
   FWindowHandle: HWND;
   FUserHookMsg: DWORD;
   FEnabled: Boolean;
   FHookFilters: TMouseHookFilters;
   FOnMouse: TMouseHookedEvent;
   procedure SetLicenceCode(AValue: string);
   procedure SetEnabled(AValue: boolean);
   procedure SetNoneStr(AValue: string);
   procedure SetUserHookMsg(AMsg: DWORD);

   procedure SetDisableMouse(AValue: boolean);
   procedure SetHidePointer(AValue: boolean);
   procedure SetInvertPointer(AValue: boolean);
   procedure SetWrapPointer(AValue: boolean);
   procedure SetBlockLeftButton(AValue: boolean);
   procedure SetBlockRightButton(AValue: boolean);
   procedure SetBlockMiddleButton(AValue: boolean);
   procedure SetBlockWheel(AValue: boolean);
   procedure SetSwapButtons(AValue: boolean);      

   function GetScreenMickeyX: Extended;
   function GetScreenMickeyY: Extended;

   procedure WndProc(var Msg: TMessage);
   function LoadHookLib: boolean;
   function UnloadHookLib: boolean;
  protected
   procedure HookMsg(var msg : TMessage); //message WM_MOUSEHOOKMSG;
   procedure DeallocateHWnd(Wnd: HWND);
  public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
   function Start_MouseHook: boolean;
   function Stop_MouseHook: boolean;
   function UpdateHook: boolean;
  published
   property Enabled: boolean read FEnabled write SetEnabled;
   property HookLibLoaded: Boolean read FHookLibLoaded;
   property LicenceCode: string read FLicenceCode write SetLicenceCode;
   property WindowHandle: HWND read FWindowHandle;
   property UserHookMsg: DWORD read FUserHookMsg write SetUserHookMsg;
   property DisableMouse: boolean read FHookFilters.DisableMouse write SetDisableMouse;
   property HidePointer: boolean read FHookFilters.HidePointer write SetHidePointer;
   property InvertPointer: boolean read FHookFilters.InvertPointer write SetInvertPointer;
   property WrapPointer: boolean read FHookFilters.WrapPointer write SetWrapPointer;
   property BlockLeftButton: boolean read FHookFilters.BlockLeftButton write SetBlockLeftButton;
   property BlockRightButton: boolean read FHookFilters.BlockRightButton write SetBlockRightButton;
   property BlockMiddleButton: boolean read FHookFilters.BlockMiddleButton write SetBlockMiddleButton;
   property BlockWheel: boolean read FHookFilters.BlockWheel write SetBlockWheel;
   property SwapButtons: boolean read FHookFilters.SwapButtons write SetSwapButtons;
   property ScreenMickeyX: Extended read GetScreenMickeyX;
   property ScreenMickeyY: Extended read GetScreenMickeyY;
   property OnMouse: TMouseHookedEvent read FOnMouse write FOnMouse;
  end;

var
 DllHandle: HModule;
 PFncHookStart: TFncHookStart;
 PFncHookStop: TFncHookStop;
 PFncHookGetData: TFncHookGetData;
 PFncHookUpdateHook: TFncHookUpdateHook;
 PFncHookInvertPointer: TFncHookInvertPointer;
 PFncHookWrapPointer: TFncHookWrapPointer;
 keyreps: integer;
 mm: dword;
 LastX,LastY: integer;
 LastDX,LastDY: word;

implementation

{ Modified version of Classes.DeallocateHwnd }
procedure TCPMouseHook.DeallocateHWnd(Wnd: HWND);
var
  Instance: Pointer;
begin
  Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC));
  if Instance <> @DefWindowProc then SetWindowLong(Wnd, GWL_WNDPROC, Longint(@DefWindowProc));
  FreeObjectInstance(Instance);
  DestroyWindow(Wnd);
end;

procedure TCPMouseHook.SetNoneStr(AValue: string);begin;end;
procedure TCPMouseHook.SetEnabled(AValue: boolean);begin;end;

procedure TCPMouseHook.SetLicenceCode(AValue: string);
begin
if AValue = FLicenceCode then exit;
FLicenceCode := AValue;
end;

procedure TCPMouseHook.SetUserHookMsg(AMsg: DWORD);
begin
if AMsg = FUserHookMsg then exit;
FUserHookMsg := AMsg;
end;

procedure TCPMouseHook.SetDisableMouse(AValue: boolean);
begin
if AValue = FHookFilters.DisableMouse then exit;
FHookFilters.DisableMouse := AValue;
end;

procedure TCPMouseHook.SetHidePointer(AValue: boolean);
begin
if AValue = FHookFilters.HidePointer then exit;
FHookFilters.HidePointer := AValue;
ShowCursor(Not AValue);
end;

procedure TCPMouseHook.SetInvertPointer(AValue: boolean);
begin
if AValue = FHookFilters.InvertPointer then exit;
FHookFilters.InvertPointer := AValue;
end;

procedure TCPMouseHook.SetWrapPointer(AValue: boolean);