Delphi Hook 鍵盤 @ 抓狂小白的程式筆記

如何寫一個全域快速鍵隨時隨地按鍵盤的按鍵即可撥放音樂放開即停止

https://tw.answers.yahoo.com/question/index?qid=20160929044947AAzPzY3

使用Hook可以全域偵測鍵盤(即使焦點不再該Application內)

但必須註冊DLL檔才能全域偵測

以下源碼使用Hook 製作DLL檔並使用PostMessage 將按鍵訊息傳回專案

由於使用了兩個專案所以弄一個ProjectGroup

定義一個Message常數放在Unit 兩個專案共用

unit HOOK_Const;

interface

uses Messages;

const WM_MyMessage = WM_USER + 1;

implementation

end.

Hook DLL程式碼

library KeyboardHook;

uses
SysUtils,
Windows,
Messages,
Classes,
HOOK_Const in 'HOOK_Const.pas';

{$R *.res}

var
hook: HHOOK; {钩子变量}
MainFormHandle: HWND;

{键盘钩子函数}
function KeyboardHookProc(iCode: Integer; wParam: WPARAM; lParam:LPARAM):LRESULT;stdcall;
var
vKey:integer; //表示按下了哪个键
PEvt:^EventMsg; //EventMsg的指针
begin
if iCode<0 then //遵照SDK文档
begin
Result:=CallNextHookEx(hook,iCode,wParam,lParam);
Exit;
end;

PEvt := pointer(Dword(lparam)); //将lparam的指针传递给PEvt事件消息指针

if (PEvt.message = WM_KEYDOWN) or (PEvt.message = WM_KEYUP) then
begin
vkey := LoByte(PEvt.paramL ); //取得16进制数最低位那个字节的内容
{通过消息把数据传递给指定窗口}
PostMessage(MainFormHandle, WM_MyMessage, PEvt.message, vkey);
end;

result := CallNextHookEx(hook,iCode,wparam,lparam);
end;

{建立钩子}
function SetHook(H:HWND):Boolean;stdcall;
begin
if (hook = 0) then
begin
hook := SetWindowsHookEx(WH_JOURNALRECORD,KeyboardHookProc,HInstance,0); //调用API HOOK
Result:=hook<>0;
MainFormHandle:=H;
end
else
Result:=False;
end;

{释放钩子}
function DelHook:Boolean;stdcall;
begin
if (hook <> 0 ) then
begin
Result:=UnHookWindowsHookEx(hook); //卸载HOOK
hook:=0;
end
else
Result:=False;
end;

{按DLL的要求输出函数}
exports
SetHook name 'SetHook',
DelHook name 'DelHook';

//SetHook,DelHook;{如果不需要改名,可以直接这样exports}
begin
end.

主程式

unit Hook_Main;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls
,HOOK_Const, Vcl.ExtCtrls, Vcl.MPlayer;

type
Tfrm_Hook_Main = class(TForm)
pnl_Top: TPanel;
btn_StartHook: TButton;
btn_StopHook: TButton;
btn_AddRecord: TButton;
btn_DelRecord: TButton;
mo_Setup: TMemo;
OpenDialog: TOpenDialog;
MediaPlayer: TMediaPlayer;
btn_test: TButton;
procedure btn_StartHookClick(Sender: TObject);
procedure btn_StopHookClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure MyMessage(var msg: TMessage); message WM_MyMessage;{定义一个消息方法接受消息}
procedure btn_AddRecordClick(Sender: TObject);
procedure btn_testClick(Sender: TObject);
private
WorkIngKey:Integer; //正在按的按鍵
isHookInstalled:Boolean; //是否正在Hook
Function GetINIPath:String; //取得INI路徑
{ Private declarations }
public
{ Public declarations }
end;

{DLL 中的函数声明}
function SetHook(H:HWND): Boolean; stdcall;
function DelHook: Boolean; stdcall;

var
frm_Hook_Main: Tfrm_Hook_Main;

implementation

{$R *.dfm}

uses HOOK_SendKey;

