VB.NET 如何从外部应用程序触发 keydown 和 keyup 事件?避免 sendkeys 方法

How to trigger keydown and keyup events from external applications in VB.NET? avoid sendkeys method

我正在尝试使用 vb.net 开发一个 击键宏程序,它将记录击键,例如 keydownkeyup events 然后在主程序在后台 运行 的任何地方播放它。到目前为止,我已经成功地捕获了击键并存储了这些击键。但是我面临的问题是在播放那些存储的击键时。我无法触发 KeyDown 和 KeyUp 事件 来自 任何外部程序。我也尝试过 SendKeys 方法,但它无法分别区分 KeyDown 和 KeyUp。在这种情况下提供帮助将不胜感激。

仅在父程序中可访问的 KeyDown 事件

Private Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
        'MessageBox.Show(e.KeyCode)
        'bla bla bla
End Sub

'使用SendKeys但无法区分KeyDown和KeyUp

Private Function AutoSendKey(ByVal keystroke As String, ByVal delay As Integer)     
        System.Threading.Thread.Sleep(delay)
        My.Computer.Keyboard.SendKeys(keystroke, True)
    End Function

我需要一种方法来从外部应用程序触发 KeyDown 和 KeyUp 事件。提前致谢

我只是在寻找同样的东西,但发现的资源很少,然后设法将其整合到一个应用程序中:

基本上这将起作用,除非您在驱动程序级别使用某种拦截,在这种情况下,被拦截应用程序拦截的键盘将对 windows 不可见,因此此脚本无用。

除此之外,这是我的代码。 此代码针对 .NET 5.0 进行了优化

首先创建KeyboardHook.vbclass:

Imports System.Runtime.InteropServices

