cpkeymaphook.pas

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

{*****************************************************************************
 * UnitName:  CPKeyMapHook
 * Version:   1.1
 * Created:   06/07/2004
 * Updated:   29/01/2005
 * Purpose:   NT Keyboard Mapping Hook Unit and DLL.
 * Developer: BITLOGIC Software
 * Email:     [e-mail]
 * WebPage:   http://www.bitlogic.co.uk
 *****************************************************************************}

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

  29/01/2005 Updated to Version 1.1

  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,KeyMap). 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.

  06/07/2004 Initial Release Version 1.0

  TCPKeyMapHook is an alternative and replacement to TCPKeyBlockHook
  
*****************************************************************************}

unit CPKeyMapHook;

interface

uses Windows, Messages, Classes, Forms, SysUtils, UKeyVars;

const
  HOOKLIBNAME = 'keymaphook.dll';       { Name of the Hook DLL file }
  WM_SYSKEYHOOKMSG: DWORD = WM_USER+202;

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

type
TKeyStates = packed record
  KeyDown : Boolean;
  ShiftDown: Boolean;
  AltDown: Boolean;
  CtrlDown: Boolean;
  ExtendedKey: Boolean;
  MenuKey: Boolean;
  KeyRepeated: Boolean;
  RepeatCount: integer;
  keyinfo: TKbDllHookStruct;
  end;

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

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

type
  TCPKeyMapHook = class(TComponent)
  private
   FHookLibLoaded: boolean;
   FLicenceCode: string;
   FWindowHandle: HWND;
   FUserHookMsg: DWORD;
   FDisableKeyboard: boolean;
   FEnabled: Boolean;
   FKeyLayout: string;
   FOnKey: TKeyHookedEvent;
   procedure SetEnabled(AValue: boolean);
   procedure SetNoneStr(AValue: string);
   procedure SetLicenceCode(AValue: string);
   procedure SetUserHookMsg(AMsg: DWORD);
   procedure SetDisableKeyboard(AValue: boolean);
   procedure WndProc(var Msg: TMessage);
   function LoadHookLib: boolean;
   function UnloadHookLib: boolean;
  protected
   procedure HookMsg(var msg : TMessage); //message WM_KEYHOOKMSG;
   procedure DeallocateHWnd(Wnd: HWND);
  public
   KeyMap: TKeyMap;
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
   function Start_KeyHook: boolean;
   function Stop_KeyHook: boolean;
   function UpdateHook: boolean;
   procedure ResetKeyMap;
   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 Enabled: boolean read FEnabled write SetEnabled;
   property KeyboardLayout: string read FKeyLayout write SetNoneStr;
   property OnKey: TKeyHookedEvent read FOnKey write FOnKey;
  end;

var
 DllHandle: HModule;
 PFncHookStart: TFncHookStart;
 PFncHookStop: TFncHookStop;
 PFncHookGetData: TFncHookGetData;
 PFncHookUpdateHook: TFncHookUpdateHook;
 keyreps: integer;

implementation

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

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

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

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

constructor TCPKeyMapHook.Create(AOwner: TComponent);
var
KLayout : array[0..KL_NAMELENGTH] of char;
begin
 inherited Create(AOwner);
 {if not (csDesigning in ComponentState) then}

FHookLibLoaded := False;
FWindowHandle := Classes.AllocateHWnd(WndProc);
FEnabled := False;
FUserHookMsg := WM_SYSKEYHOOKMSG;
FDisableKeyboard := False;
ResetKeyMap;
keyreps := 0;
GetKeyboardLayoutName(@KLayout);
FKeyLayout := KLayout;
end;

destructor TCPKeyMapHook.Destroy;
begin
TRY
if (FHookLibLoaded and FEnabled) then PFncHookStop;
FINALLY
UnloadHookLib;
DeallocateHWnd(FWindowHandle);
END;
inherited Destroy;
end;

procedure TCPKeyMapHook.WndProc(var Msg: TMessage);
begin
if Msg.Msg = FUserHookMsg then
     try
     HookMsg(Msg);
     except
     Application.HandleException(Self);
     end
  else Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.WParam, Msg.LParam);
end;

