wangzheng
asked on
keyboard hook problem
Dear Sirs
I use a DLL with my hook function to monitor all keystroke message, meantime I also want to send the keystroke message back to the application who generate it.
my DLL show as below :
//------------------------ ----hook DLL
library hook;
uses
Unit2 in 'Unit2.pas';
exports hookproc index 1 name 'hookproc' ;
exports sethook index 2 name 'sethook' ;
exports unhook index 3 name 'unhook' ;
begin
hookedalready:=false;
end.
//------------------------ ---------- ---------- -------
unit Unit2;
interface
uses Wintypes,Winprocs,Messages ;
procedure SetHook;export;
procedure UnHook; export;
function HookProc(Code:integer; wParam: Word; lParam: Longint): Longint;export;
var
HookedAlready:Boolean;
implementation
var
ourHook:HHook;
procedure SetHook ;
begin
if HookedAlready then exit;
ourHook:= SetWindowsHookEx(WH_KEYBOA RD,@HookPr oc,HInstan ce,0);
HookedAlready:=True;
end;
procedure UnHook ;
begin
UnHookWindowsHookEx(ourHoo k);
HookedAlready:=False;
end;
function HookProc(Code:integer; wParam: Word; lParam: Longint): Longint;
begin
if code<0 then
begin
{my program}
result:=CallNextHookEx(our Hook,Code, wParam,lPa ram);
end
end;
end.
//------------------------ ---------- ----end of hook DLL
but if I call the sethook in my application using the code below:
dll:=loadlibrary("hook.dll ');
sethook:=getprocaddress(dl l,'sethook ') ;
sethook;
then all keystroke message will be locked, not as I think can be sent back to application who generate the message.
I do not know where is wrong.
Can any person help me?
Thanks
I use a DLL with my hook function to monitor all keystroke message, meantime I also want to send the keystroke message back to the application who generate it.
my DLL show as below :
//------------------------
library hook;
uses
Unit2 in 'Unit2.pas';
exports hookproc index 1 name 'hookproc' ;
exports sethook index 2 name 'sethook' ;
exports unhook index 3 name 'unhook' ;
begin
hookedalready:=false;
end.
//------------------------
unit Unit2;
interface
uses Wintypes,Winprocs,Messages
procedure SetHook;export;
procedure UnHook; export;
function HookProc(Code:integer; wParam: Word; lParam: Longint): Longint;export;
var
HookedAlready:Boolean;
implementation
var
ourHook:HHook;
procedure SetHook ;
begin
if HookedAlready then exit;
ourHook:= SetWindowsHookEx(WH_KEYBOA
HookedAlready:=True;
end;
procedure UnHook ;
begin
UnHookWindowsHookEx(ourHoo
HookedAlready:=False;
end;
function HookProc(Code:integer; wParam: Word; lParam: Longint): Longint;
begin
if code<0 then
begin
{my program}
result:=CallNextHookEx(our
end
end;
end.
//------------------------
but if I call the sethook in my application using the code below:
dll:=loadlibrary("hook.dll
sethook:=getprocaddress(dl
sethook;
then all keystroke message will be locked, not as I think can be sent back to application who generate the message.
I do not know where is wrong.
Can any person help me?
Thanks
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Mr inthe:
Thank for your answer.
The goal of my generating the hook function is to monitor the keystroke.
In the DLL, I use a variable i to be the mark whether a keystroke occured.
If occured , it will set i to 1.
And I use a timer to read the i status and
clear i to zero every 3 second in application where call the DLL.
After I added your codes to DLL, it can send keystroke message back to the application I call the hook. But outside of the application form, when I press key nothing happen (mark i not to be set to 1)
below is my DLL and application :
//------------------------ ---------- -DLL
library hook;
uses
Unit2 in 'Unit2.pas';
exports hookproc index 1 name 'hookproc' ;
exports sethook index 2 name 'sethook' ;
exports unhook index 3 name 'unhook' ;
exports geti index 4 name 'geti' ;
exports seti index 5 name 'seti' ;
exports cleari index 6 name 'cleari' ;
begin
hookedalready:=false;
end.
//--
unit Unit2;
interface
uses Wintypes,Winprocs,Messages ;
procedure SetHook;export;
procedure UnHook; export;
function HookProc(Code:integer; wParam: Word; lParam: Longint): Longint;export;
function geti :integer;export;
procedure seti ;export;
procedure cleari ;export;
var
HookedAlready:Boolean;
i:integer;
ourHook:HHook;
implementation
function geti :integer;
begin
result:=i;
end;
procedure seti ;
begin
i:=1;
end;
procedure cleari ;
begin
i:=0;
end;
procedure SetHook ;
begin
if HookedAlready then exit;
ourHook:= SetWindowsHookEx(WH_KEYBOA RD,@HookPr oc,HInstan ce,0);
HookedAlready:=True;
end;
procedure UnHook ;
begin
UnHookWindowsHookEx(ourHoo k);
HookedAlready:=False;
end;
function HookProc(Code:integer; wParam: Word; lParam: Longint): Longint;
begin
if Code > 0 then
begin
//if wparam = WH_KEYBOARD then MessageBeep(1);
Result := CallNextHookEx(ourhook, Code, Wparam,lparam);
seti;
end else
begin
Result := CallNextHookEx(ourhook, Code, Wparam,lparam);
seti;
end
end;
end.
//------------------------ ---------- --end of DLL
//------------------------ ------my application:
unit callhook;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
public
{ Public declarations }
end;
var
form1:Tform;
dll,keybhook,mousehook:car dinal;
i:integer;
geti:function:integer;
seti:procedure ;
cleari:procedure ;
sethook:function :boolean;
unhook:function: boolean;
implementation
{$R *.DFM}
//------------------------ ---------- ---------- ---------- ---------- -
procedure TForm1.FormCreate(Sender: TObject);
begin
dll:=loadlibrary('c:\dephi \newhook\h ook.dll');
cleari:=getprocaddress(dll ,'cleari') ;
cleari;
end;
//------------------------ ---------- ---------- ---------- ---------- -
procedure enabledkeyboardhook;
begin
sethook:=getprocaddress(dl l,'sethook ');
sethook;
end;
procedure disablekeyboardhook;
begin
unhook:=getprocaddress(dll ,'unhook') ;
unhook;
freelibrary(dll);
end;
procedure TForm1.Button1Click(Sender : TObject);
begin
enabledkeyboardhook;
end;
procedure TForm1.Button2Click(Sender : TObject);
begin
disablekeyboardhook;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
j:integer;
begin
geti:=getprocaddress(dll,' geti');
j:=geti;
edit1.text:=edit1.text+int tostr(j);
cleari:=getprocaddress(dll ,'cleari') ;
cleari ;
end;
end.
//------------------------ ---------- -----end of my application
can you give more answer?
Best Regards
Wang, Zheng
Thank for your answer.
The goal of my generating the hook function is to monitor the keystroke.
In the DLL, I use a variable i to be the mark whether a keystroke occured.
If occured , it will set i to 1.
And I use a timer to read the i status and
clear i to zero every 3 second in application where call the DLL.
After I added your codes to DLL, it can send keystroke message back to the application I call the hook. But outside of the application form, when I press key nothing happen (mark i not to be set to 1)
below is my DLL and application :
//------------------------
library hook;
uses
Unit2 in 'Unit2.pas';
exports hookproc index 1 name 'hookproc' ;
exports sethook index 2 name 'sethook' ;
exports unhook index 3 name 'unhook' ;
exports geti index 4 name 'geti' ;
exports seti index 5 name 'seti' ;
exports cleari index 6 name 'cleari' ;
begin
hookedalready:=false;
end.
//--
unit Unit2;
interface
uses Wintypes,Winprocs,Messages
procedure SetHook;export;
procedure UnHook; export;
function HookProc(Code:integer; wParam: Word; lParam: Longint): Longint;export;
function geti :integer;export;
procedure seti ;export;
procedure cleari ;export;
var
HookedAlready:Boolean;
i:integer;
ourHook:HHook;
implementation
function geti :integer;
begin
result:=i;
end;
procedure seti ;
begin
i:=1;
end;
procedure cleari ;
begin
i:=0;
end;
procedure SetHook ;
begin
if HookedAlready then exit;
ourHook:= SetWindowsHookEx(WH_KEYBOA
HookedAlready:=True;
end;
procedure UnHook ;
begin
UnHookWindowsHookEx(ourHoo
HookedAlready:=False;
end;
function HookProc(Code:integer; wParam: Word; lParam: Longint): Longint;
begin
if Code > 0 then
begin
//if wparam = WH_KEYBOARD then MessageBeep(1);
Result := CallNextHookEx(ourhook, Code, Wparam,lparam);
seti;
end else
begin
Result := CallNextHookEx(ourhook, Code, Wparam,lparam);
seti;
end
end;
end.
//------------------------
//------------------------
unit callhook;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
public
{ Public declarations }
end;
var
form1:Tform;
dll,keybhook,mousehook:car
i:integer;
geti:function:integer;
seti:procedure ;
cleari:procedure ;
sethook:function :boolean;
unhook:function: boolean;
implementation
{$R *.DFM}
//------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
dll:=loadlibrary('c:\dephi
cleari:=getprocaddress(dll
cleari;
end;
//------------------------
procedure enabledkeyboardhook;
begin
sethook:=getprocaddress(dl
sethook;
end;
procedure disablekeyboardhook;
begin
unhook:=getprocaddress(dll
unhook;
freelibrary(dll);
end;
procedure TForm1.Button1Click(Sender
begin
enabledkeyboardhook;
end;
procedure TForm1.Button2Click(Sender
begin
disablekeyboardhook;
end;
procedure TForm1.Timer1Timer(Sender:
var
j:integer;
begin
geti:=getprocaddress(dll,'
j:=geti;
edit1.text:=edit1.text+int
cleari:=getprocaddress(dll
cleari ;
end;
end.
//------------------------
can you give more answer?
Best Regards
Wang, Zheng
ASKER
Mr inthe:
Thank for your answer.
The goal of my generating the hook function is to monitor the keystroke.
In the DLL, I use a variable i to be the mark whether a keystroke occured.
If occured , it will set i to 1.
And I use a timer to read the i status and
clear i to zero every 3 second in application where call the DLL.
After I added your codes to DLL, it can send keystroke message back to the application I call the hook. But outside of the application form, when I press key nothing happen (mark i not to be set to 1)
below is my DLL and application :
//------------------------ ---------- -DLL
library hook;
uses
Unit2 in 'Unit2.pas';
exports hookproc index 1 name 'hookproc' ;
exports sethook index 2 name 'sethook' ;
exports unhook index 3 name 'unhook' ;
exports geti index 4 name 'geti' ;
exports seti index 5 name 'seti' ;
exports cleari index 6 name 'cleari' ;
begin
hookedalready:=false;
end.
//--
unit Unit2;
interface
uses Wintypes,Winprocs,Messages ;
procedure SetHook;export;
procedure UnHook; export;
function HookProc(Code:integer; wParam: Word; lParam: Longint): Longint;export;
function geti :integer;export;
procedure seti ;export;
procedure cleari ;export;
var
HookedAlready:Boolean;
i:integer;
ourHook:HHook;
implementation
function geti :integer;
begin
result:=i;
end;
procedure seti ;
begin
i:=1;
end;
procedure cleari ;
begin
i:=0;
end;
procedure SetHook ;
begin
if HookedAlready then exit;
ourHook:= SetWindowsHookEx(WH_KEYBOA RD,@HookPr oc,HInstan ce,0);
HookedAlready:=True;
end;
procedure UnHook ;
begin
UnHookWindowsHookEx(ourHoo k);
HookedAlready:=False;
end;
function HookProc(Code:integer; wParam: Word; lParam: Longint): Longint;
begin
if Code > 0 then
begin
//if wparam = WH_KEYBOARD then MessageBeep(1);
Result := CallNextHookEx(ourhook, Code, Wparam,lparam);
seti;
end else
begin
Result := CallNextHookEx(ourhook, Code, Wparam,lparam);
seti;
end
end;
end.
//------------------------ ---------- --end of DLL
//------------------------ ------my application:
unit callhook;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
public
{ Public declarations }
end;
var
form1:Tform;
dll,keybhook,mousehook:car dinal;
i:integer;
geti:function:integer;
seti:procedure ;
cleari:procedure ;
sethook:function :boolean;
unhook:function: boolean;
implementation
{$R *.DFM}
//------------------------ ---------- ---------- ---------- ---------- -
procedure TForm1.FormCreate(Sender: TObject);
begin
dll:=loadlibrary('c:\dephi \newhook\h ook.dll');
cleari:=getprocaddress(dll ,'cleari') ;
cleari;
end;
//------------------------ ---------- ---------- ---------- ---------- -
procedure enabledkeyboardhook;
begin
sethook:=getprocaddress(dl l,'sethook ');
sethook;
end;
procedure disablekeyboardhook;
begin
unhook:=getprocaddress(dll ,'unhook') ;
unhook;
freelibrary(dll);
end;
procedure TForm1.Button1Click(Sender : TObject);
begin
enabledkeyboardhook;
end;
procedure TForm1.Button2Click(Sender : TObject);
begin
disablekeyboardhook;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
j:integer;
begin
geti:=getprocaddress(dll,' geti');
j:=geti;
edit1.text:=edit1.text+int tostr(j);
cleari:=getprocaddress(dll ,'cleari') ;
cleari ;
end;
end.
//------------------------ ---------- -----end of my application
can you give more answer?
Best Regards
Wang, Zheng
Thank for your answer.
The goal of my generating the hook function is to monitor the keystroke.
In the DLL, I use a variable i to be the mark whether a keystroke occured.
If occured , it will set i to 1.
And I use a timer to read the i status and
clear i to zero every 3 second in application where call the DLL.
After I added your codes to DLL, it can send keystroke message back to the application I call the hook. But outside of the application form, when I press key nothing happen (mark i not to be set to 1)
below is my DLL and application :
//------------------------
library hook;
uses
Unit2 in 'Unit2.pas';
exports hookproc index 1 name 'hookproc' ;
exports sethook index 2 name 'sethook' ;
exports unhook index 3 name 'unhook' ;
exports geti index 4 name 'geti' ;
exports seti index 5 name 'seti' ;
exports cleari index 6 name 'cleari' ;
begin
hookedalready:=false;
end.
//--
unit Unit2;
interface
uses Wintypes,Winprocs,Messages
procedure SetHook;export;
procedure UnHook; export;
function HookProc(Code:integer; wParam: Word; lParam: Longint): Longint;export;
function geti :integer;export;
procedure seti ;export;
procedure cleari ;export;
var
HookedAlready:Boolean;
i:integer;
ourHook:HHook;
implementation
function geti :integer;
begin
result:=i;
end;
procedure seti ;
begin
i:=1;
end;
procedure cleari ;
begin
i:=0;
end;
procedure SetHook ;
begin
if HookedAlready then exit;
ourHook:= SetWindowsHookEx(WH_KEYBOA
HookedAlready:=True;
end;
procedure UnHook ;
begin
UnHookWindowsHookEx(ourHoo
HookedAlready:=False;
end;
function HookProc(Code:integer; wParam: Word; lParam: Longint): Longint;
begin
if Code > 0 then
begin
//if wparam = WH_KEYBOARD then MessageBeep(1);
Result := CallNextHookEx(ourhook, Code, Wparam,lparam);
seti;
end else
begin
Result := CallNextHookEx(ourhook, Code, Wparam,lparam);
seti;
end
end;
end.
//------------------------
//------------------------
unit callhook;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
public
{ Public declarations }
end;
var
form1:Tform;
dll,keybhook,mousehook:car
i:integer;
geti:function:integer;
seti:procedure ;
cleari:procedure ;
sethook:function :boolean;
unhook:function: boolean;
implementation
{$R *.DFM}
//------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
dll:=loadlibrary('c:\dephi
cleari:=getprocaddress(dll
cleari;
end;
//------------------------
procedure enabledkeyboardhook;
begin
sethook:=getprocaddress(dl
sethook;
end;
procedure disablekeyboardhook;
begin
unhook:=getprocaddress(dll
unhook;
freelibrary(dll);
end;
procedure TForm1.Button1Click(Sender
begin
enabledkeyboardhook;
end;
procedure TForm1.Button2Click(Sender
begin
disablekeyboardhook;
end;
procedure TForm1.Timer1Timer(Sender:
var
j:integer;
begin
geti:=getprocaddress(dll,'
j:=geti;
edit1.text:=edit1.text+int
cleari:=getprocaddress(dll
cleari ;
end;
end.
//------------------------
can you give more answer?
Best Regards
Wang, Zheng
i dont have the time for 6 points ?
sorry that seems not fair to me ,but it should be something like:
function HookProc(Code:integer; wParam: Word; lParam: Longint): Longint;
begin
if Code <> 0 then
begin
seti; {do your stuff then pass on call}
Result := CallNextHookEx(ourhook,Cod e,Wparam,l param);
end
else {code = 0 so pass on call}
Result := CallNextHookEx
(ourhook, Code, Wparam,lparam);
end;
end;
sorry that seems not fair to me ,but it should be something like:
function HookProc(Code:integer; wParam: Word; lParam: Longint): Longint;
begin
if Code <> 0 then
begin
seti; {do your stuff then pass on call}
Result := CallNextHookEx(ourhook,Cod
end
else {code = 0 so pass on call}
Result := CallNextHookEx
(ourhook, Code, Wparam,lparam);
end;
end;
ASKER
Mr inthe:
I will express my very sorry not to give you the 6 point . I am one new Experts-Exchange's member, it is the first time I ask question, I am not familar with some operation , after received your first answer I increase the score to 10 point and submit it , but I do not know why you have not received it.
I have done as you said to test your second time codes, I also read a lot of relevant information about hook in the Experts-Exchange-such as Q10097258,Q10043315,Q10199 528 and etc. There are a lot of different answer.
Finally I think may be as below:
//------------------------ ---------- ---------- --------
function HookProc(Code:integer; wParam: Word; lParam:
Longint): Longint;
begin
if Code < 0 then
Result := CallNextHookEx
(ourhook, Code, Wparam,lparam);
else
begin
{do my stuff then pass on call}
messagebeep(1);
seti;
Result :=0;
end;
end;
//------------------------ ---------- ---------- --
but if I did as above, another two problem also confuse me:
1.if keystrike occured on my form where call the DLL, then beep right sounds, the value of i will be 1.
if keystrike occured on other form , then beep sounds, the value of i will be 0, not as I hope to be 1.
2.before I call the DLL, there is another HOOK program reside in win95 system whose main function is to capture the keyboard strike and input the special char- two segment char , after I call my DLL, then the another HOOK program does not do the work as previous.
If I unhook the my hook, then the another program resume.
It really is a big problem to me. I think the right answer of the question is worthy of at least 20 point. I do not know how to pay it.
Best Regards
Wang, Zheng
I will express my very sorry not to give you the 6 point . I am one new Experts-Exchange's member, it is the first time I ask question, I am not familar with some operation , after received your first answer I increase the score to 10 point and submit it , but I do not know why you have not received it.
I have done as you said to test your second time codes, I also read a lot of relevant information about hook in the Experts-Exchange-such as Q10097258,Q10043315,Q10199
Finally I think may be as below:
//------------------------
function HookProc(Code:integer; wParam: Word; lParam:
Longint): Longint;
begin
if Code < 0 then
Result := CallNextHookEx
(ourhook, Code, Wparam,lparam);
else
begin
{do my stuff then pass on call}
messagebeep(1);
seti;
Result :=0;
end;
end;
//------------------------
but if I did as above, another two problem also confuse me:
1.if keystrike occured on my form where call the DLL, then beep right sounds, the value of i will be 1.
if keystrike occured on other form , then beep sounds, the value of i will be 0, not as I hope to be 1.
2.before I call the DLL, there is another HOOK program reside in win95 system whose main function is to capture the keyboard strike and input the special char- two segment char , after I call my DLL, then the another HOOK program does not do the work as previous.
If I unhook the my hook, then the another program resume.
It really is a big problem to me. I think the right answer of the question is worthy of at least 20 point. I do not know how to pay it.
Best Regards
Wang, Zheng
if Code >= 0 then begin
should read:
if Code > 0 then begin
it is the first call to callnexthookex that passes the message on..and the seciond call passes it if the code not > 0 .