📄 ukeymaphookdemo.pas

📁 键盘钩子程序及控件, C++ Builder 和DELPHI可用
💻 PAS
字号:
unit UKeyMapHookDemo;

interface

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

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_VK_F1: TCheckBox;
    cb_VK_F3: TCheckBox;
    cb_VK_F4: TCheckBox;
    cb_VK_F2: TCheckBox;
    Label12: TLabel;
    cb_VK_F5: TCheckBox;
    cb_crazykeyboard: TCheckBox;
    cb_VK_F6: TCheckBox;
    cb_VK_F7: TCheckBox;
    cb_VK_F8: TCheckBox;
    cb_VK_F9: TCheckBox;
    cb_VK_F10: TCheckBox;
    cb_VK_F11: TCheckBox;
    cb_VK_F12: TCheckBox;
    cb_VK_NUMLOCK: TCheckBox;
    cb_VK_SUBTRACT: TCheckBox;
    cb_VK_ADD: TCheckBox;
    cb_VK_NUMPAD6: TCheckBox;
    cb_VK_NUMPAD4: TCheckBox;
    cb_VK_NUMPAD2: TCheckBox;
    cb_VK_NUMPAD8: TCheckBox;
    btUpdate: TButton;
    procedure btStartClick(Sender: TObject);
    procedure btStopClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure OnKeyPressed(Sender: TObject; AKeyStates: TKeyStates; AKeyNames: TKeyNames; Blocked: Boolean);
    procedure FormDestroy(Sender: TObject);
    procedure lwebpageClick(Sender: TObject);
    procedure lemailClick(Sender: TObject);
    procedure cbdisablekeyboardClick(Sender: TObject);
    procedure cb_VK_F1Click(Sender: TObject);
    procedure cb_VK_F3Click(Sender: TObject);
    procedure cb_VK_F4Click(Sender: TObject);
    procedure cb_VK_F2Click(Sender: TObject);
    procedure cbblocksyskeysClick(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_F12Click(Sender: TObject);
    procedure cb_VK_F11Click(Sender: TObject);
    procedure cb_VK_NUMLOCKClick(Sender: TObject);
    procedure cb_VK_SUBTRACTClick(Sender: TObject);
    procedure cb_VK_ADDClick(Sender: TObject);
    procedure cb_VK_NUMPAD6Click(Sender: TObject);
    procedure cb_VK_NUMPAD4Click(Sender: TObject);
    procedure cb_VK_NUMPAD2Click(Sender: TObject);
    procedure cb_VK_NUMPAD8Click(Sender: TObject);
    procedure cb_crazykeyboardClick(Sender: TObject);
    procedure btUpdateClick(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=TCPKeyMapHook';
var
  Form1: TForm1;
  callcount: integer = 0;
  KeyHook1: TCPKeyMapHook;

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: 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 and AKeyStates.KeyDown) then sblockedkey.Brush.Color := clRed else sblockedkey.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 := TCPKeyMapHook.Create(self);
KeyHook1.LicenceCode := '';  //Enter Licence Code to remove Trial Message
KeyHook1.UserHookMsg := RegisterWindowMessage('keymaphook_msg'); //WM_USER+202;
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.cb_VK_F1Click(Sender: TObject);
begin
if cb_VK_F1.Checked then
   begin
   KeyHook1.KeyMap.VK_F1 := HK_CTRL_ESC;
   end else
   begin
   KeyHook1.KeyMap.VK_F1 := VK_F1;
   end;
end;

procedure TForm1.cb_VK_F3Click(Sender: TObject);
begin
if cb_VK_F3.Checked then
   begin
   KeyHook1.KeyMap.VK_F3 := HK_ALT_TAB;
   end else
   begin
   KeyHook1.KeyMap.VK_F3 := VK_F3;
   end;
end;

procedure TForm1.cb_VK_F4Click(Sender: TObject);
begin
if cb_VK_F4.Checked then
   begin
   KeyHook1.KeyMap.VK_F4 := HK_ALT_F4;
   end else
   begin
   KeyHook1.KeyMap.VK_F4 := VK_F4;
   end;
end;

procedure TForm1.cb_VK_F2Click(Sender: TObject);
begin
if cb_VK_F2.Checked then
   begin
   KeyHook1.KeyMap.VK_F2 := HK_ALT_ESC;
   end else
   begin
   KeyHook1.KeyMap.VK_F2 := VK_F2;
   end;
end;

procedure TForm1.cbblocksyskeysClick(Sender: TObject);
begin
if cbblocksyskeys.Checked then
   begin
   KeyHook1.KeyMap.HK_CTRL_ESC := 0;
   KeyHook1.KeyMap.HK_ALT_ESC := 0;
   KeyHook1.KeyMap.HK_ALT_TAB := 0;
   KeyHook1.KeyMap.HK_ALT_F4 := 0;
   KeyHook1.KeyMap.HK_CTRL_BREAK := 0;
   KeyHook1.KeyMap.HK_ALT_RETURN := 0;
   end else
   begin
   KeyHook1.KeyMap.HK_CTRL_ESC := HK_CTRL_ESC;
   KeyHook1.KeyMap.HK_ALT_ESC := HK_ALT_ESC;
   KeyHook1.KeyMap.HK_ALT_TAB := HK_ALT_TAB;
   KeyHook1.KeyMap.HK_ALT_F4 := HK_ALT_F4;
   KeyHook1.KeyMap.HK_CTRL_BREAK := HK_CTRL_BREAK;
   KeyHook1.KeyMap.HK_ALT_RETURN := HK_ALT_RETURN;
   end;
end;

procedure TForm1.cb_VK_F5Click(Sender: TObject);
begin
if cb_VK_F5.Checked then
   begin
   KeyHook1.KeyMap.VK_F5 := VK_BROWSER_BACK;
   end else
   begin
   KeyHook1.KeyMap.VK_F5 := VK_F5;
   end;
end;

procedure TForm1.cb_VK_F6Click(Sender: TObject);
begin
if cb_VK_F6.Checked then
   begin
   KeyHook1.KeyMap.VK_F6 := VK_BROWSER_FORWARD;
   end else
   begin
   KeyHook1.KeyMap.VK_F6 := VK_F6;
   end;
end;

procedure TForm1.cb_VK_F7Click(Sender: TObject);
begin
if cb_VK_F7.Checked then
   begin
   KeyHook1.KeyMap.VK_F7 := VK_BROWSER_REFRESH;
   end else
   begin
   KeyHook1.KeyMap.VK_F7 := VK_F7;
   end;
end;

procedure TForm1.cb_VK_F8Click(Sender: TObject);
begin
if cb_VK_F8.Checked then
   begin
   KeyHook1.KeyMap.VK_F8 := VK_BROWSER_STOP;
   end else
   begin
   KeyHook1.KeyMap.VK_F8 := VK_F8;
   end;
end;

procedure TForm1.cb_VK_F9Click(Sender: TObject);
begin
if cb_VK_F9.Checked then
   begin
   KeyHook1.KeyMap.VK_F9 := VK_BROWSER_SEARCH;
   end else
   begin
   KeyHook1.KeyMap.VK_F9 := VK_F9;
   end;
end;

procedure TForm1.cb_VK_F10Click(Sender: TObject);
begin
if cb_VK_F10.Checked then
   begin
   KeyHook1.KeyMap.VK_F10 := VK_BROWSER_FAVORITES;
   end else
   begin
   KeyHook1.KeyMap.VK_F10 := VK_F10;
   end;
end;

procedure TForm1.cb_VK_F12Click(Sender: TObject);
begin
if cb_VK_F12.Checked then
   begin
   KeyHook1.KeyMap.VK_F12 := VK_LAUNCH_MAIL;
   end else
   begin
   KeyHook1.KeyMap.VK_F12 := VK_F12;
   end;
end;

procedure TForm1.cb_VK_F11Click(Sender: TObject);
begin
if cb_VK_F11.Checked then
   begin
   KeyHook1.KeyMap.VK_F11 := VK_BROWSER_HOME;
   end else
   begin
   KeyHook1.KeyMap.VK_F11 := VK_F11;
   end;
end;

procedure TForm1.cb_VK_NUMLOCKClick(Sender: TObject);
begin
if cb_VK_NUMLOCK.Checked then
   begin
   KeyHook1.KeyMap.VK_NUMLOCK := VK_VOLUME_MUTE;
   end else
   begin
   KeyHook1.KeyMap.VK_NUMLOCK := VK_NUMLOCK;
   end;
end;

procedure TForm1.cb_VK_SUBTRACTClick(Sender: TObject);
begin
if cb_VK_SUBTRACT.Checked then
   begin
   KeyHook1.KeyMap.VK_SUBTRACT := VK_VOLUME_DOWN;
   end else
   begin
   KeyHook1.KeyMap.VK_SUBTRACT := VK_SUBTRACT;
   end;
end;

procedure TForm1.cb_VK_ADDClick(Sender: TObject);
begin
if cb_VK_ADD.Checked then
   begin
   KeyHook1.KeyMap.VK_ADD := VK_VOLUME_UP;
   end else
   begin
   KeyHook1.KeyMap.VK_ADD := VK_ADD;
   end;
end;

procedure TForm1.cb_VK_NUMPAD6Click(Sender: TObject);
begin
if cb_VK_NUMPAD6.Checked then
   begin
   KeyHook1.KeyMap.VK_NUMPAD6 := VK_MEDIA_NEXT_TRACK;
   end else
   begin
   KeyHook1.KeyMap.VK_NUMPAD6 := VK_NUMPAD6;
   end;
end;

procedure TForm1.cb_VK_NUMPAD4Click(Sender: TObject);
begin
if cb_VK_NUMPAD4.Checked then
   begin
   KeyHook1.KeyMap.VK_NUMPAD4 := VK_MEDIA_PREV_TRACK;
   end else
   begin
   KeyHook1.KeyMap.VK_NUMPAD4 := VK_NUMPAD4;
   end;
end;

procedure TForm1.cb_VK_NUMPAD2Click(Sender: TObject);
begin
if cb_VK_NUMPAD2.Checked then
   begin
   KeyHook1.KeyMap.VK_NUMPAD2 := VK_MEDIA_STOP;
   end else
   begin
   KeyHook1.KeyMap.VK_NUMPAD2 := VK_NUMPAD2;
   end;
end;

procedure TForm1.cb_VK_NUMPAD8Click(Sender: TObject);
begin
if cb_VK_NUMPAD8.Checked then
   begin
   KeyHook1.KeyMap.VK_NUMPAD8 := VK_MEDIA_PLAY_PAUSE;
   end else
   begin
   KeyHook1.KeyMap.VK_NUMPAD8 := VK_NUMPAD8;
   end;
end;

procedure TForm1.cb_crazykeyboardClick(Sender: TObject);
begin
if cb_crazykeyboard.Checked then
   begin
   KeyHook1.KeyMap.VK_A := VK_Z;
   KeyHook1.KeyMap.VK_B := VK_Y;
   KeyHook1.KeyMap.VK_C := VK_X;
   KeyHook1.KeyMap.VK_D := VK_W;
   KeyHook1.KeyMap.VK_E := VK_V;
   KeyHook1.KeyMap.VK_F := VK_U;
   KeyHook1.KeyMap.VK_G := VK_T;
   KeyHook1.KeyMap.VK_H := VK_S;
   KeyHook1.KeyMap.VK_I := VK_R;
   KeyHook1.KeyMap.VK_J := VK_Q;
   KeyHook1.KeyMap.VK_K := VK_P;
   KeyHook1.KeyMap.VK_L := VK_O;
   KeyHook1.KeyMap.VK_M := VK_N;
   KeyHook1.KeyMap.VK_N := VK_M;
   KeyHook1.KeyMap.VK_O := VK_L;
   KeyHook1.KeyMap.VK_P := VK_K;
   KeyHook1.KeyMap.VK_Q := VK_J;
   KeyHook1.KeyMap.VK_R := VK_I;
   KeyHook1.KeyMap.VK_S := VK_H;
   KeyHook1.KeyMap.VK_T := VK_G;
   KeyHook1.KeyMap.VK_U := VK_F;
   KeyHook1.KeyMap.VK_V := VK_E;
   KeyHook1.KeyMap.VK_W := VK_D;
   KeyHook1.KeyMap.VK_X := VK_C;
   KeyHook1.KeyMap.VK_Y := VK_B;
   KeyHook1.KeyMap.VK_Z := VK_A;
   end else
   begin
   KeyHook1.KeyMap.VK_A := VK_A;
   KeyHook1.KeyMap.VK_B := VK_B;
   KeyHook1.KeyMap.VK_C := VK_C;
   KeyHook1.KeyMap.VK_D := VK_D;
   KeyHook1.KeyMap.VK_E := VK_E;
   KeyHook1.KeyMap.VK_F := VK_F;
   KeyHook1.KeyMap.VK_G := VK_G;
   KeyHook1.KeyMap.VK_H := VK_H;
   KeyHook1.KeyMap.VK_I := VK_I;
   KeyHook1.KeyMap.VK_J := VK_J;
   KeyHook1.KeyMap.VK_K := VK_K;
   KeyHook1.KeyMap.VK_L := VK_L;
   KeyHook1.KeyMap.VK_M := VK_M;
   KeyHook1.KeyMap.VK_N := VK_N;
   KeyHook1.KeyMap.VK_O := VK_O;
   KeyHook1.KeyMap.VK_P := VK_P;
   KeyHook1.KeyMap.VK_Q := VK_Q;
   KeyHook1.KeyMap.VK_R := VK_R;
   KeyHook1.KeyMap.VK_S := VK_S;
   KeyHook1.KeyMap.VK_T := VK_T;
   KeyHook1.KeyMap.VK_U := VK_U;
   KeyHook1.KeyMap.VK_V := VK_V;
   KeyHook1.KeyMap.VK_W := VK_W;
   KeyHook1.KeyMap.VK_X := VK_X;
   KeyHook1.KeyMap.VK_Y := VK_Y;
   KeyHook1.KeyMap.VK_Z := VK_Z;
   end;
end;

procedure TForm1.btUpdateClick(Sender: TObject);
begin
if KeyHook1.UpdateHook then MessageDlg('Hook Updated.'+#13+#10+''+#13+#10+'The Hook has been updated with the selected properties.'+#13+#10+'Updates take effect immediately.', mtInformation, [mbOK], 0)
else MessageDlg('Error Updating Hook.'+#13+#10+''+#13+#10+'It was not possible to update the Hook. The Hook must be'+#13+#10+'Enabled and Started to update the properties.', mtError, [mbOK], 0);
end;

end.
⌨️ 快捷键说明

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