Блог

Главная - Вопросы по программированию - Знаете ли вы, как эмулировать удерживание нажатия клавиши в течение любого периода времени, а затем отпускание ее позже?

Знаете ли вы, как эмулировать удерживание нажатия клавиши в течение любого периода времени, а затем отпускание ее позже?

#windows #delphi #key #sendinput

#Windows #delphi #Клавиша #отправка ввода

Вопрос:

Я пытаюсь эмулировать нажатие клавиши V на клавиатуре при использовании библиотеки BASS для автоматизации голосовой активации push to talk. У меня работает библиотека BASS, просто не могу заставить клавиатуру имитировать удержание клавиши нажатой в течение любого периода времени!

Редактировать: Я пытаюсь заставить другое приложение (‘TeamSpeak 3’) распознавать мое нажатие и удержание клавиши как аппаратное нажатие и удержание клавиши, а не программное нажатие и удержание клавиши. Чтобы помочь имитировать нажатие для разговора через мое приложение. У меня будет открытый исходный код для всех, кто этого захочет, но я не буду публиковать свое приложение по какой-либо причине. Это для моего личного использования, и мне любопытно, сработает ли это? Я понимаю, что любое злоупотребление такого рода приложениями я беру на себя личную ответственность.

Правка2: Я провел обширное исследование. Я полагаю, мне придется использовать либо мой старый Android-наладонник, либо Raspberry Pi. У меня есть Raspberry Pi Zero, поэтому я собираюсь посмотреть, смогу ли я создать его как аппаратную клавиатуру. Я напишу программу на Delphi для ее интерфейса (у меня Delphi 10.4.1 Enterprise, и я надеюсь, что она будет работать с Linux-версией Raspberry Pi.) На моем компьютере установлены ОС vmware Debian и Ubuntu, с помощью которых я мог бы предварительно скомпилировать ее? В любом случае статья здесь: https://randomnerdtutorials.com/raspberry-pi-zero-usb-keyboard-hid /

Я собираюсь продолжить и разрешить ответ ниже, потому что он в основном выполняет то, что указано в моем предыдущем запросе. Чтобы пойти дальше, чем мой запрос, требуется много работы. Я дам обновление, если смогу заставить его работать должным образом.

(Delphi 10.4.1 / Целевая 32-разрядная версия Windows)

Вот мой текущий исходный код:

 unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.MPlayer, System.UITypes, BASS,
  Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    Timer1: TTimer;
    ComboBox1: TComboBox;
    Timer2: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer2Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function RecordingCallback(h:HRECORD; b:Pointer; l,u: DWord): boolean; stdcall;
  end;

var
  Form1: TForm1;
  rchan:   HRECORD; // recording channel
  level2: dword;
  LoudEnough: boolean = FALSE;
  threshold: DWORD = 500; // trigger level
  MicON_Timer, Counter1: Cardinal;
  MicON_Bool : Boolean;

implementation

{$R *.dfm}

(* This function called while recording audio *)
function TForm1.RecordingCallback(h:HRECORD; b:Pointer; l,u: DWord): boolean; stdcall;
 //var level:dword;
 begin
  level2:=BASS_ChannelGetLevel(h);
  LoudEnough := (LoWord(level2) >= threshold) or (HiWord(level2) >= threshold);
  //Memo1.Lines.add('Loword '   IntToStr(LoWord(level)) ' - HiWord ' IntToStr(HiWord(level)));
  Result := True;
 end;

// START BUTTON
procedure TForm1.Button1Click(Sender: TObject);
begin
  {
  if BASS_RecordSetDevice(0) = false then
  begin
    memo1.Lines.Add('BASS_RecordSetDevice ERROR = '  BASS_ErrorGetCode().ToString);
  end;}

  Counter1 := 0;
  MicON_Timer := 0;

  Timer1.Enabled := true;
  ComboBox1Change(Self);
  rchan := BASS_RecordStart(44100, 1, 0, @TForm1.RecordingCallback, nil);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Timer1.Enabled := false;
  rchan := BASS_RecordStart(44100, 1, BASS_RECORD_PAUSE, @TForm1.RecordingCallback, nil);
    //BASS_Free();
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
var
    i: Integer;
  r: Boolean;
begin
    // enable the selected input
    r := True;
    i := 0;
    // first disable all inputs, then...
    while r do
    begin
        r := BASS_RecordSetInput(i, BASS_INPUT_OFF, -1);
        Inc(i);
    end;
    // ...enable the selected.
    BASS_RecordSetInput(ComboBox1.ItemIndex, BASS_INPUT_ON, -1);
    //UpdateInputInfo;  // update info
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  BASS_RecordFree;
  BASS_Free();
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
  dName: PAnsiChar;
  level: Single;
  flags: dWord;
  deviceInfo: BASS_DEVICEINFO;
  info: BASS_INFO;
