Detecting key-strokes...

[3MTA3]

Hey!

How can my app detect key-strokes, in form of single keys
being pressed (including shift, ctrl, etc), and key-
combinations, when it is working in the background?

Example: If I press the F2-key in Explorer (in order to
change the selected file's name), how will my program know
that F2 was pressed?

Thanks!

 

[McMerfy]

You have to set up a hook. RTM SetWindowsHookEx. I want to add just one thing a hook procedure must be in a .DLL.

--- markus

 

[paulbenn]

If you are using Delphi 5 or above you could add an actionlist to your form and assign the actions for the keys you wish to look out for. Kind Regards, Paul Benn

**** Never Giveup, keep trying, the answer is out there!!! ****

 

[McMerfy]

That won't work if you need to detect keys pressed outside your application.

--- markus

 

[3MTA3]

Hmmm...
Could someone give me an example of using the
keyboard hook method (or any other method for that matter).
(please, insert a piece of code)
I want it to work outside the application -> when it is
not visible or active!

It can't be THAT difficult, can it?

 

[McMerfy]

You asked for it....
In my example i had a main application, a unit that contained shared functions, and a DLL (because global hooks must be called from DLLs)

// === DLL code.
library HooksLib;
uses
  SysUtils, Classes, Windows, Messages, UShared;

function AMouseProc(Code : Integer; wParam : WPARAM; lParam: LPARAM):LRESULT;stdcall;
begin
  if (Code >= 0) then
  begin
    if ((wParam = WM_LBUTTONDOWN)or(wParam = WM_RBUTTONDOWN)) then
     PostMessage(SharedData^.hMainWnd, SharedData^.WMMessage, 1, 0);
    if (wParam = WM_MOUSEMOVE) then
     PostMessage(SharedData^.hMainWnd, SharedData^.WMMessage, 1, MakeLong(MOUSEHOOKSTRUCT(Pointer(lParam)^).pt.x, MOUSEHOOKSTRUCT(Pointer(lParam)^).pt.y));
  end;
  Result := CallNextHookEx(SharedData^.hMouseHook, Code, wParam, lParam);
end;

function AKeyboardProc(Code : Integer; wParam : WPARAM; lParam: LPARAM):LRESULT;stdcall;
begin
  if (Code >= 0) then
   PostMessage(SharedData^.hMainWnd, SharedData^.WMMessage, 0, 0);
  Result := CallNextHookEx(SharedData^.hKBHook, Code, wParam, lParam);
end;

exports
  AMouseProc index 1 name 'AMouseProc',
  AKeyboardProc index 2 name 'AKeyboardProc';

{$R *.RES}

procedure LibraryProg(Reason: Integer);
begin
 case Reason of
   DLL_PROCESS_ATTACH: CreateOrOpenMemShare();
 end;
end;

begin
  DLLProc := @LibraryProg;
  LibraryProg(DLL_PROCESS_ATTACH);
end.
// === DLL code ends here

// === Shared unit code
unit UShared;

interface
uses Windows, Messages;

const
  MemShareName = 'SharedData.mem';
  MessageName  = 'WM_HOOKEVENT';
type
  TMemoryData = packed record
    WMMessage   : Cardinal;
    hTraceWnd   : HWND;
    hMainWnd    : HWND;
    hMouseHook  : HHOOK;
    hKBHook     : HHOOK;
  end;
  PMemoryData = ^TMemoryData;

  THookProc = function (Code : Integer; wParam : WPARAM; lParam: LPARAM):LRESULT of object; stdcall;

function CreateOrOpenMemShare():Boolean;
function CloseMemShare():Boolean;

var
  hMappedFile    : Cardinal = 0;
  MappingExists  : Boolean  = False;
  SharedData     : PMemoryData = nil;

implementation

function CreateOrOpenMemShare():Boolean;
var
  NewlyCreated : Boolean;
begin
  Result := False;
  hMappedFile := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(TMemoryData), pChar(MemShareName));
  if (hMappedFile <> 0) then
  begin
    NewlyCreated := (GetLastError <> ERROR_ALREADY_EXISTS);
    SharedData := MapViewOfFile(hMappedFile, FILE_MAP_ALL_ACCESS, 0, 0, 0);
    Result := Assigned(SharedData);
    MappingExists := Result;
    if (Result and NewlyCreated) then
     FillChar(SharedData^, SizeOf(TMemoryData), 0);
  end;
end;

function CloseMemShare():Boolean;
begin
  Result := True;
  if MappingExists then
   UnmapViewOfFile(SharedData);
  if (hMappedFile <> 0) then
   CloseHandle(hMappedFile);
  MappingExists := False;
end;

end.
// === Shared unit code ends here

// === And how to call it from your application
unit UMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, UShared;


