cpkeyhook.pas

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

{*****************************************************************************
 * UnitName:  CPKeyHook
 * Version:   1.9
 * Created:   02/03/2006
 * Purpose:   Global Keyboard Hook Unit and DLL.
 * Developer: BITLOGIC Software
 * Email:     [e-mail]
 * WebPage:   http://www.bitlogic.co.uk
 *****************************************************************************}

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

  02/03/2006 Updated to Version 1.9

  Version 1.9 now includes support for Low Level Keyboard Hooking using the
  WH_KEYBOARD_LL method as well as the WH_KEYBAORD method. The LowLevel Hooks
  can capture Injected keyboard events generated by calls to the Win32 API
  function keybd_event.

  Two new Properties have been introduced to support the new LowLevel Hooking
  methods: LowLevelHook, HookInjected: Boolean

  Set LowLevelHook to True to use the LowLevelHooking Method.
  Set HookInjected to True to capture Injected calls from keybd_event.
  Set HookInjected to False to ignore Injected calls from keybd_event.

  IMPORTANT: THe default Hooking method is WH_KEYBAORD as before.
  HookInjected is only supported when using the LowLevel Hooking method.

  23/04/2005 Updated to Version 1.8 Experimental

  Experimental version for keyboards using international dead-key character set.
  New Properties in TKeyState: DeadKey, DoubleKey: Boolean.
  Reverted TKeyNames.KeyChar back to Char Type.

  29/03/2005 Updated to Version 1.7
  
  Changed TKeyNames.KeyChar to WideChar for supporting Unicode characters and
  Foreign Keyboard Layouts that have dead key character keys.

  29/01/2005 Updated to Version 1.6

  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 (DisableKeyboard). 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.

  04/07/2004 Updated to Version 1.5

  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.

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

  Added new property (HookLibLoaded: Boolean) to indicate if the DLL and functions
  successfully loaded. The Keyboard Hook 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 CPKeyHook;

interface

{$IFDEF VER140} 
  {$DEFINE USE_FORMS}
{$ENDIF}
{$IFDEF VER130}
  {$DEFINE USE_FORMS}
{$ENDIF}
{$IFDEF VER120}
  {$DEFINE USE_FORMS}
{$ENDIF}
{$IFDEF VER100}
  {$DEFINE USE_FORMS}
{$ENDIF}

uses Windows, Messages, Classes {$IFDEF USE_FORMS},Forms{$ENDIF}, Sysutils;

const
  HOOKLIBNAME = 'keyhook.dll';
  WM_KEYHOOKMSG: DWORD = WM_USER+100;

  LLKHF_EXTENDED = KF_EXTENDED shr 8;
  LLKHF_INJECTED = $00000010;
  LLKHF_ALTDOWN = KF_ALTDOWN shr 8;
  LLKHF_UP = KF_UP shr 8;
  LLMHF_INJECTED = $00000001;

{type
  PHookParams = ^THookParams;
  THookParams = record
    wParam: WPARAM;
    lParam: LPARAM;
    KBS: TKeyboardState;
    end;}
type
 PKbDllHookStruct = ^TKbDllHookStruct;
 TKbDllHookStruct = record
         vkCode: DWORD;
         scanCode: DWORD;
         flags: DWORD;
         time: DWORD;
         dwExtraInfo: DWORD;
         end;

type
  PMMFData = ^TMMFData;
  TMMFData = record
    NextHook : HHOOK;
    WinHandle : HWND;
    MsgToSend : DWORD;
    BlockKeys : boolean;
    {HookParams: THookParams;}
  end;

type
  { DLL Function Hook_GetData }
 {TFncHookGetData = function: PHookParams; stdcall;}

 { DLL Function Hook_Start }
 TFncHookStart = function(LicenceCode: string; WinHandle : HWND; MsgToSend : DWORD; DisableKeyboard: Boolean): boolean; stdcall;
 { DLL Function Hook_Stop }
 TFncHookStop = function: boolean; stdcall;
 { DLL Function Hook_UpdateHook }
 TFncHookUpdateHook = function(DisableKeyboard: boolean): boolean; stdcall;

 { DLL Function Hook_StartLL LowLevel Hook }
 TFncHookStartLL = function(LicenceCode: string; WinHandle : HWND; MsgToSend : DWORD; DisableKeyboard, HookInjected: boolean): boolean; stdcall;
 { DLL Function Hook_StopLL LowLevel Hook }
 TFncHookStopLL = function: boolean; stdcall;
 { DLL Function Hook_UpdateHookLL LowLevel Hook }
 TFncHookUpdateHookLL = function(DisableKeyboard, HookInjected: boolean): boolean; stdcall;
 { DLL Function Hook_GetDataLL LowLevel Hook }
 TFncHookGetDataLL = function: PKbDllHookStruct; stdcall;

