fullerm
fullerm

Reputation: 468

Delphi routine to simulate typing

I'm trying to develop a routine in Delphi XE to output text to the screen to simulate typing text in a game. It's not as simple as concatenating characters to a TMemo for example, as this results in flickering even when using beginupdate/endupdate. I've used the technique here, converted in to Delphi code as best I can and modified it based on comments here but I'm not getting the correct text. I'm getting garbage I guess because the characters are somehow not in the right format. Does anyone see what is wrong here or know a better way to simulate typing?

procedure SendEnter();
var
  KeyInputs: array [0..1] of TInput;
begin
  ZeroMemory(@KeyInputs,sizeof(KeyInputs));
  KeyInputs[0].Itype := INPUT_KEYBOARD;
  KeyInputs[0].ki.wVk := VK_RETURN;
  KeyInputs[0].ki.dwFlags := 0;
  KeyInputs[1].Itype := INPUT_KEYBOARD;
  KeyInputs[1].ki.wVk := VK_RETURN;
  KeyInputs[1].ki.dwFlags := KEYEVENTF_EXTENDEDKEY;
  SendInput(2, KeyInputs[0], SizeOf(TInput));
end;

function TForm2.PrintOutLine(sLine: string): boolean;
var
  i: integer;
  VKRes: SmallInt;
  VK: byte;
  KeyInputsU: array [0..3] of TInput;
  KeyInputsL: array [0..1] of TInput;
  bUppercase: boolean;
begin
  Memo1.SetFocus;
  i:= 1;
  while (i<=Length(sLine)) do begin
    bUppercase:= sLine[i]=UpCase(sLine[i]);
    VKRes:= VkKeyScanEx(sLine[i],GetKeyboardLayout(0));
    VK:= VKRes;
    if (bUppercase) then begin
      ZeroMemory(@KeyInputsU,sizeof(KeyInputsU));
      KeyInputsU[0].Itype := INPUT_KEYBOARD;
      KeyInputsU[0].ki.wVk := VK_LSHIFT;
      //KeyInputsU[0].ki.dwFlags := 0;
      KeyInputsU[1].Itype := INPUT_KEYBOARD;
      KeyInputsU[1].ki.wVk := vk;
      KeyInputsU[1].ki.dwFlags := KEYEVENTF_UNICODE ;
      KeyInputsU[2].Itype := INPUT_KEYBOARD;
      KeyInputsU[2].ki.wVk := vk;
      KeyInputsU[2].ki.dwFlags := KEYEVENTF_UNICODE or KEYEVENTF_KEYUP;
      KeyInputsU[3].Itype := INPUT_KEYBOARD;
      KeyInputsU[3].ki.wVk := VK_LSHIFT;
      KeyInputsU[3].ki.dwFlags := KEYEVENTF_KEYUP;
      SendInput(4, KeyInputsU[0], SizeOf(TInput));
    end
    else begin
      ZeroMemory(@KeyInputsL,sizeof(KeyInputsL));
      KeyInputsL[0].Itype := INPUT_KEYBOARD;
      KeyInputsL[0].ki.wVk := vk;
      KeyInputsL[0].ki.dwFlags := KEYEVENTF_UNICODE;
      KeyInputsL[1].Itype := INPUT_KEYBOARD;
      KeyInputsL[1].ki.wVk := vk;
      KeyInputsL[1].ki.dwFlags := KEYEVENTF_UNICODE or KEYEVENTF_KEYUP;
      SendInput(2, KeyInputsL[0], SizeOf(TInput));
    end;
    Application.ProcessMessages;
    Sleep(80);
    inc(i);
  end;
  SendEnter;
  Form2.SetFocus;
  Result:= True;
end;

Upvotes: 2

Views: 2319

Answers (3)

Alexander Yarovy
Alexander Yarovy

Reputation: 1

procedure TypeKey(Key: Cardinal);
const KEYEVENTF_KEYDOWN = 0;
      KEYEVENTF_UNICODE = 4;
var rec: TInput;
    rLen: Integer;
    shift: Boolean;
