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_KEYBOARD,@HookProc,HInstance,0);
HookedAlready:=True;
end;
procedure UnHook ;
begin
UnHookWindowsHookEx(ourHook);
HookedAlready:=False;
end;
function HookProc(Code:integer; wParam: Word; lParam: Longint): Longint;
begin
 
 
     if code<0 then
     begin
     {my program}
      result:=CallNextHookEx(ourHook,Code,wParam,lParam);

     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(dll,'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

 

wangzhengAsked:
Who is Participating?
 
intheConnect With a Mentor Commented:
try like this:

function HookProc(Code:integer; wParam: Word; lParam: Longint): Longint;
begin
  if Code >= 0 then begin
     if Msg = WM_somemesage then
      MessageBeep(1);
    Result := CallNextHookEx(HookHandle, Code, Msg, MouseHook);
  end else
    Result := CallNextHookEx(HookHandle, Code, Msg, MouseHook);
end;
0
 
intheCommented:
typo:
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 .
0
 
wangzhengAuthor Commented:
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_KEYBOARD,@HookProc,HInstance,0);
HookedAlready:=True;
end;
procedure UnHook ;
begin
UnHookWindowsHookEx(ourHook);
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:cardinal;
   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\hook.dll');
    cleari:=getprocaddress(dll,'cleari');
    cleari;
end;



//-----------------------------------------------------------------
procedure  enabledkeyboardhook;
begin
     sethook:=getprocaddress(dll,'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+inttostr(j);

cleari:=getprocaddress(dll,'cleari');
cleari ;

end;

 
end.
//---------------------------------------end of my application


can you give more answer?

Best Regards

Wang, Zheng



0
[Webinar] Kill tickets & tabs using PowerShell

Are you tired of cycling through the same browser tabs everyday to close the same repetitive tickets? In this webinar JumpCloud will show how you can leverage RESTful APIs to build your own PowerShell modules to kill tickets & tabs using the PowerShell command Invoke-RestMethod.

 
wangzhengAuthor Commented:
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_KEYBOARD,@HookProc,HInstance,0);
HookedAlready:=True;
end;
procedure UnHook ;
begin
UnHookWindowsHookEx(ourHook);
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:cardinal;
   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\hook.dll');
    cleari:=getprocaddress(dll,'cleari');
    cleari;
end;



//-----------------------------------------------------------------
procedure  enabledkeyboardhook;
begin
     sethook:=getprocaddress(dll,'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+inttostr(j);

cleari:=getprocaddress(dll,'cleari');
cleari ;

end;

 
end.
//---------------------------------------end of my application


can you give more answer?

Best Regards

Wang, Zheng



0
 
intheCommented:
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,Code,Wparam,lparam);
 end
else  {code = 0 so pass on call}
Result := CallNextHookEx
(ourhook, Code, Wparam,lparam);
 end;
 
end;
0
 
wangzhengAuthor Commented:
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,Q10199528 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


0
All Courses

From novice to tech pro — start learning today.