We help IT Professionals succeed at work.

Delphi - how to capture all keystrokes

edhasted
edhasted asked
on
Medium Priority
2,732 Views
Last Modified: 2010-04-04
I'm need to write a program for some blind users. They read the screen with a voice box. However their tutors are often helping them remotely. Knowing what keys they have actually pressed can be very hit and miss. So I need to write a program that can display whatever keystrokes they have typed in. This can be simply displayed in a memo box so their remote tutors can see what is actually going on.

How do I capture the keystroke feed, and maybe mouse left or right click, if the Delphi app doesn't have the focus.

With many thanks,

Ed
Comment
Watch Question

Senior Security Administrator
CERTIFIED EXPERT
Commented:
well you might need a key hook. here is an exemple:

create a dll,

LIBRARY KeyHandler; {$R Keyboard.res}
  USES
    Windows,
    Messages;

  CONST
    CM_SEND_KEY = WM_USER + $1000;

  VAR
    Keybrd: HHook;
    MemFile: THandle;
    Reciever: ^Integer;

  Function HookCallBack(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
  {This is the CallBack function called by the Hook}
  Begin
  {if a key was pressed/released}
    if (code = HC_ACTION) then begin
    {attempt to map to MemFile}
      MemFile := OpenFileMapping(FILE_MAP_READ, False, 'KeyReciever');
    {if mapping successful, send keypress to receiver application}
      if (MemFile <> 0) then begin
        Reciever := MapViewOfFile(MemFile, FILE_MAP_READ, 0, 0, 0);
        PostMessage(Reciever^, CM_SEND_KEY, wParam, lParam);
        UnmapViewOfFile(Reciever);
        CloseHandle(MemFile);
      end;
    end;
    {call to next hook of the chain}
    Result := CallNextHookEx(Keybrd, Code, wParam, lParam)
  End;

  Procedure HookOn; stdcall;
  {procedure to install the hook}
  Begin
    Keybrd := SetWindowsHookEx(WH_KEYBOARD, @HookCallBack, HInstance, 0);
  End;

  Procedure HookOff; stdcall;
  {procedure to uninstall the hook}
  Begin
    UnhookWindowsHookEx(Keybrd);
  End;

  EXPORTS

  { Export the following Procedures/Functions }

  HookOn,
  HookOff;

BEGIN
END.

afterwords,  use this:

 USES
    Windows, Messages, SysUtils,
    Classes, Graphics, Controls,
    Forms, Dialogs, StdCtrls;

  CONST
    DLLName = 'KeyHandler.dll';
    CM_SEND_KEY = WM_USER + $1000;

  TYPE
    TKeyHandler = Procedure; stdcall;

    Type
      TForm1 = class(TForm)
      { Protected declarations }
        Memo1: TMemo;
        Procedure FormCreate(Sender: TObject);
        Procedure FormDestroy(Sender: TObject);
      Private
     { Private declarations }
        MemFile: THandle;
        Reciever: ^Integer;
        DLLHandle: THandle;
        HookOn,
        HookOff: TKeyHandler;
        Procedure ScanHook(var message: TMessage); message CM_SEND_KEY;
      Public
      { Public declarations }
        //NONE
    End;

  VAR
    Form1: TForm1;

  IMPLEMENTATION {$R *.DFM}
Function/Procedure Definitions}
  Procedure TForm1.FormCreate(Sender: TObject);
  Begin
  {Initialize the TMemo control (Used for test display)}
    Memo1.Lines.Clear;
    Memo1.ReadOnly := TRUE;

  {Load DLL and aquire Handle}
    DLLHandle := LoadLibrary( PChar(ExtractFilePath(Application.Exename) + DLLName ) );
    if (DLLHandle = 0) then begin
      raise Exception.Create('Unable to Load DLL');
    end;

  {Check for and bind functions located in external DLL}
    @HookOn := GetProcAddress(DLLHandle, 'HookOn');
    @HookOff := GetProcAddress(DLLHandle, 'HookOff');
    if not assigned(HookOn) or not assigned(HookOff)  then begin
      raise Exception.Create('Unable to locate the required DLL functions');
    end;

  {Attempt to create a memory mapped file}
    MemFile := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(Integer), 'KeyReciever');
    if (MemFile = 0) then begin
      raise Exception.Create('Error while creating file');
    end;

  {Write DLL data to the memory mapped file MemFile}
    Reciever := MapViewOfFile(MemFile, FILE_MAP_WRITE, 0, 0, 0);

  {Direct memory mapped file through Reciever}
    Reciever^ := Handle;
    HookOn;

  End;

  Procedure TForm1.ScanHook(var Message: TMessage);
  Var
    KeyName: array[0..100] of char;
    Action: string;
  Begin
  {Virtual key code to Key Name}
    GetKeyNameText(Message.LParam,@KeyName,100);

  {Display if the key was pressed, released, or held down}
    if ((Message.lParam shr 31) and 1) = 1 then begin
      Action := 'KeyUp'; {key released}
    end else begin
      if ((Message.lParam shr 30) and 1) = 1 then begin
        Action := 'KeyRepeat'; {key held down}
      end else begin
        Action := 'KeyDown'; {key pressed}
      end;
    end;
    Memo1.Lines.Append(Action + ': ' + String(KeyName) );

  End;
  Procedure TForm1.FormDestroy(Sender: TObject);
  Begin
  {Uninstall the Hook}
    if Assigned(HookOff) then begin
      HookOff;
    end;

  {Free the DLL}
    if (DLLHandle <> 0) then begin
      FreeLibrary(DLLHandle);
    end;

  {Close the memfile and the View}
    if (MemFile <> 0) then begin
      UnmapViewOfFile(Reciever);
      CloseHandle(MemFile);
    end;

  End;

