Delphi 模拟打字的例程

Question

我正在尝试在 Delphi XE 中开发一个例程以将文本输出到屏幕以模拟在游戏中键入文本。它不像将字符连接到 TMemo 那样简单，因为即使使用 beginupdate/endupdate 也会导致闪烁。我使用了 here 技术，尽我所能将其转换为 Delphi 代码，并根据此处的评论对其进行了修改，但我没有得到正确的文本。我猜我得到了垃圾，因为字符的格式不正确。有没有人看到这里有什么问题或知道更好的模拟打字的方法？

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;

Answer 1

回答您修改后的问题，以及您关于非字母字符的最新评论仍然无法正常工作：

您对 upper/lower 大小写的检测在任何不在 a .. z 中的字符上都失败了。如果您查看 System.UpCase() 的文档，它指出 不在 a..z 范围内的字符值不受影响。 因此，如果您给它输入 <，你会得到相同的 <。您的代码会将其解释为大写字符，尽管它不是。

有人在评论中告知您发送带有 dwFlags KEYEVENTF_UNICODE 的密钥（实际上是字符）。您似乎只部分地采用了这一点，而且还错误地采用了这一点。

请注意 MSDN documentation 表示：

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

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

此外，对于标志 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.

因此，您不需要检测和分别处理大写和小写字符。您只需将 wScan 设置为您要发送的 UTF-16 字符的序号。因此，您的非字母字符也可以正确使用从您的修改而来的以下代码：

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;

以上内容回答了您的实际问题，但未考虑 UTF-16 代码点的代理对。

有一个完整的代码（在 C++ 中）

此外，这不是你问题的一部分，但我不能不加评论就让它过去：Application.ProcessMessages 和 Sleep() 不是一次发送一个字符的正确方法。使用计时器来触发每个字符的发送。

Answer 2

Remy Lebeau 的解决方案也很有效。

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;

Answer 3

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;

Delphi 模拟打字的例程

Delphi routine to simulate typing

delphi

sendinput