[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2218
  • Last Modified:

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
0
edhasted
Asked:
edhasted
  • 6
  • 4
1 Solution
 
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.
0
 
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
0
 
BlackTigerXCommented:
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

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

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

With very many thanks,

Ed Hasted
0
 
A. Cristian CsikiSenior System AdministratorCommented:
glad i could help.
best wishes.
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 6
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now