END.

original by Xorcist,
regards.

Not the solution you were looking for? Getting a personalized solution is easy.

Ask the Experts
A. Cristian CsikiSenior Security Administrator
CERTIFIED EXPERT

Commented:
and for clicks, use this:

private
  procedure WMNCRBUTTONDOWN(var msg: TMessage); message WM_NCRBUTTONDOWN;
  procedure WMNCLBUTTONDOWN(var msg: TMessage); message WM_NCLBUTTONDOWN;
  procedure WMNCLBUTTONDBLCLK(var msg: TMessage); message WM_NCLBUTTONDBLCLK;
end;



implementation


procedure TForm1.WMNCRBUTTONDOWN(var msg: TMessage);
begin
  if msg.wParam = HTCAPTION then Caption := 'Right Click!';
  // Message.Result := 0; {to ignore the message}
  inherited;
end;

procedure TForm1.WMNCLBUTTONDOWN(var msg: TMessage);
begin
  if msg.wParam = HTCAPTION then Caption := 'Left Click!';
  // Message.Result := 0; {to ignore the message}
  inherited;
end;

procedure TForm1.WMNCLBUTTONDBLCLK(var msg: TMessage);
begin
  if msg.wParam = HTCAPTION then Caption := 'Double Click!';
  // Message.Result := 0; {to ignore the message}
  inherited;
end;

probably might help. //from torry's page

Author

Commented:
Will work my way through these over the weekend - they look extremely impressive and just what I'm looking for.

Many thanks - Ed

Author

Commented:
Have compiled NODRAMAS's code OK, however I've clearly missed something out.
I put the obvious memo box in the form but text only appears in it when I have focus on the Memo box, which is how they normally work.
Isn't it meant to record the keystokes into the memo box irrespective of what and where I am typing?

Any ideas?

Ed
A. Cristian CsikiSenior Security Administrator
CERTIFIED EXPERT

Commented:
hy edhasted, i'll post a link for download. My project captures all keystrokes even he is not focused.
A. Cristian CsikiSenior Security Administrator
CERTIFIED EXPERT

Commented:
here's the receiver source.
http://www.filehost.ro/125830/Reciever_rar/

enjoy

Author

Commented:
Hum - that link doesn't task me to the link I think you intended :-)
A. Cristian CsikiSenior Security Administrator
CERTIFIED EXPERT

Commented:
sry, my bad. try this: http://www.uploading.com/?get=ZIVU6I1W.

Author

Commented:
Can I thank "nodramas" for not only a really clever, but complete, solution.

With very many thanks,

Ed Hasted
A. Cristian CsikiSenior Security Administrator
CERTIFIED EXPERT

Commented:
glad i could help.
best wishes.
Access more of Experts Exchange with a free account
Thanks for using Experts Exchange.

Create a free account to continue.

Limited access with a free account allows you to:

  • View three pieces of content (articles, solutions, posts, and videos)
  • Ask the experts questions (counted toward content limit)
  • Customize your dashboard and profile

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.