Repeating the function until I release the CTRL button

Question

I need a code, which will be constantly pressing the arrow up button when I am holding the ctrl button on keyboard - to simulate ctrl (pressed until i release it) + arrow up. The code I got so far:

function LowLevelKeybdHookProc(nCode, wParam, lParam : integer) : integer; stdcall;
var
  info : ^KeybdLLHookStruct absolute lParam;
  lpChar : word;
  kState : TKeyboardState;
  s:string;
  i:integer;
  inputArray: array[0..3] of TInput;
begin
result := CallNextHookEx(kHook, nCode, wParam, lParam);



with info^ do

case wParam of
  wm_keydown : begin

    GetKeyboardState(kState);


  if  GetKeyState(VK_CONTROL) = 0  then

  begin
  inputArray[0].Itype := INPUT_KEYBOARD;
  inputArray[0].ki.wVk := VK_UP;
  inputArray[1].Itype := INPUT_KEYBOARD;
  inputArray[1].ki.wVk := VK_UP;
  inputArray[1].ki.dwFlags := KEYEVENTF_KEYUP;


  SendInput(length(inputArray), inputArray[0], sizeof(TInput));
  end;

end;
end;
end;

I tried to make it myself, but something doesnt work properly - it's like a strange mouse and keyboard glitch, which keeps the arrow button and sometimes even right mouse click pressed and could be fixed only when clicking ctrl+alt+delete. I would appreciate any help. Thank you.

Answer 1

This one seems to be working, but with some kind of delay:

function LowLevelKeybdHookProc(nCode, wParam, lParam : integer) : integer; stdcall;
// possible wParam values: WM_KEYDOWN, WM_KEYUP, WM_SYSKEYDOWN, WM_SYSKEYUP
var
  info : ^KeybdLLHookStruct absolute lParam;
  lpChar : word;
  kState : TKeyboardState;
begin
result := CallNextHookEx(kHook, nCode, wParam, lParam);



with info^ do

case wParam of
  wm_keydown : begin

    GetKeyboardState(kState);


  if GetKeyState(VK_CONTROL) < 0 then
 begin

  keybd_event(VK_UP, 0, 0, 0);
  keybd_event(VK_UP, 0, KEYEVENTF_KEYUP, 0);

end;
end;
end;
end;

It's like I really got to hold the control pressed for a while. I need something with a much faster reaction.

Answer 2

Ok. Here's the MVP written in Lazarus 2.2.6 x64. It doesn't handle corner cases and hardly follows so called best practices.

1. Global hook. It is located within DLL and only notifies parent app about CTRL press/release. I find it wrong to fire a keyboard event inside a hook.

library LibHook;

{$mode ObjFPC}{$H+}

uses
  Windows, Messages;

const
  WH_KEYBOARD_LL = 13;
  WM_HOOK_NOTIFY = WM_USER + 100;

type
  PKBDLLHOOKSTRUCT = ^TKBDLLHOOKSTRUCT;
  TKBDLLHOOKSTRUCT = packed record
    vkCode      : DWORD;
    scanCode    : DWORD;
    flags       : DWORD;
    time        : DWORD;
    dwExtraInfo : ULONG_PTR;
  end;

var
  hParentWnd : HANDLE;
  hKeybHook  : HHOOK;

function LLKeybHookProc( nCode: integer; wPar: WPARAM; lPar: LPARAM ): LRESULT; stdcall;
var
  isOK        : Boolean;
  pHookStruct : PKBDLLHOOKSTRUCT absolute lPar;

begin
  isOK := ( nCode >= 0 )
          and ( pHookStruct > Pointer(0) )
          and ( pHookStruct^.vkCode in [VK_LCONTROL, VK_RCONTROL] )
          and ( ( wPar = WM_KEYDOWN ) or ( wPar = WM_KEYUP ) );

  if ( not isOK ) then Exit( CallNextHookEx( hKeybHook, nCode, wPar, lPar) );

  PostMessage( hParentWnd, WM_HOOK_NOTIFY, wPar, 0 );
  Result := 0;
end;

procedure ClearHandles();
begin
  hParentWnd := INVALID_HANDLE_VALUE;
  hKeybHook  := 0;
end;

