Warm tip: This article is reproduced from serverfault.com, please click

Do you know how to emulate holding down a keystroke for any period of time, then releasing it later?

发布于 2020-11-28 20:18:22

I'm trying to emulate pushing the keyboard V key down while using BASS library to automate Voice Activation push to talk. I've got the BASS library working, just can't get the keyboard to simulate holding down a Key for any length of time!

Edit: I am trying to get another application ('TeamSpeak 3') to recognize my Key Press & hold as a hardware based Key Press & Hold rather than a software based Key Press & Hold. To help simulate a Push to Talk via my application. I will openly have the source code for anyone that wants it, but I will not be publishing my application for any reason. It's for my personal use and It's out of curiosity if it would work? I understand that any kind of abuse of this kind of app I take as my own personal responsibility.

Edit2: I have done extensive research. I figure I'm going to have to either use my old Android handheld or a Raspberry Pi. I have a Raspberry Pi Zero, so I am going to see if I can create it as a hardware keyboard. I'll write a program in Delphi to interface it (I have Delphi 10.4.1 Enterprise and hope it will work with Raspberry Pi's linux version.) I have a vmware Debian and Ubuntu os on my computer that I could pre-compile it with? Anyhow the article is here: https://randomnerdtutorials.com/raspberry-pi-zero-usb-keyboard-hid/

I'm going to go ahead an allow the answer below, because it basically does what my previous request says. To go further than my request requires a lot of work. I'll give an update if I can get it working properly.

(Delphi 10.4.1 / Target Windows 32-bit)

Here's my current source code:

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);
        Halt;
    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);
        Halt;
    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.
Questioner
Greg T
Viewed
0
fpiette 2020-11-29 14:35:03

I designed a simple example where when the user click the mouse on a TButton, it simulate a keystroke every 250mS until the user release the mouse button.

The OnMouseButtonDown starts a 250mS timer, the OnMouseButtonUp stop the timer. The OnTimer send the keyboard event. The timer is also stopped when the mouse leave the form.

The .PAS file:

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.

And the DFM file:

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