Delphi - how to capture all keystrokes

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
LVL 1
edhastedAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

A. Cristian CsikiSenior System AdministratorCommented:
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.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
A. Cristian CsikiSenior System AdministratorCommented:
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
BlackTigerXCommented:
Become a Microsoft Certified Solutions Expert

This course teaches how to install and configure Windows Server 2012 R2.  It is the first step on your path to becoming a Microsoft Certified Solutions Expert (MCSE).

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

Many thanks - Ed
edhastedAuthor 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 System AdministratorCommented:
hy edhasted, i'll post a link for download. My project captures all keystrokes even he is not focused.
A. Cristian CsikiSenior System AdministratorCommented:
here's the receiver source.
http://www.filehost.ro/125830/Reciever_rar/

enjoy
edhastedAuthor Commented:
Hum - that link doesn't task me to the link I think you intended :-)
A. Cristian CsikiSenior System AdministratorCommented:
sry, my bad. try this: http://www.uploading.com/?get=ZIVU6I1W.
edhastedAuthor Commented:
Can I thank "nodramas" for not only a really clever, but complete, solution.

With very many thanks,

Ed Hasted
A. Cristian CsikiSenior System AdministratorCommented:
glad i could help.
best wishes.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.