你知道如何模拟在任何一段时间内按住按键,然后再释放它吗



我正在尝试模拟按下键盘V键,同时使用BASS库自动执行语音激活按键通话。我已经让BASS库工作了,只是无法让键盘模拟长时间按住键!

编辑:我正在尝试获得另一个应用程序("TeamSpeak 3"(来识别我的按键&保持为基于硬件的按键&按住而不是基于软件的按键&持有通过我的应用程序帮助模拟一键通。我会公开为任何想要它的人提供源代码,但我不会出于任何原因发布我的应用程序。这是我个人用的,只是出于好奇,它是否有效?我明白,任何滥用这种应用程序的行为都是我个人的责任

第二版:我做了大量的研究。我想我要么用我的旧安卓掌上电脑,要么用树莓派。我有一个复盆子Pi Zero,所以我要看看我是否可以把它作为一个硬件键盘。我会用Delphi编写一个程序来连接它(我有Delphi 10.4.1 Enterprise,希望它能与Raspberry Pi的linux版本配合使用。(我的电脑上有一个vmware Debian和Ubuntu操作系统,我可以用它预编译它吗?无论如何,文章在这里:https://randomnerdtutorials.com/raspberry-pi-zero-usb-keyboard-hid/

我将在下面给出一个允许的答案,因为它基本上符合我之前的请求。要比我的要求走得更远,需要做很多工作。如果我能让它正常工作,我会更新的。

(Delphi 10.4.1/Target Windows 32位(

这是我当前的源代码:

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.

我设计了一个简单的例子,当用户在TButton上单击鼠标时,它模拟每250mS一次按键,直到用户释放鼠标按钮。

OnMouseButtonDown启动250mS计时器,OnMouseButton Up停止计时器。OnTimer发送键盘事件。当鼠标离开窗体时,计时器也会停止。

.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

SendKeys.Send怎么样?

假设目标应用程序没有类似于SendKeys的DCOM。Send以活动应用程序为目标,因此如果焦点被另一个应用程序更改,则无法获得所需的结果。

最新更新