ukeyblockhookdemo.pas

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

unit UKeyBlockHookDemo;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Menus, ExtCtrls, ShellAPI, CPKeyBlockHook;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    skey: TShape;
    salt: TShape;
    sctrl: TShape;
    sshift: TShape;
    sxkey: TShape;
    sblockedkey: TShape;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label8: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    skeyrepeat: TShape;
    lbkeyrepeat: TLabel;
    Panel2: TPanel;
    Label6: TLabel;
    Label7: TLabel;
    GroupBox1: TGroupBox;
    lemail: TLabel;
    lwebpage: TLabel;
    GroupBox2: TGroupBox;
    btStart: TButton;
    btStop: TButton;
    Panel4: TPanel;
    Label9: TLabel;
    cbdisablekeyboard: TCheckBox;
    cbblocksyskeys: TCheckBox;
    GroupBox3: TGroupBox;
    Label2: TLabel;
    Panel3: TPanel;
    memokeylog: TMemo;
    ltotcalls: TLabel;
    lbvkey: TLabel;
    Label1: TLabel;
    lbakey: TLabel;
    lbkeylayout: TLabel;
    lwindowhandle: TLabel;
    luserhookmsg: TLabel;
    lbapp: TLabel;
    lbflags: TLabel;
    lbtime: TLabel;
    lbvkcode: TLabel;
    lbscancode: TLabel;
    lbdwextrainfo: TLabel;
    cb_HK_CTRL_ESC: TCheckBox;
    cb_HK_ALT_TAB: TCheckBox;
    cb_HK_ALT_F4: TCheckBox;
    cb_HK_ALT_ESC: TCheckBox;
    cb_VK_CANCEL: TCheckBox;
    cb_VK_BACK: TCheckBox;
    cb_VK_TAB: TCheckBox;
    cb_VK_RETURN: TCheckBox;
    cb_VK_SHIFT: TCheckBox;
    cb_VK_CLEAR: TCheckBox;
    cb_VK_CONTROL: TCheckBox;
    cb_VK_MENU: TCheckBox;
    cb_VK_PAUSE: TCheckBox;
    cb_VK_CAPITAL: TCheckBox;
    cb_VK_ESCAPE: TCheckBox;
    cb_VK_SPACE: TCheckBox;
    cb_VK_PRIOR: TCheckBox;
    cb_VK_END: TCheckBox;
    cb_VK_HOME: TCheckBox;
    cb_VK_NEXT: TCheckBox;
    Label12: TLabel;
    cb_VK_LEFT: TCheckBox;
    cb_VK_UP: TCheckBox;
    cb_VK_RIGHT: TCheckBox;
    cb_VK_DOWN: TCheckBox;
    cb_VK_SELECT: TCheckBox;
    cb_VK_PRINT: TCheckBox;
    cb_VK_EXECUTE: TCheckBox;
    cb_VK_INSERT: TCheckBox;
    cb_VK_DELETE: TCheckBox;
    cb_VK_SNAPSHOT: TCheckBox;
    cb_VK_HELP: TCheckBox;
    cb_VK_LWIN: TCheckBox;
    cb_VK_RWIN: TCheckBox;
    cb_VK_NUMLOCK: TCheckBox;
    cb_VK_SCROLL: TCheckBox;
    cb_VK_APPS: TCheckBox;
    cb_VK_LSHIFT: TCheckBox;
    cb_VK_RSHIFT: TCheckBox;
    cb_VK_RCONTROL: TCheckBox;
    cb_VK_RMENU: TCheckBox;
    cb_VK_PROCESSKEY: TCheckBox;
    cb_VK_LMENU: TCheckBox;
    cb_VK_F1: TCheckBox;
    cb_VK_F2: TCheckBox;
    cb_VK_F3: TCheckBox;
    cb_VK_F5: TCheckBox;
    cb_VK_F6: TCheckBox;
    cb_VK_F4: TCheckBox;
    cb_VK_F7: TCheckBox;
    cb_VK_F8: TCheckBox;
    cb_VK_F9: TCheckBox;
    cb_VK_F11: TCheckBox;
    cb_VK_F12: TCheckBox;
    cb_VK_F10: TCheckBox;
    cb_VK_A: TCheckBox;
    cb_VK_B: TCheckBox;
    cb_VK_C: TCheckBox;
    cb_VK_E: TCheckBox;
    cb_VK_F: TCheckBox;
    cb_VK_D: TCheckBox;
    cb_VK_G: TCheckBox;
    cb_VK_H: TCheckBox;
    cb_VK_I: TCheckBox;
    cb_VK_K: TCheckBox;
    cb_VK_L: TCheckBox;
    cb_VK_J: TCheckBox;
    cb_VK_M: TCheckBox;
    cb_VK_N: TCheckBox;
    cb_VK_O: TCheckBox;
    cb_VK_Q: TCheckBox;
    cb_VK_R: TCheckBox;
    cb_VK_P: TCheckBox;
    cb_VK_S: TCheckBox;
    cb_VK_T: TCheckBox;
    cb_VK_V: TCheckBox;
    cb_VK_W: TCheckBox;
    cb_VK_U: TCheckBox;
    cb_VK_X: TCheckBox;
    cb_VK_Y: TCheckBox;
    cb_VK_Z: TCheckBox;
    sinjectedkey: TShape;
    Label13: TLabel;
    cbhookinjected: TCheckBox;
    btupdate: TButton;
    KeyHook1: TCPKeyBlockHook;
    procedure btupdateClick(Sender: TObject);
    procedure btStartClick(Sender: TObject);
    procedure btStopClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure lwebpageClick(Sender: TObject);
    procedure lemailClick(Sender: TObject);
    procedure cbdisablekeyboardClick(Sender: TObject);
    procedure cbblocksyskeysClick(Sender: TObject);
    procedure cb_HK_CTRL_ESCClick(Sender: TObject);
    procedure cb_HK_ALT_TABClick(Sender: TObject);
    procedure cb_HK_ALT_F4Click(Sender: TObject);
    procedure cb_HK_ALT_ESCClick(Sender: TObject);
    procedure cb_VK_CANCELClick(Sender: TObject);
    procedure cb_VK_BACKClick(Sender: TObject);
    procedure cb_VK_TABClick(Sender: TObject);
    procedure cb_VK_CLEARClick(Sender: TObject);
    procedure cb_VK_RETURNClick(Sender: TObject);
    procedure cb_VK_SHIFTClick(Sender: TObject);
    procedure cb_VK_LSHIFTClick(Sender: TObject);
    procedure cb_VK_RSHIFTClick(Sender: TObject);
    procedure cb_VK_RCONTROLClick(Sender: TObject);
    procedure cb_VK_RMENUClick(Sender: TObject);
    procedure cb_VK_CONTROLClick(Sender: TObject);
    procedure cb_VK_MENUClick(Sender: TObject);
    procedure cb_VK_PAUSEClick(Sender: TObject);
    procedure cb_VK_CAPITALClick(Sender: TObject);
    procedure cb_VK_ESCAPEClick(Sender: TObject);
    procedure cb_VK_SPACEClick(Sender: TObject);
    procedure cb_VK_PRIORClick(Sender: TObject);
    procedure cb_VK_NEXTClick(Sender: TObject);
    procedure cb_VK_ENDClick(Sender: TObject);
    procedure cb_VK_HOMEClick(Sender: TObject);
    procedure cb_VK_NUMLOCKClick(Sender: TObject);
    procedure cb_VK_SCROLLClick(Sender: TObject);
    procedure cb_VK_APPSClick(Sender: TObject);
    procedure cb_VK_LMENUClick(Sender: TObject);
    procedure cb_VK_LEFTClick(Sender: TObject);
    procedure cb_VK_UPClick(Sender: TObject);
    procedure cb_VK_RIGHTClick(Sender: TObject);
    procedure cb_VK_DOWNClick(Sender: TObject);
    procedure cb_VK_SELECTClick(Sender: TObject);
    procedure cb_VK_PRINTClick(Sender: TObject);
    procedure cb_VK_EXECUTEClick(Sender: TObject);
    procedure cb_VK_SNAPSHOTClick(Sender: TObject);
    procedure cb_VK_INSERTClick(Sender: TObject);
    procedure cb_VK_DELETEClick(Sender: TObject);
    procedure cb_VK_HELPClick(Sender: TObject);
    procedure cb_VK_LWINClick(Sender: TObject);
    procedure cb_VK_RWINClick(Sender: TObject);
    procedure cb_VK_PROCESSKEYClick(Sender: TObject);
    procedure cb_VK_F1Click(Sender: TObject);
    procedure cb_VK_F2Click(Sender: TObject);
    procedure cb_VK_F3Click(Sender: TObject);
    procedure cb_VK_F4Click(Sender: TObject);
    procedure cb_VK_F5Click(Sender: TObject);
    procedure cb_VK_F6Click(Sender: TObject);
    procedure cb_VK_F7Click(Sender: TObject);
    procedure cb_VK_F8Click(Sender: TObject);
    procedure cb_VK_F9Click(Sender: TObject);
    procedure cb_VK_F10Click(Sender: TObject);
    procedure cb_VK_F11Click(Sender: TObject);
    procedure cb_VK_F12Click(Sender: TObject);
    procedure cb_VK_AClick(Sender: TObject);
    procedure cb_VK_BClick(Sender: TObject);
    procedure cb_VK_CClick(Sender: TObject);
    procedure cb_VK_DClick(Sender: TObject);
    procedure cb_VK_EClick(Sender: TObject);
    procedure cb_VK_FClick(Sender: TObject);
    procedure cb_VK_GClick(Sender: TObject);
    procedure cb_VK_HClick(Sender: TObject);
    procedure cb_VK_IClick(Sender: TObject);
    procedure cb_VK_JClick(Sender: TObject);
    procedure cb_VK_KClick(Sender: TObject);
    procedure cb_VK_LClick(Sender: TObject);
    procedure cb_VK_MClick(Sender: TObject);
    procedure cb_VK_NClick(Sender: TObject);
    procedure cb_VK_OClick(Sender: TObject);
    procedure cb_VK_PClick(Sender: TObject);
    procedure cb_VK_QClick(Sender: TObject);
    procedure cb_VK_RClick(Sender: TObject);
    procedure cb_VK_SClick(Sender: TObject);
    procedure cb_VK_TClick(Sender: TObject);
    procedure cb_VK_UClick(Sender: TObject);
    procedure cb_VK_VClick(Sender: TObject);
    procedure cb_VK_WClick(Sender: TObject);
    procedure cb_VK_XClick(Sender: TObject);
    procedure cb_VK_YClick(Sender: TObject);
    procedure cb_VK_ZClick(Sender: TObject);
    procedure cbhookinjectedClick(Sender: TObject);
    procedure KeyHook1Key(Sender: TObject; AKeyStates: TKeyStates;
      AKeyNames: TKeyNames; Blocked, Injected: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

Const
  KH_WEB = 'http://www.bitlogic.co.uk';
  KH_EMAIL = 'mailto:[e-mail]?subject=TCPKeyHook';
var
  Form1: TForm1;
  callcount: integer = 0;
  KeyHook1: TCPKeyBlockHook;

implementation

{$R *.DFM}

function GetActiveWindowTitle: string;
var
Wnd: Thandle;
PC: Array[0..$FFF] of Char;
begin
Result := '';
Wnd := GetForeGroundWindow; {GetActiveWindow}
GetWindowText(Wnd, PC, sizeof(PC)); {SendMessage(Wnd, wm_GetText, $FFF, LongInt(@PC));}
Result := StrPas(PC);
end;

procedure TForm1.btStartClick(Sender: TObject);
begin
KeyHook1.LicenceCode := '';
KeyHook1.UserHookMsg := RegisterWindowMessage('keyblockhook_msg'); //WM_USER+100;
KeyHook1.DisableKeyboard := false;
if KeyHook1.Start_KeyHook then begin
   lwindowhandle.Caption := 'KeyHook WindowHandle: '+inttostr(KeyHook1.WindowHandle);
   luserhookmsg.Caption := 'Custom UserHookMsg: '+inttostr(KeyHook1.UserHookMsg);
   lbkeylayout.Caption := 'KeyboardLayout Code: '+KeyHook1.KeyboardLayout;
   label1.caption := 'KeyHook Status: Enabled';
   btStart.Enabled := False;
   btStop.Enabled := True;
   btUpdate.Enabled := True;
   end
   else begin
   label1.caption := 'KeyHook Status: Error Starting Hook DLL';
   btStart.Enabled := True;
   btStop.Enabled := False;
   btUpdate.Enabled := False;
   end;
end;

procedure TForm1.btStopClick(Sender: TObject);
begin
if KeyHook1.Stop_KeyHook then begin
   label1.caption := 'KeyHook Status: Disabled';
   btStart.Enabled := True;
   btStop.Enabled := False;
   btUpdate.Enabled := False;
   end
   else begin
   label1.caption := 'KeyHook Status: Error Starting Hook DLL';
   btStart.Enabled := False;
   btStop.Enabled := True;
   btUpdate.Enabled := True;
   end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if KeyHook1.Enabled then KeyHook1.Stop_KeyHook;
end;

procedure TForm1.lwebpageClick(Sender: TObject);
begin
ShellExecute(GetDesktopWindow(), 'open', PChar(KH_WEB), nil, nil, SW_SHOWNORMAL);
end;

procedure TForm1.lemailClick(Sender: TObject);
begin
ShellExecute(GetDesktopWindow(), 'open', PChar(KH_EMAIL), nil, nil, SW_SHOWNORMAL);
end;

procedure TForm1.cbdisablekeyboardClick(Sender: TObject);
begin
KeyHook1.DisableKeyboard := cbdisablekeyboard.Checked;
end;

procedure TForm1.cbblocksyskeysClick(Sender: TObject);
begin
KeyHook1.BlockSystemKeys := cbblocksyskeys.Checked;
end;

procedure TForm1.cb_HK_CTRL_ESCClick(Sender: TObject);
begin
KeyHook1.BlockKeys.HK_CTRL_ESC := cb_HK_CTRL_ESC.Checked;
end;

procedure TForm1.cb_HK_ALT_TABClick(Sender: TObject);
begin
KeyHook1.BlockKeys.HK_ALT_TAB := cb_HK_ALT_TAB.Checked;
end;

procedure TForm1.cb_HK_ALT_F4Click(Sender: TObject);
begin
KeyHook1.BlockKeys.HK_ALT_F4 := cb_HK_ALT_F4.Checked;
end;

procedure TForm1.cb_HK_ALT_ESCClick(Sender: TObject);
begin
KeyHook1.BlockKeys.HK_ALT_ESC := cb_HK_ALT_ESC.Checked;
end;

procedure TForm1.cb_VK_CANCELClick(Sender: TObject);
begin
KeyHook1.BlockKeys.VK_CANCEL := cb_VK_CANCEL.Checked;
end;

procedure TForm1.cb_VK_BACKClick(Sender: TObject);
begin
KeyHook1.BlockKeys.VK_BACK := cb_VK_BACK.Checked;
end;

procedure TForm1.cb_VK_TABClick(Sender: TObject);
begin
KeyHook1.BlockKeys.VK_TAB := cb_VK_TAB.Checked;
end;

procedure TForm1.cb_VK_CLEARClick(Sender: TObject);
begin
KeyHook1.BlockKeys.VK_CLEAR := cb_VK_CLEAR.Checked;
end;

procedure TForm1.cb_VK_RETURNClick(Sender: TObject);
begin
KeyHook1.BlockKeys.VK_RETURN := cb_VK_RETURN.Checked;
end;

procedure TForm1.cb_VK_SHIFTClick(Sender: TObject);
begin
KeyHook1.BlockKeys.VK_SHIFT := cb_VK_SHIFT.Checked;
end;

procedure TForm1.cb_VK_LSHIFTClick(Sender: TObject);
begin
KeyHook1.BlockKeys.VK_LSHIFT := cb_VK_LSHIFT.Checked;
end;

procedure TForm1.cb_VK_RSHIFTClick(Sender: TObject);
begin
KeyHook1.BlockKeys.VK_RSHIFT := cb_VK_RSHIFT.Checked;
end;

procedure TForm1.cb_VK_RCONTROLClick(Sender: TObject);