procedure TCPKeyMapHook.HookMsg(var msg : TMessage);
var
FKeyState: TKeyStates;
FKeyNames: TKeyNames;
VKeyName : array[0..100] of char;
VKeyChar : array[1..2] of Char;
KBS : TKeyboardState;
KeyHookStruct : PKbDllHookStruct;
ScanCode: Integer;
WasBlocked: Boolean;
begin
  KeyHookStruct := PFncHookGetData;
  FKeyState.keyinfo.vkCode := KeyHookStruct.vkCode;
  FKeyState.keyinfo.scanCode := KeyHookStruct.scanCode;
  FKeyState.keyinfo.flags := KeyHookStruct.flags;
  FKeyState.keyinfo.time := KeyHookStruct.time;
  FKeyState.keyinfo.dwExtraInfo := KeyHookStruct.dwExtraInfo;

  fillchar(VKeyName,SizeOf(VKeyName),#0);
  fillchar(VKeyChar,SizeOf(VKeyChar),#0);
  FKeyNames.KeyChar := #0;

  WasBlocked := Bool(Msg.lParam);

  //FKeyState.KeyDown := (KeyHookStruct.flags AND LLKHF_UP);
  FKeyState.KeyDown := (msg.WParam = WM_KEYDOWN) or (msg.WParam = WM_SYSKEYDOWN);

  FKeyState.CtrlDown := bool(GetAsyncKeyState(VK_CONTROL) AND $00008000);
  //FKeyState.CtrlDown := ((GetKeyState(VK_CONTROL) and (1 shl 15)) <> 0);

  //FKeyState.ShiftDown  := bool(KeyHookStruct.vkCode AND VK_SHIFT);
  FKeyState.ShiftDown  := bool(GetAsyncKeyState(VK_SHIFT) AND $00008000);

  //FKeyState.AltDown := bool(KeyHookStruct.flags AND LLKHF_ALTDOWN);
  FKeyState.AltDown := bool(GetAsyncKeyState(VK_MENU) AND $00008000);

  FKeyState.MenuKey := False; //bool(GetAsyncKeyState(VK_EXECUTE) AND $00008000);
  FKeyState.ExtendedKey := bool(KeyHookStruct.flags AND LLKHF_EXTENDED);

  //FKeyState.KeyRepeated := (msg.lParam AND (1 shl 30)) <> 0;
  FKeyState.KeyRepeated := FKeyState.KeyDown;
  if (FKeyState.KeyRepeated and FKeyState.KeyDown) then inc(keyreps)
  else keyreps := 0;
  FKeyState.RepeatCount := keyreps;

  case KeyHookStruct.vkCode of
  VK_PAUSE: VKeyName := 'VK_PAUSE';
  VK_LSHIFT: VKeyName := 'VK_LSHIFT';
  VK_RSHIFT: VKeyName := 'VK_RSHIFT';
  VK_LCONTROL: VKeyName := 'VK_LCONTROL';
  VK_RCONTROL: VKeyName := 'VK_RCONTROL';
  VK_LMENU: VKeyName := 'VK_LMENU';
  VK_RMENU: VKeyName := 'VK_RMENU';
  VK_BROWSER_BACK: VKeyName := 'VK_BROWSER_BACK';
  VK_BROWSER_FORWARD: VKeyName := 'VK_BROWSER_FORWARD';
  VK_BROWSER_REFRESH: VKeyName := 'VK_BROWSER_REFRESH';
  VK_BROWSER_STOP: VKeyName := 'VK_BROWSER_STOP';
  VK_BROWSER_SEARCH: VKeyName := 'VK_BROWSER_SEARCH';
  VK_BROWSER_FAVORITES: VKeyName := 'VK_BROWSER_FAVORITES';
  VK_BROWSER_HOME: VKeyName := 'VK_BROWSER_HOME';
  VK_VOLUME_MUTE: VKeyName := 'VK_VOLUME_MUTE';
  VK_VOLUME_DOWN: VKeyName := 'VK_VOLUME_DOWN';
  VK_VOLUME_UP: VKeyName := 'VK_VOLUME_UP';
  VK_MEDIA_NEXT_TRACK: VKeyName := 'VK_MEDIA_NEXT_TRACK';
  VK_MEDIA_PREV_TRACK: VKeyName := 'VK_MEDIA_PREV_TRACK';
  VK_MEDIA_STOP: VKeyName := 'VK_MEDIA_STOP';
  VK_MEDIA_PLAY_PAUSE: VKeyName := 'VK_MEDIA_PLAY_PAUSE';
  VK_LAUNCH_MAIL: VKeyName := 'VK_LAUNCH_MAIL';
  VK_LAUNCH_MEDIA_SELECT: VKeyName := 'VK_LAUNCH_MEDIA_SELECT';
  VK_LAUNCH_APP1: VKeyName := 'VK_LAUNCH_APP1';
  VK_LAUNCH_APP2: VKeyName := 'VK_LAUNCH_APP2';
  VK_OEM_1: VKeyName := 'VK_OEM_1';
  VK_OEM_PLUS: VKeyName := 'VK_OEM_PLUS';
  VK_OEM_COMMA: VKeyName := 'VK_OEM_COMMA';
  VK_OEM_MINUS: VKeyName := 'VK_OEM_MINUS';
  VK_OEM_PERIOD: VKeyName := 'VK_OEM_PERIOD';
  VK_OEM_2: VKeyName := 'VK_OEM_2';
  VK_OEM_3: VKeyName := 'VK_OEM_3';
  VK_OEM_4: VKeyName := 'VK_OEM_4';
  VK_OEM_5: VKeyName := 'VK_OEM_5';
  VK_OEM_6: VKeyName := 'VK_OEM_6';
  VK_OEM_7: VKeyName := 'VK_OEM_7';
  VK_OEM_8: VKeyName := 'VK_OEM_8';
  VK_OEM_102: VKeyName := 'VK_OEM_102';
  VK_PROCESSKEY: VKeyName := 'VK_PROCESSKEY';