hook WH_KEYBOARD_ll 在大部分電腦上運行良好，但是在某些電腦上hook會在不確定的時間后，hook失效。
請提供些解決思略，謝謝
unit uhook;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Buttons;
type
TForm1 = class(TForm)
Memo1: TMemo;
btnHook: TBitBtn;
btnUnhook: TBitBtn;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnHookClick(Sender: TObject);
procedure btnUnhookClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
hHkKeyboard: hhook;
iKeyboardTypeCount: Integer;
function Setkeyhook: Boolean;
function Endkeyhook: Boolean;
function WriteLog(const sContent: string): Boolean;
implementation
{$R *.dfm}
function KeyboardHookProc(iCode: Integer; wParam: WPARAM; lParam:LPARAM):LRESULT;stdcall;
begin
WriteLog('進入hook程式');
if iCode<0 then //遵照SDK檔案
begin
Result:=CallNextHookEx(hHkKeyboard,iCode,wParam,lParam);
Exit;
end;
if wParam =WM_KEYDOWN then //設備動作
begin
iKeyboardTypeCount := iKeyboardTypeCount + 1;
WriteLog('鍵盤次數:' + inttostr(iKeyboardTypeCount))
end;
result := CallNextHookEx(hHkKeyboard,iCode,wparam,lparam);
WriteLog('退出hook程式' + UIntToStr(GetLastError) );
end;
function Setkeyhook: Boolean;
begin
if hHkKeyboard= 0 then
begin
hHkKeyboard := SetwindowsHookEx(WH_KEYBOARD_ll, @KeyboardHookProc, HInstance, 0); //裝載鉤子
WriteLog('hhook' + IntToStr(hHkKeyboard));
end;
result := hHkKeyboard <> 0;
end;
function Endkeyhook: Boolean;
begin
if hHkKeyboard <> 0 then
begin
unhookwindowshookex(hHkKeyboard); //卸載鉤子
hHkKeyboard := 0;
end;
result := hHkKeyboard = 0;
end;
function WriteLog(const sContent: string): Boolean;
var
sPath, sLogFile: string;
sDate, sTime, sText: string;
logFile: TextFile;
begin
Result := True;
sDate := DateToStr(Now);
sTime := TimeToStr(Now);
sPath := GetHomePath + '\dora';
if not directoryExists(sPath) then
ForceDirectories(sPath);
if sPath[Length(sPath)] <> '\' then sPath := sPath + '\';
sPath := sPath + 'Log\';
if not DirectoryExists(sPath) then
begin
if not ForceDirectories(sPath) then
begin
Result := False;
Exit;
end;
end;
sLogFile := sPath + 'log_Comm_test.txt';
AssignFile(logFile, sLogFile);
if not FileExists(sLogFile) then
Rewrite(logFile)
else
Append(logFile);
try
sText := '<時間: ' + sDate + ' ' + sTime + ' 操作員: ' + '' + '> ';
sText := sText + sContent;
Form1.Memo1.Lines.Add(sText);
Writeln(logFile, sText);
finally
CloseFile(logFile);
end;
end;
procedure TForm1.btnHookClick(Sender: TObject);
begin
if Setkeyhook then
begin
WriteLog('hook: 成功');
end
else begin
WriteLog('hook: 失敗' + inttostr(GetLastError));
end;
end;
procedure TForm1.btnUnhookClick(Sender: TObject);
begin
Endkeyhook;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
iKeyboardTypeCount := 0;
hHkKeyboard := 0;
if Setkeyhook then
begin
WriteLog('hook: 成功');
end
else begin
WriteLog('hook: 失敗' + inttostr(GetLastError));
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Endkeyhook;
end;
end.
uj5u.com熱心網友回復：
請提供些解決思路uj5u.com熱心網友回復：
寫成dll吧。。。uj5u.com熱心網友回復：
試過dll，鉤子依然會掉，不知道為什么。uj5u.com熱心網友回復：
這是我之前的鍵盤鉤子，還比較穩定的，看你的代碼，不要在鉤子里面寫檔案，鉤子占用時間盡量要少，有寫檔案操作，添加到你的執行緒佇列來操作。這樣就好了
function KeyBoardProc(nCode: Integer; WParam: WParam; LParam: LParam): LRESULT; stdcall;
begin
if (nCode = HC_ACTION) then
begin
if ((WParam = WM_KEYUP) or (WParam = WM_KEYDOWN) or (WParam = WM_SYSKEYDOWN) or (WParam = WM_SYSKEYUP)) then
begin
// OutputDebugStringA(PAnsiChar(AnsiString('ProcKeyBoard' + ' Msg_id=' + IntToHex(WParam, 8))));
// OutputDebugStringA(PAnsiChar(AnsiString('ProcKeyBoard' + ' FKeyboardCallHandle=' + IntToHex(FKeyboardCallHandle, 8))));
end;
case WParam of
WM_KEYUP:
begin
if ReportMemoryLeaksOnShutdown then
begin
OutputDebugStringA(PAnsiChar(AnsiString('WM_KEYUP key=' + Chr(PKeyBoardHookStruct(LParam).vkCode))));
end;
end;
WM_KEYDOWN:
begin
if ReportMemoryLeaksOnShutdown then
begin
OutputDebugStringA(PAnsiChar(AnsiString('WM_KEYDOWN key=' + Chr(PKeyBoardHookStruct(LParam).vkCode))));
end;
// SendMessage(FKeyboardCallHandle, WM_HookKeyDonw, WParam, LParam);
if Assigned(FThreadKeyBoardHook) then
FThreadKeyBoardHook.AddCount;
end;
WM_SYSKEYDOWN, WM_SYSKEYUP:
begin
if ReportMemoryLeaksOnShutdown then
begin
OutputDebugStringA(PAnsiChar(AnsiString('WM_SYSKEYDOWN, WM_SYSKEYUP key=' + Chr(PKeyBoardHookStruct(LParam).vkCode))));
end;
end;
end;
end;
Result := CallNextHookEx(FKeyboardNextHook, nCode, WParam, LParam);
end;
uj5u.com熱心網友回復：
非常感謝，加日志是為了除錯，正式代碼中沒有日志操作。我參考您的代碼再做個demo，debug下，謝謝。
uj5u.com熱心網友回復：
FThreadKeyBoardHook 這個類的代碼能分享下嗎，謝謝。uj5u.com熱心網友回復：
會不會有其它程式也hook，且不往下傳。或者更高級的比如殺軟檢測到然后禁止了。轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/228525.html
上一篇：認為是高手的來一下