begin
    // check the correct BASS was loaded
    if (HIWORD(BASS_GetVersion) <> BASSVERSION) then
    begin
        MessageBox(0,'An incorrect version of BASS.DLL was loaded', nil,MB_ICONERROR);
        Ha<
    end;
    if (not BASS_RecordInit(-1)) or (not BASS_Init(-1, 44100, 0, Handle, nil)) then
    begin
        BASS_RecordFree;
        BASS_Free();
        MessageDlg('Cannot start default recording device!', mtError, [mbOk], 0);
        Ha<
    end;
    i := 0;
//  dName := BASS_RecordGetInputName(i);
  //dName := (BASS_RecordGetDeviceInfo(i,deviceInfo));
    while (BASS_RecordGetDeviceInfo(i,deviceInfo)) do
    begin
    //BASS_GetInfo(info);
        ComboBox1.Items.Add(String(deviceInfo.name));
        // is this one currently "on"?
    //flags := BASS_RecordGetInput(i, level);
    //if (flags and BASS_INPUT_TYPE_MASK) = BASS_INPUT_TYPE_MIC then
        if (BASS_RecordGetInput(i, level) and BASS_INPUT_OFF) = 0 then
            ComboBox1.ItemIndex := i;
        Inc(i);
        //dName := BASS_RecordGetInputName(i);
    end;
    ComboBox1Change(Self);  // display info
end;


procedure TForm1.Timer1Timer(Sender: TObject);
var
  eu: array [0..1] of TInput;
  //S: String;
begin
  //S:='v';
  level2:=BASS_ChannelGetLevel(rchan);
  inc(Counter1);
  LoudEnough := (LoWord(level2) >= threshold) or (HiWord(level2) >= threshold);

  if (LoudEnough = true) then
  begin
    inc(MicON_Timer);

    if (MicON_Bool = false) then
    begin
      MicON_Bool := true;

      //keybd_event(ord('v'), MapVirtualKey(ord('v'), 0), KEYEVENTF_KEYUP, 0);
      //keybd_event(ord('v'), MapVirtualKey(ord('v'), 0), 0, 0);

      ZeroMemory(@eu,sizeof(eu));
      eu[0].Itype := INPUT_KEYBOARD;
      eu[0].ki.dwFlags := KEYEVENTF_UNICODE;
      eu[0].ki.wVk := 0;
      eu[0].ki.wScan   := ord('v');
      eu[0].ki.Time := 0;
      SendInput(1,eu[0],sizeof(TInput));

      Memo1.Lines.add('Push to Talk ON');

      Timer2.Enabled := true;
    end;
  end;

  //if LoudEnough then Memo1.Lines.add('Push to Talk ON')
    //else Memo1.Lines.add('Push to Talk OFF');
  //Memo1.Lines.add('Loword '   LoWord(level2).ToString  ' - HiWord '  HiWord(level2).ToString   ' - AVG: '   MicON_Timer.ToString);
end;

procedure TForm1.Timer2Timer(Sender: TObject);
var
  eu: array [0..1] of TInput;
begin
  dec(MicON_Timer);
  if MicON_Timer <= 0 then
  begin
    Memo1.Lines.add('Push to Talk OFF');

    //keybd_event(ord('v'), MapVirtualKey(ord('v'), 0), KEYEVENTF_KEYUP, 0);
    ZeroMemory(@eu,sizeof(eu));
    eu[0].Itype := INPUT_KEYBOARD;
    eu[0].ki.dwFlags := KEYEVENTF_UNICODE or KEYEVENTF_KEYUP;
    eu[0].ki.wVk := 0;
    eu[0].ki.wScan   := ord('v');
    eu[0].ki.Time := 0;
    SendInput(1,eu[0],sizeof(TInput));

    MicON_Bool := false;
    Counter1 := 0;
    MicON_Timer := 0;

    Timer2.Enabled := false;
  end;
end;

end.

Комментарии:

1. Если я понимаю, что вы пытаетесь сделать, не должен ли timer1 быть отключен в какой-то момент?

2. Надеюсь, мне не придется заходить так далеко, как создание виртуального последовательного порта, а затем имитация информации с клавиатуры через этот виртуальный последовательный порт?

Ответ №1:

Я разработал простой пример, в котором, когда пользователь нажимает мышью на TButton, он имитирует нажатие клавиши каждые 250 мс, пока пользователь не отпустит кнопку мыши.

OnMouseButtonDown запускает таймер на 250 мс, OnMouseButtonUp останавливает таймер. OnTimer отправляет событие клавиатуры. Таймер также останавливается, когда мышь покидает форму.

