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熱心網友回復：
請提供些解決思路，非常感謝轉載請註明出處，本文鏈接：https://www.uj5u.com/caozuo/228588.html
標籤：安全技術/病毒