begin
  rLen:=SizeOf(TInput);

  shift:=(Key shr 8)=1;

  if shift then begin
    rec.Itype:=INPUT_KEYBOARD;
    rec.ki.wVk:=VK_SHIFT;
    rec.ki.dwFlags:=KEYEVENTF_KEYDOWN; // or KEYEVENTF_UNICODE;
    SendInput(1,rec,rLen);
  end;

  rec.Itype:=INPUT_KEYBOARD;
  rec.ki.wVk:=Key;
  rec.ki.dwFlags:=KEYEVENTF_KEYDOWN; // or KEYEVENTF_UNICODE;
  SendInput(1,rec,rLen);

  rec.Itype:=INPUT_KEYBOARD;
  rec.ki.wVk:=Key;
  rec.ki.dwFlags:=KEYEVENTF_KEYUP; // or KEYEVENTF_UNICODE;
  SendInput(1,rec,rLen);

  if shift then begin
    rec.Itype:=INPUT_KEYBOARD;
    rec.ki.wVk:=VK_SHIFT;
    rec.ki.dwFlags:=KEYEVENTF_KEYUP; // or KEYEVENTF_UNICODE;
    SendInput(1,rec,rLen);
  end;
end;

procedure TypeString(Str: String);
var i, sLen: Integer;
begin
  sLen:=Length(Str);
  if sLen>0 then for i:=1 to sLen do TypeKey(vkKeyScan(Str[i]));
  TypeKey(VK_RETURN);
end;

Upvotes: 0

fullerm
fullerm

Reputation: 468

The solution from Remy Lebeau also works well.

function TForm2.PrintOutLine(sLine: string): boolean;
var
  i: integer;
begin
  i:= 1;
  while (i<=Length(sLine)) do begin
    Memo1.SelStart := Memo1.GetTextLen;
    Memo1.SelText := sLine[i];
    Application.ProcessMessages;
    Sleep(80);
    inc(i);
  end;
  Memo1.SelStart := Memo1.GetTextLen;
  Memo1.SelText := #13#10;
  Result:= True;
end;

Upvotes: 0

Tom Brunberg
Tom Brunberg

Reputation: 21033

To answer your modified question, and your latest comment about non-alpha characters still not working correctly:

Your detection of upper/lower case fails on any character not in a .. z. If you look at the documentation for System.UpCase() it states Character values not in the range a..z are unaffected. Therefore, if you feed it a <, you will get back the same <. Your code will interpret that as an upper case character although it's not.

You have been told in a comment to send the keys (actually characters) with dwFlags KEYEVENTF_UNICODE. You seem to have adopted that only partially and also erroneously.

Note that the MSDN documentation says:

wVk: ...If the dwFlags member specifies KEYEVENTF_UNICODE, wVk must be 0.

wScan: ...If dwFlags specifies KEYEVENTF_UNICODE, wScan specifies a Unicode character

and further, for flag KEYEVENTF_UNICODE:

If specified, the system synthesizes a VK_PACKET keystroke. The wVk parameter must be zero. This flag can only be combined with the KEYEVENTF_KEYUP flag.

Ergo, you do not need to detect and separately deal with upper case and lower case characters. You just set wScan to the ordinal of the UTF-16 character you want to send . Therefore your non-alpha characters also works correctly with following code modified from yours:

function TForm3.PrintOutLine(sLine: string): boolean;
var
  i: integer;
  KeyInputsL: array [0..1] of TInput;
begin
  Memo1.SetFocus;
  i:= 1;
  while (i<=Length(sLine)) do begin
    ZeroMemory(@KeyInputsL,sizeof(KeyInputsL));

    KeyInputsL[0].Itype := INPUT_KEYBOARD;
//    KeyInputsL[0].ki.wVk := vk;            // don't use wVk with KEYEVENTF_UNICODE
    KeyInputsL[0].ki.wScan := ord(sLine[i]); // instead use wScan
    KeyInputsL[0].ki.dwFlags := KEYEVENTF_UNICODE;

    KeyInputsL[1].Itype := INPUT_KEYBOARD;
//    KeyInputsL[1].ki.wVk := vk;
    KeyInputsL[1].ki.wScan := ord(sLine[i]);
    KeyInputsL[1].ki.dwFlags := KEYEVENTF_UNICODE or KEYEVENTF_KEYUP;

    SendInput(2, KeyInputsL[0], SizeOf(TInput));

    Application.ProcessMessages;
    Sleep(80);
    inc(i);
  end;
  SendEnter;
  Form3.SetFocus;
  Result:= True;
end;

The above answers your actual question but does not consider surrogate pairs of UTF-16 codepoints. There's a full code (in C++) for that shown here

Also, not a part of your question, but I can't let it pass without a comment: Application.ProcessMessages and Sleep() is not the correct way of sending one character at a time. Use a timer instead to trigger the sending of each character.

Upvotes: 1

Related Questions