Hook the keyboard

Posted in Manipulators

This example shows, how the string (Edit1.Text) is broken into symbols. And two messages WM_KEYDOWN and WM_KEYUP are created for each symbol. These messages are brought in the list of the messages. After that, you should create a hook, which processes the messages of this types.

...
type
  TMessageList = class(TList);

var
  Form1: TForm1;
  MessageList: TMessageList = nil;
  MessageBuffer: TEventMsg;
  HookHandle: hHook = 0;
  MessageCount: Word = 0;
  Go: Boolean = False;

implementation

{$R *.DFM}

procedure Stop;
begin
  if Go then UnHookWindowsHookEx(HookHandle);
  MessageList.Free;
  Go:=False;
end;

function FBack(Code: Integer; wParam, lParam: LongInt): LongInt; stdcall;
begin
  case Code of
    HC_SKIP:
    begin
      Inc(MessageCount);
      if MessageCount>=MessageList.Count then Stop
      else MessageBuffer:=TEventMsg(MessageList.Items[MessageCount]^);
      Result:=0;
    end;
    HC_GETNEXT:
    begin
      PEventMsg(lParam)^:=MessageBuffer;
      Result:=0;
    end
    else
      Result:=CallNextHookEx(HookHandle, Code, wParam, lParam);
  end;
end;

procedure SetHook;
begin
  MessageBuffer:=TEventMsg(MessageList.Items[0]^);
  MessageCount:=0;
  HookHandle:=SetWindowsHookEx(WH_JOURNALPLAYBACK, FBack, hInstance, 0);
  Go:=True;
end;

procedure MakeMessage(Key: byte; Mes: Cardinal);
var
  MyEvent: PEventMsg;
begin
  New(MyEvent);
  with MyEvent^ do
  begin
    message:=Mes;
    ParamL:=Key;
    ParamH:=MapVirtualKey(Key, 0);
    Time:=GetTickCount;
    hWnd:=Form1.Handle;
  end;
  MessageList.Add(MyEvent);
end;

procedure Imitation(KeyCode: Word);
begin
  MakeMessage(Lo(KeyCode), WM_KEYDOWN);
  MakeMessage(Lo(KeyCode), WM_KEYUP);
end;

procedure SetMessages(S: string);
var
  i: Integer;
  KeyCode: Word;
begin
  i:=1;
  repeat
    KeyCode:=vkKeyScan(S[i]);
    Imitation(KeyCode);  // simulate key presses
    Inc(i);
  until i>Length(S);
end;

function SendStr(S: string): Integer;
begin
  try
    MessageList:=TMessageList.Create;
    SetMessages(S);  // set messages
    SetHook;         // set hook
  except
  end;
  Result:=0;  
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit2.SetFocus;
  SendStr(Edit1.Text);
end;