【问题标题】:Emulate Keyboard Typing模拟键盘打字
【发布时间】:2012-12-21 10:57:00
【问题描述】:

如何在 TWebBrowser 或 TChromium 中模拟真人的打字。它可以是这两者中的任何一个。

【问题讨论】:

    标签: delphi delphi-xe2 twebbrowser tchromium


    【解决方案1】:

    将需要一些调整,可能有助于进一步发展

    procedure SendKeys(sText: String);
    
    var
     i             : Integer;
     shift         : Boolean;
     vk, scancode   : Word;
     ch            : Char;
     c, s          : Byte;
    const
     vk_keys       : Array[0..9] of Byte=(VK_HOME, VK_END, VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT, VK_PRIOR, VK_NEXT, VK_INSERT, VK_DELETE);
     vk_shft       : Array[0..2] of Byte=(VK_SHIFT, VK_CONTROL, VK_MENU);
     flags         : Array[FALSE..TRUE] of Integer = (KEYEVENTF_KEYUP, 0);
     C_ALTGRS = ['\','@','~','²','³','€','{','}','[',']'];
    
    begin
     shift:=FALSE;
     for i:=1 to Length(sText) do begin
       ch:=sText[i];
         if (ch>=#250) then begin
         s:=Ord(ch)-250;
         shift:=NOT Odd(s);
         c:=vk_shft[s shr 1];
         scancode:=MapVirtualKey(c, 0);
         Keybd_Event(c, scancode, flags[shift], 0);
       end else begin
         vk:=0;
         if (ch>=#240) then
           c:=vk_keys[Ord(ch)-240]
         else if (ch>=#228) then
           c:=Ord(ch)-116
         else if (ch<#32) then
           c:=Ord(ch)
         else begin
           vk:=VkKeyScan(ch);
           c:=LoByte(vk);
         end;
    
         scancode:=MapVirtualKey(c, 0);
    
         if (sText[i] in C_AltGRS) then Keybd_Event(VK_RMENU, MapVirtualKey(VK_RMENU,0), 0, 0)
         else if (NOT shift AND (Hi(vk)>0)) then Keybd_Event(VK_SHIFT, $2A, 0, 0 );
         Keybd_Event( c, scancode, 0, 0 );
         Keybd_Event( c, scancode, KEYEVENTF_KEYUP, 0 );
         if (sText[i] in C_AltGRS) then Keybd_Event(VK_RMENU,MapVirtualKey(VK_RMENU,0), KEYEVENTF_KEYUP, 0)
         else if (NOT shift AND (Hi(vk)>0)) then Keybd_Event(VK_SHIFT, $2A, KEYEVENTF_KEYUP, 0);
    
       end;
       Application.ProcessMessages;
     end;
    end;
    
    
    
    procedure TForm4.FormCreate(Sender: TObject);
    begin
       WebBrowser1.Navigate('http://www.google.de');
    
    end;
    
    procedure TForm4.SpeedButton1Click(Sender: TObject);
    begin
       SendKeys('test');
       SendKeys(#13);
    end;
    

    【讨论】:

    • @Santos,我不会称之为最好的; SendInput 函数是首选方式。
    • 它适用于大写字母 0123456789`!"£$%^&*()_+=-*/?|\,但在使用 ąčęėįšųūž 时会出现范围检查错误。
    【解决方案2】:

    这应该足以让你开始。

    procedure EmulateKeyPress();
    var
      _Input: TInput;
    begin
      _Input.Itype := INPUT_KEYBOARD;
      _Input.ki.wVk := VK_SHIFT; // $31 is the VK_1
      _Input.ki.wScan := 0;
      _Input.ki.dwFlags := 0;
      _Input.ki.time := 0;
      _Input.ki.dwExtraInfo := 0;
      if SendInput(1, _Input, SizeOf(_Input)) = 0 then
      begin
        ShowMessage('Input event was Blocked');
        Exit
      end;
      _Input.ki.dwFlags := KEYEVENTF_KEYUP;
      SendInput(1, _Input, SizeOf(_Input));
    end;
    

    【讨论】:

    • 如何确保将这些事件发送到正确的控件?
    • 此代码应该将输入发送到当前活动的控件,您可以使用其他代码将您的控件设置为活动的,afaik,没有办法将 KeyPress 事件模拟为非活动控件。在激活控件之前,不要忘记检查您的控件是否可见并已启用。
    猜你喜欢
    • 2011-09-17
    • 2011-04-26
    • 2016-03-19
    • 1970-01-01
    • 1970-01-01
    • 2011-05-19
    • 2012-03-13
    • 2020-12-01
    • 2016-06-27
    相关资源
    最近更新 更多