Public Class KeyboardHook

    <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)>
    Private Overloads Shared Function SetWindowsHookEx(ByVal idHook As Integer, ByVal HookProc As KBDLLHookProc, ByVal hInstance As IntPtr, ByVal wParam As Integer) As Integer
    End Function
    <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)>
    Private Overloads Shared Function CallNextHookEx(ByVal idHook As Integer, ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
    End Function
    <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)>
    Private Overloads Shared Function UnhookWindowsHookEx(ByVal idHook As Integer) As Boolean
    End Function

    <StructLayout(LayoutKind.Sequential)>
    Private Structure KBDLLHOOKSTRUCT
        Public vkCode As UInt32
        Public scanCode As UInt32
        Public flags As KBDLLHOOKSTRUCTFlags
        Public time As UInt32
        Public dwExtraInfo As UIntPtr
    End Structure

    <Flags()>
    Private Enum KBDLLHOOKSTRUCTFlags As UInt32
        LLKHF_EXTENDED = &H1
        LLKHF_INJECTED = &H10
        LLKHF_ALTDOWN = &H20
        LLKHF_UP = &H80
    End Enum

    Public Shared Event KeyDown(ByVal Key As Key)
    Public Shared Event KeyUp(ByVal Key As Key)

    Private Const WH_KEYBOARD_LL As Integer = 13
    Private Const HC_ACTION As Integer = 0
    Private Const WM_KEYDOWN = &H100
    Private Const WM_KEYUP = &H101
    Private Const WM_SYSKEYDOWN = &H104
    Private Const WM_SYSKEYUP = &H105

    Private Delegate Function KBDLLHookProc(ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer

    Private KBDLLHookProcDelegate As KBDLLHookProc = New KBDLLHookProc(AddressOf KeyboardProc)
    Private HHookID As IntPtr = IntPtr.Zero

    Private Function KeyboardProc(ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
        If (nCode = HC_ACTION) Then
            Dim struct As KBDLLHOOKSTRUCT
            Select Case wParam
                Case WM_KEYDOWN, WM_SYSKEYDOWN
                    Dim aKey = KeyInterop.KeyFromVirtualKey(CType(Marshal.PtrToStructure(lParam, struct.GetType()), KBDLLHOOKSTRUCT).vkCode)
                    RaiseEvent KeyDown(aKey)
                Case WM_KEYUP, WM_SYSKEYUP
                    Dim aKey = KeyInterop.KeyFromVirtualKey(CType(Marshal.PtrToStructure(lParam, struct.GetType()), KBDLLHOOKSTRUCT).vkCode)
                    RaiseEvent KeyUp(aKey)
            End Select
        End If
        Return CallNextHookEx(IntPtr.Zero, nCode, wParam, lParam)
    End Function

    Public Sub New()
        HHookID = SetWindowsHookEx(WH_KEYBOARD_LL, KBDLLHookProcDelegate, System.Diagnostics.Process.GetCurrentProcess().MainModule.BaseAddress, 0)
        If HHookID = IntPtr.Zero Then
            Throw New Exception("Could not set keyboard hook")
        End If
    End Sub

    Protected Overrides Sub Finalize()
        If Not HHookID = IntPtr.Zero Then
            UnhookWindowsHookEx(HHookID)
        End If
        MyBase.Finalize()
    End Sub

End Class

现在使用 KeyboardHook 事件处理程序创建您自己的 class/usercontrol。

对我来说这很简单 OnScreenKBView.xaml 文本块的文本 属性 绑定到视图模型 class 属性,它显示按下和释放的键以及有多少键同时按下:

 <Grid>
        <Border Background="Red" >
            <StackPanel Orientation="Vertical">
                <TextBlock Text="KeyDown:"/>
                <TextBlock Text="{Binding keyDown, Converter={StaticResource KeyToStringVC}}"/>
                <TextBlock Text="KeyUp:"/>
                <TextBlock Text="{Binding keyUp, Converter={StaticResource KeyToStringVC}}"/>
                <TextBlock Text="TotalKeysPressed at the same time:"/>
                <TextBlock Text="{Binding keysPressed, Converter={StaticResource ListToCountVC}}"/>
                <TextBlock Text="KeysPressed:"/>
                <TextBlock Text="{Binding keysPressed, Converter={StaticResource ListToStringVC}}" TextWrapping="Wrap"/>
            </StackPanel>
           
        </Border> 
    </Grid>

注意我有几个值转换器 KeyToStringVCListToStringVCListToCountVC

KeyToStringVC:

 Return value.ToString

ListToCountVC:

        If Not value Is Nothing Then
            Return value.count
        Else
            Return Nothing
        End If

ListToStringVC :

        Dim kl As ObservableCollection(Of Key) = value
        Dim str As String = Nothing
        If Not kl Is Nothing Then
            For Each item In kl
                str += item.ToString & "; "
            Next
        End If
        Return str

如果您不知道如何 use/create 值转换器,则必须查找如何。

VB OnScreenKBView.xaml 后面的代码:

Imports System.Collections.ObjectModel

Public Class OnScreenKBView


    Private WithEvents kbHook As New KeyboardHook

    Private viewModel As OnScreenKBViewModel



    Private Sub kbHook_KeyDown(ByVal Key As Key) Handles kbHook.KeyDown
        viewModel.keyDown = Key


        'check if list already has the key in it

        Dim hasKey As Boolean = False

        If Me.viewModel.keysPressed.Contains(Key) Then
            hasKey = True
        End If
        If Not hasKey Then
            Me.viewModel.keysPressed.Add(Key)

            Dim localCol = Me.viewModel.keysPressed
            Dim newCol = New ObservableCollection(Of Key)(From i In localCol Select i)
            Me.viewModel.keysPressed = newCol
        End If

    End Sub
    Private Sub kbHook_KeyUp(ByVal Key As Key) Handles kbHook.KeyUp
        viewModel.keyUp = Key
        Me.viewModel.keysPressed.Remove(Key)

        Dim localCol = Me.viewModel.keysPressed
        Dim newCol = New ObservableCollection(Of Key)(From i In localCol Select i)
        Me.viewModel.keysPressed = newCol

    End Sub

    Sub New()

        ' This call is required by the designer.
        InitializeComponent()

        ' Add any initialization after the InitializeComponent() call.
        Me.viewModel = Application.Current.MainWindow.DataContext
    End Sub
End Class

我希望这会给你一些想法。如果你需要整个项目,我在 github 上有它,但它是私有的,我可以为你压缩它。

小演示: GIF here

Imports System.Runtime.InteropServices
Imports System.Windows.Forms 'for the keys. enumeration

Public Module SendWinKey
    Const KEYEVENTF_KEYDOWN As Integer = &H0
    Const KEYEVENTF_KEYUP As Integer = &H2

    
       Declare Sub keybd_event Lib "User32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As UInteger, ByVal dwExtraInfo As UInteger)

Public Sub Main()    
        keybd_event(CByte(Keys.LWin), 0, KEYEVENTF_KEYDOWN, 0) 'press the left Win key down
        keybd_event(CByte(Keys.R), 0, KEYEVENTF_KEYDOWN, 0) 'press the R key down
        keybd_event(CByte(Keys.R), 0, KEYEVENTF_KEYUP, 0) 'release the R key
        keybd_event(CByte(Keys.LWin), 0, KEYEVENTF_KEYUP, 0) 'release the left Win key
    End Sub
End Module

如你所见,其实很简单。