type
TKeyStates = packed record
  KeyDown : Boolean;
  ShiftDown: Boolean;
  AltDown: Boolean;
  CtrlDown: Boolean;
  ExtendedKey: Boolean;
  MenuKey: Boolean;
  KeyRepeated: Boolean;
  RepeatCount: integer;
  DeadKey: boolean;
  DoubleKey: boolean;
  InjectedKey: boolean;
  KeyInfo: TKbDllHookStruct;
  end;

TKeyNames = packed record
 KeyChar: Char;
 {KeyChar: WideChar;}
 KeyExtName: array[0..100] of Char;
 end;

type
TKeyHookedEvent = procedure(Sender: TObject; AKeyStates: TKeyStates; AKeyNames: TKeyNames) of object;

type
  TCPKeyHook = class(TComponent)
  private
   FHookLibLoaded: boolean;
   FLicenceCode: string;
   FWindowHandle: HWND;
   FUserHookMsg: DWORD;
   FDisableKeyboard: boolean;
   FHookInjected: boolean;
   FLowLevelHook: boolean;
   FEnabled: Boolean;
   FKeyboardLayout: string;
   FKeyboardLayoutHandle: HKL;
   FOnKey: TKeyHookedEvent;
   procedure SetEnabled(AValue: boolean);
   procedure SetNoneStr(AValue: string);
   procedure SetLicenceCode(AValue: string);
   procedure SetUserHookMsg(AMsg: DWORD);
   procedure SetDisableKeyboard(AValue: boolean);
   procedure SetHookInjected(AValue: boolean);
   procedure SetLowLevelHook(AValue: boolean);
   procedure WndProc(var Msg: TMessage);
   procedure ProcessHookMsg(AMsg : TMessage);
   procedure ProcessHookMsgLL(AMsg : TMessage);
   function CheckDLLFncPtrs: boolean;
   function LoadHookLib: boolean;
   function UnloadHookLib: boolean;
  protected
   procedure HookMsg(var msg : TMessage); //message WM_KEYHOOKMSG;
   procedure DeallocateHWnd(Wnd: HWND);
  public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
   function Start_KeyHook: boolean;
   function Stop_KeyHook: boolean;
   function UpdateHook: boolean;
  published
   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 DisableKeyboard: boolean read FDisableKeyboard write SetDisableKeyboard;
   property HookInjected: boolean read FHookInjected write SetHookInjected;
   property LowLevelHook: boolean read FLowLevelHook write SetLowLevelHook;
   property Enabled: boolean read FEnabled write SetEnabled;
   property KeyboardLayout: string read FKeyboardLayout write SetNoneStr;
   property KeyboardLayoutHandle: HKL read FKeyboardLayoutHandle;
   property OnKey: TKeyHookedEvent read FOnKey write FOnKey;
  end;

var
 DllHandle: HModule;
 PFncHookStart: TFncHookStart;
 PFncHookStop: TFncHookStop;
 PFncHookUpdateHook: TFncHookUpdateHook;

 PFncHookStartLL: TFncHookStartLL;
 PFncHookStopLL: TFncHookStopLL;
 PFncHookUpdateHookLL: TFncHookUpdateHookLL;

 PFncHookGetDataLL: TFncHookGetDataLL;
 keyreps: integer;

implementation

uses
  Dialogs;

{ Modified version of Classes.DeallocateHwnd }
procedure TCPKeyHook.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 TCPKeyHook.SetNoneStr(AValue: string);begin;end;
procedure TCPKeyHook.SetEnabled(AValue: boolean);begin;end;

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

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

procedure TCPKeyHook.SetDisableKeyboard(AValue: boolean);
begin
if AValue = FDisableKeyboard then exit;
FDisableKeyboard := AValue;
end;

procedure TCPKeyHook.SetHookInjected(AValue: boolean);
begin
if AValue = FHookInjected then exit;
FHookInjected := AValue;
end;

procedure TCPKeyHook.SetLowLevelHook(AValue: boolean);
begin
if AValue = FLowLevelHook then exit;
FLowLevelHook := AValue;
end;

constructor TCPKeyHook.Create(AOwner: TComponent);
var
KLayout : array[0..KL_NAMELENGTH] of char;
begin
 inherited Create(AOwner);
 {if not (csDesigning in ComponentState) then}
FHookLibLoaded := False;
FWindowHandle := AllocateHWnd(WndProc);
FEnabled := False;
FUserHookMsg := WM_KEYHOOKMSG;
FDisableKeyboard := False;
FHookInjected := False;
FLowLevelHook := False;