const
  WM_HOOKEVENT   = WM_USER + 300;

type
  TfrMain = class(TForm)
    eWndName          : TEdit;
    btnFind           : TButton;
    Bevel1            : TBevel;
    Panel1            : TPanel;
    btnRemove         : TButton;
    btnSet            : TButton;
    eTimeOut          : TEdit;
    Label1            : TLabel;
    lbStatus          : TListBox;
    XPos              : TLabel;
    YPos              : TLabel;
    procedure btnFindClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnSetClick(Sender: TObject);
    procedure btnRemoveClick(Sender: TObject);
  private
    { Private declarations }
    TraceWnd          : HWND;
    HooksSet          : Boolean;
    HLibrary          : Cardinal;
    procedure AppMessageHandler(var Msg : TMsg; var Handled : Boolean);
  public
    { Public declarations }
  end;

var
  frMain: TfrMain;

implementation

{$R *.DFM}

procedure TfrMain.btnFindClick(Sender: TObject);
begin
  if (eWndName.Text = '') then
  begin
    ShowMessage('Specify a window name');
    Exit;
  end;
  TraceWnd := FindWindow(nil, pChar(eWndName.Text));
  if (TraceWnd = 0) then
  begin
    ShowMessage('Window not found');
    Exit;
  end;
  btnFind.Enabled := False;
  btnSet.Enabled := True;
end;

procedure TfrMain.FormCreate(Sender: TObject);
begin
  hLibrary := 0;
    Application.OnMessage := AppMessageHandler;
  if CreateOrOpenMemShare() then
  begin
    SharedData^.hMainWnd := Application.Handle;
    SharedData^.WMMessage := WM_HOOKEVENT;
  end
  else
   btnFind.Enabled := False;
end;

procedure TfrMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Application.OnMessage := nil;
  if (HLibrary <> 0) then
   FreeLibrary(HLibrary);
  CloseMemShare();
end;

procedure TfrMain.btnSetClick(Sender: TObject);
var
  AHookProc   : THookProc;
begin
  HLibrary := LoadLibrary('HooksLib.dll');
  if (HLibrary = 0) then
  begin
    ShowMessage('Library not found');
    Exit;
  end;
  AHookProc := nil;
  //--- Setting Mouse hook.
  @AHookProc := GetProcAddress(hLibrary, 'AMouseProc');
  if (Assigned(@AHookProc)) then
   SharedData^.hMouseHook := SetWindowsHookEx(WH_MOUSE, @AHookProc, HLibrary, 0)
  else
  begin
    FreeLibrary(HLibrary);
    hLibrary := 0;
    ShowMessage('Failed to setup mouse hook');
    Exit;
  end;
  //--- Setting Keyboard hook.
  @AHookProc := GetProcAddress(hLibrary, 'AKeyboardProc');
  if (Assigned(@AHookProc)) then
   SharedData^.hKBHook := SetWindowsHookEx(WH_KEYBOARD, @AHookProc, HLibrary, 0)
  else
  begin
    FreeLibrary(HLibrary);
    hLibrary := 0;
    ShowMessage('Failed to setup keyboard hook');
    Exit;
  end;
  if ((SharedData^.hMouseHook <> 0)and(SharedData^.hKBHook <> 0)) then
  begin
    btnSet.Enabled := False;
    btnRemove.Enabled := True;
    SharedData^.hTraceWnd := TraceWnd;
    HooksSet := True;
    lbStatus.Clear;
  end;
end;

procedure TfrMain.btnRemoveClick(Sender: TObject);
begin
  UnHookWindowsHookEx(SharedData^.hMouseHook);
  UnHookWindowsHookEx(SharedData^.hKBHook);
  HooksSet := False;
  FreeLibrary(HLibrary);
  HLibrary := 0;
  btnSet.Enabled := True;
  btnFind.Enabled := True;
  btnRemove.Enabled := False;
end;

procedure TfrMain.AppMessageHandler(var Msg: TMsg; var Handled: Boolean);
begin
  if (Msg.message = WM_HOOKEVENT) then
  begin
    if (GetForeGroundWindow() = SharedData^.hTraceWnd) then
    begin
      if (Msg.LParam = 0) then
      begin
        if (Msg.WParam = 0) then
         lbStatus.Items.Add('-Keyboard signaled');
        if (Msg.WParam = 1) then
         lbStatus.Items.Add('-Mouse signaled');
      end
      else
      begin
        XPos.Caption := 'XPos : ' + IntToStr(LoWord(Msg.LParam));
        YPos.Caption := 'YPos : ' + IntToStr(HiWord(Msg.LParam));
      end;
    end;
    Handled := True;
  end;
end;
end.
// === That's all.

Hope that helps.

--- markus