cpkeyblockhook.pas

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

{*****************************************************************************
 * UnitName:  CPKeyBlockHook
 * Version:   1.5
 * Created:   10/06/2004
 * Updated:   29/03/2005
 * Purpose:   NT Keyboard Blocking Hook Unit and DLL.
 * Developer: BITLOGIC Software
 * Email:     [e-mail]
 * WebPage:   http://www.bitlogic.co.uk
 *****************************************************************************}

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

  29/03/2005 Updated to Version 1.5
  
  CPKeyBlockHook.pas Updated:
  Changed TKeyNames.KeyChar to WideChar for supporting Unicode characters and
  Foreign Keyboard Layouts with dead key character keys.

  KeyBlockHook.dll Updated:
  Fixed pMMF.BlockKeys.HK_ALT_F4 in HookSystemKeyboard_Proc which was prevented
  ALT + F4 (Close Window) from being Blocked.

  29/01/2005 Updated to Version 1.4

  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 (BlockKeys,DisableKeyboard,BlockSystemKeys,HookInjected). 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.

  23/11/2004 Updated to Version 1.3

  Added a new HookInjected boolean parameter to the HookStart procedure which
  will enable or disable the hooking of Injected Keys sent via the Win32 API
  function call to keyb_event.

  Added Boolean HookInjected parameter to TFncHookStart function
  Added Boolean Injected parameter to TKeyHookedEvent procedure

  05/07/2004 Updated to Version 1.2

  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 Boolean Blocked to TKeyHookedEvent to indicate if the Key was blocked
  by the Hook.

  30/06/2004 Updated to Version 1.1

  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 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 CPKeyBlockHook;

interface

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

type
 { DLL Function Hook_Start }
 TFncHookStart = function(LicenceCode: string; WinHandle : HWND; MsgToSend : DWORD; DisableKeyboard, BlockSystemKeys, HookInjected: boolean; BlockKeys: TBlockKeys): 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, BlockSystemKeys, HookInjected: boolean; BlockKeys: TBlockKeys): 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: WideChar; //Char;
 KeyExtName: array[0..100] of Char;
 end;

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

type
  TCPKeyBlockHook = class(TComponent)
  private
   FHookLibLoaded: boolean;
   FLicenceCode: string;
   FWindowHandle: HWND;
   FUserHookMsg: DWORD;
   FDisableKeyboard: boolean;
   FBlockSystemKeys: boolean;
   FHookInjected: 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 SetBlockSystemKeys(AValue: boolean);
   procedure SetHookInjected(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
   BlockKeys: TBlockKeys;
   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 BlockSystemKeys: boolean read FBlockSystemKeys write SetBlockSystemKeys;
   property HookInjected: boolean read FHookInjected write SetHookInjected;
   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 TCPKeyBlockHook.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 TCPKeyBlockHook.SetNoneStr(AValue: string);begin;end;
procedure TCPKeyBlockHook.SetEnabled(AValue: boolean);begin;end;

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

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

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

procedure TCPKeyBlockHook.SetBlockSystemKeys(AValue: boolean);
begin
if AValue = FBlockSystemKeys then exit;
FBlockSystemKeys := AValue;
end;

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

constructor TCPKeyBlockHook.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;
FBlockSystemKeys := False;
FHookInjected := False;
keyreps := 0;
GetKeyboardLayoutName(@KLayout);
FKeyLayout := KLayout;
end;

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

procedure TCPKeyBlockHook.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 TCPKeyBlockHook.HookMsg(var msg : TMessage);
var
FKeyState: TKeyStates;
FKeyNames: TKeyNames;
VKeyName : array[0..100] of char;
VKeyChar : WideChar;//array[1..2] of Char;
KBS : TKeyboardState;
KeyHookStruct : PKbDllHookStruct;
ScanCode: Integer;
WasBlocked: Boolean;
WasInjected: 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);
  WasInjected := (FKeyState.keyinfo.flags and LLKHF_INJECTED) <> 0;

  //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;

  ScanCode := MapVirtualKey(KeyHookStruct.vkCode, 0) shl 16;
  if FKeyState.ExtendedKey then ScanCode := ScanCode or $01000000;
  GetKeyNameText(ScanCode ,@VKeyName,SizeOf(VKeyName));
  move(VKeyName,FKeyNames.KeyExtName,SizeOf(VKeyName));

  GetKeyboardState(KBS);
  //if ToAscii(KeyHookStruct.vkCode, KeyHookStruct.scanCode, KBS, @VKeyChar, 0) <> 0
  if ToAsciiEx(KeyHookStruct.vkCode, KeyHookStruct.scanCode, KBS, @VKeyChar, ord(FKeyState.MenuKey),GetKeyboardLayout(0)) <> 0
  then begin
       if FKeyState.ShiftDown then FKeyNames.KeyChar := VKeyChar //AnsiUpperCase(VKeyChar) ??
       else FKeyNames.KeyChar := VKeyChar; //VKeyChar[1];
       end;

  if Assigned(FOnKey) then FOnKey(self,FKeyState,FKeyNames,WasBlocked,WasInjected);
  //msg.Result := 0;
end;

function TCPKeyBlockHook.Start_KeyHook: Boolean;
begin
Result := False;
if FEnabled then exit;
if Not LoadHookLib then exit;
if PFncHookStart(FLicenceCode,FWindowHandle,FUserHookMsg, FDisableKeyboard, FBlockSystemKeys, FHookInjected, BlockKeys) then begin
   FEnabled := True;
   Result := True;
   end;
end;

function TCPKeyBlockHook.Stop_KeyHook: Boolean;
begin
Result := False;
Try
if FEnabled then Result := PFncHookStop;
FEnabled := False;
Finally
UnloadHookLib;
End;
end;

function TCPKeyBlockHook.UpdateHook: boolean;
begin
Result := False;
if FEnabled then Result := PFncHookUpdateHook(FDisableKeyboard, FBlockSystemKeys, FHookInjected, BlockKeys);
end;

function TCPKeyBlockHook.LoadHookLib: boolean;
begin
result := false;
if FHookLibLoaded then exit;
DllHandle := LoadLibrary(PChar(HOOKLIBNAME));
if DllHandle <> 0 then
   begin
   { Get pointers to DLL Hook Functions }
   PFncHookStart := GetProcAddress(DllHandle, 'SystemKeyboardHook_Start');
   PFncHookStop := GetProcAddress(DllHandle, 'SystemKeyboardHook_Stop');
   PFncHookGetData := GetProcAddress(DllHandle, 'SystemKeyboardHook_GetData');
   PFncHookUpdateHook := GetProcAddress(DllHandle, 'SystemKeyboardHook_UpdateHook');
   if Assigned(PFncHookStart) and Assigned(PFncHookStop) and Assigned(PFncHookGetData) and Assigned(PFncHookUpdateHook) then
      begin
      FHookLibLoaded := True;
      result := true;
      end else FreeLibrary(DllHandle);
   end;
end;

function TCPKeyBlockHook.UnloadHookLib: boolean;
begin
result := false;
if DllHandle <> 0 then
   begin
   FreeLibrary(DllHandle);
   FHookLibLoaded := false;
   result := true;
   end;
End;

initialization

finalization
 if DllHandle <> 0 then FreeLibrary(DllHandle);


end.