Hook WH_KEYBOARD_ll run on most of the computer is good, but in some computer hook in uncertain time, hook fails,


The unit uhook;

Interface

USES the
Winapi. Windows, Winapi Messages, System. SysUtils, System. Variants, System. Classes, Vcl. Graphics,
The 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;

The function Setkeyhook: Boolean;
The function Endkeyhook: Boolean;
The function WriteLog (const sContent: string) : Boolean;

Implementation

{$R *. DFM}


The function KeyboardHookProc (iCode: Integer; WParam: wParam; LParam: lParam) : LRESULT; Stdcall;
The begin
WriteLog (' into the hook procedure);
If iCode<0 then//in accordance with the SDK documentation
The begin
Result:=CallNextHookEx (hHkKeyboard, iCode wParam, lParam);
Exit;
end;

If wParam=WM_KEYDOWN then//equipment action
The begin
IKeyboardTypeCount:=iKeyboardTypeCount + 1;
WriteLog (' keyboard number: + inttostr (iKeyboardTypeCount))
end;

Result:=CallNextHookEx (hHkKeyboard, iCode wparam, lparam);
WriteLog (' exit hook program + UIntToStr GetLastError ());

end;

The function Setkeyhook: Boolean;
The begin
If hHkKeyboard=0 then
The begin
HHkKeyboard:=SetwindowsHookEx (WH_KEYBOARD_ll, @ KeyboardHookProc HInstance, 0).//load hook
WriteLog (' hhook + IntToStr (hHkKeyboard));
end;
Result:=hHkKeyboard & lt;> 0;
end;

The function Endkeyhook: Boolean;
The begin
If hHkKeyboard & lt;> 0 then
The begin
Unhookwindowshookex (hHkKeyboard);//uninstall hooks
HHkKeyboard:=0;
end;
The result: hHkKeyboard==0;
end;


The function WriteLog (const sContent: string) : Boolean;
Var
SPath sLogFile: string;
SDate sTime, sText: string;
LogFile: TextFile;
The begin
Result:=True;
SDate=DateToStr (Now);
STime:=TimeToStr (Now);

SPath:=GetHomePath + '\ DORA';
If not directoryExists (sPath) then
ForceDirectories (sPath);
If sPath [Length (sPath)] <> The '\' then sPath: sPath +='\';

SPath:=sPath + 'Log \';
If not DirectoryExists (sPath) then
The begin
If not ForceDirectories (sPath) then
The begin
Result:=False;
Exit;
end;
end;
SLogFile:=sPath + 'log_Comm_test. TXT';
AssignFile (logFile, sLogFile);
If not FileExists (sLogFile) then
Rewrite (logFile)
The else
Append (logFile);

Try
SText:='& lt; Time: '+ sDate +' '+ sTime + operator:' + 'a' + '& gt; ';
SText:=sText + sContent;
Form1. Memo1. Lines. The Add (sText);
Writeln (logFile, sText);
The finally
CloseFile (logFile);
end;
end;

Procedure TForm1. BtnHookClick (Sender: TObject);
The begin
If Setkeyhook then
The begin
WriteLog (' hook: success);
End
The else begin
WriteLog (' hook: failure '+ inttostr GetLastError ());
end;
end;

Procedure TForm1. BtnUnhookClick (Sender: TObject);
The begin
Endkeyhook;
end;

Procedure TForm1. FormCreate (Sender: TObject);
The begin
IKeyboardTypeCount:=0;
HHkKeyboard:=0;
If Setkeyhook then
The begin
WriteLog (' hook: success);
End
The else begin
WriteLog (' hook: failure '+ inttostr GetLastError ());
end;
end;

Procedure TForm1. FormDestroy (Sender: TObject);
The begin
Endkeyhook;
end;

end.

CodePudding user response:

Please provide some solution, thank you very much