{DLL 中的函数实现, 也就是说明来自那里, 原来叫什么名}
function SetHook; external 'KeyboardHook.dll' name 'SetHook';
function DelHook; external 'KeyboardHook.dll' name 'DelHook';

//增加一個按鍵紀錄
procedure Tfrm_Hook_Main.btn_AddRecordClick(Sender: TObject);
var key:integer;
begin
key:=GetAKey;
//Caption:=IntToStr(Key);
if Sender = btn_AddRecord then
begin
if not OpenDialog.Execute then
Exit;
mo_Setup.Lines.Values[inttostr(key)]:=OpenDialog.FileName;
end
else
with mo_Setup.Lines do
Delete(IndexOfName(inttostr(key)));
end;

//開始Hook
procedure Tfrm_Hook_Main.btn_StartHookClick(Sender: TObject);
begin
btn_StartHook.Enabled:=False;
btn_StopHook.Enabled:=True;

if SetHook(Handle) then
isHookInstalled:=True;
end;

//停止Hook
procedure Tfrm_Hook_Main.btn_StopHookClick(Sender: TObject);
begin
if DelHook then
isHookInstalled:=False;

btn_StartHook.Enabled:=True;
btn_StopHook.Enabled:=False;
end;

//音樂測試按鈕
procedure Tfrm_Hook_Main.btn_testClick(Sender: TObject);
begin
if not OpenDialog.Execute then
Exit;
MediaPlayer.Close;
MediaPlayer.FileName:=OpenDialog.FileName;
MediaPlayer.open;
MediaPlayer.Play;
end;

//FormCreate事件
procedure Tfrm_Hook_Main.FormCreate(Sender: TObject);
begin
btn_StartHook.Enabled:=True;
btn_StopHook.Enabled:=False;
isHookInstalled:=False;

if not FileExists(GetINIPath) then
With TStringlist.Create do
begin
SaveToFile(GetINIPath);
Free;
end;

mo_setup.Lines.LoadFromFile(GetINIPath);
end;

//FormDestroy事件
procedure Tfrm_Hook_Main.FormDestroy(Sender: TObject);
begin
if isHookInstalled then
DelHook;
mo_setup.Lines.SaveToFile(GetINIPath);
end;

//取得INI路徑
function Tfrm_Hook_Main.GetINIPath: String;
begin
Result:=ExtractFileDir(Application.ExeName)+'\'+'setup.ini';
end;

//自訂義接收Hook DLL回傳訊息
procedure Tfrm_Hook_Main.MyMessage(var msg: TMessage);
var index:integer;
begin
//Caption:=IntToStr(msg.WParam)+' '+IntToStr(msg.LParam);
if msg.WParam = WM_KEYUP then
begin
WorkIngKey:=0;
MediaPlayer.Close;
Exit;
end;
if msg.WParam = WM_KEYDOWN then
begin
if WorkIngKey=msg.lParam then
Exit;

WorkIngKey:=msg.lParam;

with mo_Setup.Lines do
begin
index:=IndexOfName(IntToStr(WorkIngKey));
if index>=0 then
begin
with MediaPlayer do
begin
Close;
FileName:=ValueFromIndex[index];
open;
Play;
end;
end;
end;
end;
end;

end.

使用一個彈窗 HOOK_SendKey 來增加或減少鍵盤紀錄 (偵測鍵盤然後選擇音樂檔)

unit HOOK_SendKey;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
Tfrm_SendKey = class(TForm)
Label1: TLabel;
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
private
FResult:integer; //回傳值
{ Private declarations }
public
{ Public declarations }
end;

function GetAKey:Integer;

var
frm_SendKey: Tfrm_SendKey;

implementation

{$R *.dfm}

function GetAKey:Integer;
begin
with frm_SendKey do
begin
//設定顯示在正中央
Top:=(Screen.Height-Height) div 2;
Left:=(Screen.Width-Width) div 2;

ShowModal;
Result:=FResult;
end;
end;

procedure Tfrm_SendKey.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
FResult:=Key;
Close;
end;

end.

參考網址

Hook

http://www.cnblogs.com/edisonfeng/archive/2012/05/18/2507858.html

Message傳遞