function InstallHook( hWnd: HANDLE ): boolean; stdcall;
begin
  Result := False;
  if ( hParentWnd <> INVALID_HANDLE_VALUE ) then Exit;

  hKeybHook := SetWindowsHookEx( WH_KEYBOARD_LL, @LLKeybHookProc, hInstance, 0 );

  if ( hKeybHook = 0 ) then Exit;

  hParentWnd := hWnd;

  Result := True;
end;

function UninstallHook(): boolean; stdcall;
begin
  if ( hKeybHook <> 0 ) then begin
    Result := UnhookWindowsHookEx( hKeybHook );
    if ( not Result ) then Exit;

    ClearHandles();
  end
  else
    Result := False;
end;

exports
  InstallHook,
  UninstallHook;

Procedure ProcessDetach(dllParam : PtrInt);
Begin
  UninstallHook();
End;

begin
  DLL_PROCESS_DETACH_Hook := @ProcessDetach;
  ClearHandles();
end.

2. Wokrer thread. It is (de)activated when main app receives notification from a hook. When activated it simulates VK_UP keypress.

unit KeyPressThread;

{$mode ObjFPC}{$H+}

interface

uses Classes, Windows;

type

  { TKeyPressThread }

  TKeyPressThread = class( TThread )
    procedure Execute(); override;
  private
    FActive : Boolean;
  public
    Constructor Create( CreateSuspended : boolean );
    property Active: Boolean read FActive write FActive;
  end;

implementation

{ TKeyPressThread }

procedure TKeyPressThread.Execute();
var
  input: TINPUT;

begin
  while ( not Terminated ) do begin
    if ( not FActive ) then begin
      sleep( 100 );
      continue;
    end;

    input._Type        := INPUT_KEYBOARD;
    input.ki.wScan     := 0;              // hardware scan code for key
    input.ki.time      := 0;
    input.ki.ExtraInfo := 0;
    input.ki.wVk       := VK_UP;          // virtual-key code for the UP arrow key
    input.ki.dwFlags   := 0;              // 0 for key press
    SendInput( 1, @input, sizeof(TINPUT) );

    input.ki.dwFlags := KEYEVENTF_KEYUP;  // KEYEVENTF_KEYUP for key release
    SendInput( 1, @input, sizeof(TINPUT) );
  end;
end;

constructor TKeyPressThread.Create( CreateSuspended: boolean );
begin
  inherited Create( CreateSuspended );
  FActive := false;
  FreeOnTerminate := True;
end;

end.

3. Main app.

unit main;

{$mode ObjFPC}{$H+}

interface

uses
  KeyPressThread,
  Messages,
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;

const
  WM_HOOK_NOTIFY = WM_USER + 100;

type

  { TMainForm }

  TMainForm = class( TForm )
    btnHookInstall   : TButton;
    btnHookUninstall : TButton;

    procedure btnHookInstallClick  ( Sender: TObject );
    procedure btnHookUninstallClick( Sender: TObject );
    procedure FormCreate ( Sender: TObject );
    procedure FormDestroy( Sender: TObject );
  private
    FKeypressThread : TKeyPressThread;
    procedure WMHookNotify( var Message: TMessage ); message WM_HOOK_NOTIFY;
  public

  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

function InstallHook( hWindow: THandle ): boolean; stdcall; external 'LibHook.dll' name 'InstallHook';
function UninstallHook(): boolean; stdcall; external 'LibHook.dll' name 'UninstallHook';

{ TMainForm }

procedure TMainForm.btnHookInstallClick( Sender: TObject );
begin
  InstallHook( Self.Handle );
end;

procedure TMainForm.btnHookUninstallClick( Sender: TObject );
begin
  UninstallHook();
end;

procedure TMainForm.FormCreate( Sender: TObject );
begin
  FKeypressThread := TKeyPressThread.Create( False );
end;

procedure TMainForm.FormDestroy( Sender: TObject );
begin
  FKeypressThread.Terminate();
end;

procedure TMainForm.WMHookNotify( var Message: TMessage );
begin
  if ( not Assigned(FKeypressThread) ) then Exit;

  FKeypressThread.Active := ( Message.wParam = WM_KEYDOWN );
end;

end.