The .PAS-файл:

 unit KbdEmulDemoMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Timer1: TTimer;
    Memo1: TMemo;
    procedure Button1MouseDown(Sender: TObject; Button: TMouseButton; Shift:
        TShiftState; X, Y: Integer);
    procedure Button1MouseLeave(Sender: TObject);
    procedure Button1MouseUp(Sender: TObject; Button: TMouseButton; Shift:
        TShiftState; X, Y: Integer);
    procedure Timer1Timer(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure TForm1.Button1MouseDown(
    Sender : TObject;
    Button : TMouseButton;
    Shift  : TShiftState;
    X, Y   : Integer);
begin
    // Set focus on Memo1 so that it will receive keyboard input
    Memo1.SetFocus;
    // Start the timer sending keyboard event
    Timer1.Interval := 250;
    Timer1.Enabled  := TRUE;
    // Call OnTimer immediately to key first key event right now
    Timer1.OnTimer(nil);
end;

procedure TForm1.Button1MouseUp(
    Sender : TObject;
    Button : TMouseButton;
    Shift  : TShiftState;
    X, Y   : Integer);
begin
    // Stop timer, this will stop key event
    Timer1.Enabled := FALSE;
end;

procedure TForm1.Button1MouseLeave(Sender: TObject);
begin
    // Stop timer, this will stop key event
    Timer1.Enabled := FALSE;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
    Eu: array [0..1] of TInput;
begin
    ZeroMemory(@Eu, SizeOf(Eu));
    Eu[0].Itype      := INPUT_KEYBOARD;
    Eu[0].ki.dwFlags := KEYEVENTF_UNICODE;
    Eu[0].ki.wVk     := 0;
    Eu[0].ki.wScan   := Ord('v');
    Eu[0].ki.Time    := 0;
    SendInput(1, Eu[0], Sizeof(TInput));
end;

end.

И файл DFM:

 object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 299
  ClientWidth = 635
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 24
    Top = 28
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnMouseDown = Button1MouseDown
    OnMouseLeave = Button1MouseLeave
    OnMouseUp = Button1MouseUp
  end
  object Memo1: TMemo
    Left = 20
    Top = 76
    Width = 605
    Height = 213
    Lines.Strings = (
      'Memo1')
    TabOrder = 1
  end
  object Timer1: TTimer
    OnTimer = Timer1Timer
    Left = 168
    Top = 24
  end
end

Комментарии:

1. Будет ли это работать, если целевое приложение использует GetAsyncKeyState?

2. Это работает в Блокноте, но не хочет работать с приложением, которое «нацелено на реальное оборудование»? Я не уверен, как использовать GetAsyncKeyState? Я посмотрю это и посмотрю, смогу ли я найти примеры. В Stack Overflow нет никакой информации о Delphi SetAsyncKeyState, на которую, я полагаю, я едва смотрел некоторое время назад. Честно говоря, я пытаюсь настроить приложение TeamSpeak 3, которое может заставить игроков использовать Push для разговора, и я хочу использовать обнаружение голосовой активности… для чего я смог сделать это с помощью BASS, но нажатие на talk намекает мне через мое приложение нажатием кнопки!

3. Вам лучше объяснить, что вы собираетесь делать. Возможно, «удерживание нажатия клавиши» — это не то, что вам действительно нужно. Я понял, что у вас есть приложение «TeamSpeak 3», которое вы хотите обмануть, заставив другое приложение нажимать на клавиатуру вместо того, чтобы физическое лицо фактически нажимало и удерживало клавишу. Пожалуйста, ОТРЕДАКТИРУЙТЕ СВОЙ ВОПРОС, чтобы поместить всю информацию туда, а не в комментарии.

4. Я отредактировал вопрос, выбрал ответ, который подходит для моего вопроса, потому что он подходит для моего вопроса, если используется в блокноте. Я решил, что мне придется использовать мой Delphi 10.4.1 Enterprise для написания программы Linux для Raspberry Pi и надеюсь, что это сработает. Я буду использовать свой Raspberry Pi Zero в качестве аппаратной клавиатуры, и это должно решить проблему, с которой я столкнулся. Я знаю, что Delphi 10.4.1 Enterprise в настоящее время не одобрен для Raspberry Pi, поэтому я сначала скомпилирую его на Ubuntu и перенесу? Или я могу отправить запрос в Embarcadero, чтобы, возможно, добавить поддержку Raspberry Pi.

5. О Delphi для RPi: quality.embarcadero.com/browse/RSP-13370

Ответ №2:

Как насчет SendKeys.Отправить?

Предположим, что целевое приложение не имеет эквивалента DCOM, такого как SendKeys.Отправка нацелена на активное приложение, поэтому, если фокус будет изменен другим приложением, вы не получите желаемых результатов.

Метки: , ,