📄 ukeyblockhookdemo.pas

📁 键盘钩子程序及控件, C++ Builder 和DELPHI可用
💻 PAS
📖 第 1 页 / 共 2 页
字号:
12 下一页
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;
    procedure btupdateClick(Sender: TObject);
    procedure btStartClick(Sender: TObject);
    procedure btStopClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure OnKeyPressed(Sender: TObject; AKeyStates: TKeyStates; AKeyNames: TKeyNames; Blocked, Injected: Boolean);
    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);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

Const
  KH_WEB = 'http://www.bitlogic.co.uk';
  KH_EMAIL = 'mailto:development@bitlogic.co.uk?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.OnKeyPressed(Sender: TObject; AKeyStates: TKeyStates; AKeyNames: TKeyNames; Blocked, Injected: Boolean);
begin
  inc(callcount);
  ltotcalls.caption := 'Total Hook Calls Processed: '+inttostr(callcount);
  lbvkcode.Caption := 'vkCode: '+inttostr(AKeyStates.keyinfo.vkCode);
  lbscancode.Caption := 'scanCode: '+inttostr(AKeyStates.keyinfo.scanCode);
  lbflags.Caption := 'flags: '+inttostr(AKeyStates.keyinfo.flags);
  lbtime.Caption := 'time: '+inttostr(AKeyStates.keyinfo.time);
  lbdwextrainfo.Caption := 'xinfo: '+inttostr(AKeyStates.keyinfo.dwExtraInfo);

  { Show The Current State of each Key Pressed }
  if AKeyStates.KeyDown then skey.Brush.Color := clLime else skey.Brush.Color := clWhite;
  if (AKeyStates.KeyRepeated and AKeyStates.KeyDown) then skeyrepeat.Brush.Color := clYellow
  else skeyrepeat.Brush.Color := clWhite;
  lbkeyrepeat.Caption := 'Repeat '+inttostr(AKeyStates.RepeatCount);
  if AKeyStates.AltDown then salt.Brush.Color := clLime else salt.Brush.Color := clWhite;
  if AKeyStates.CtrlDown then sctrl.Brush.Color := clLime else sctrl.Brush.Color := clWhite;
  if AKeyStates.ShiftDown then sshift.Brush.Color := clLime else sshift.Brush.Color := clWhite;
  if (AKeyStates.ExtendedKey and AKeyStates.KeyDown) then sxkey.Brush.Color := clRed else sxkey.Brush.Color := clWhite;
  if (Blocked) then sblockedkey.Brush.Color := clRed else sblockedkey.Brush.Color := clWhite;
  if (Injected) then sinjectedkey.Brush.Color := clRed else sinjectedkey.Brush.Color := clWhite;

  { If Key is Down and ASCII Character then Log to Memo }
  if Not AKeyStates.KeyDown then Exit;
  lbapp.Caption := 'Active Window: '+GetActiveWindowTitle;
  lbvkey.Caption := 'Virtual Key Name: '+AKeyNames.KeyExtName;
  lbakey.Caption := 'Ascii Key Character: '+AKeyNames.KeyChar;
  if AKeyNames.KeyChar = #13 then memokeylog.Text := memokeylog.Text+#13#10
  else memokeylog.Text := memokeylog.Text+AKeyNames.KeyChar;
end;

procedure TForm1.btStartClick(Sender: TObject);
begin
if KeyHook1.Start_KeyHook then begin
   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.FormCreate(Sender: TObject);
begin
KeyHook1 := TCPKeyBlockHook.Create(self);
KeyHook1.LicenceCode := '';
KeyHook1.UserHookMsg := RegisterWindowMessage('keyblockhook_msg'); //WM_USER+100;
KeyHook1.OnKey := OnKeyPressed;
KeyHook1.DisableKeyboard := false;
lwindowhandle.Caption := 'KeyHook WindowHandle: '+inttostr(KeyHook1.WindowHandle);
luserhookmsg.Caption := 'Custom UserHookMsg: '+inttostr(KeyHook1.UserHookMsg);
lbkeylayout.Caption := 'KeyboardLayout Code: '+KeyHook1.KeyboardLayout;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
try
if KeyHook1.Enabled then KeyHook1.Stop_KeyHook;
finally
KeyHook1.Free;
KeyHook1 := nil;
end;
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;
12 下一页
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -