VBA 和 GetRawInputDeviceList

Question

我在 Access 2013 中工作，尝试获取 VBA 的 GetRawInputDeviceList、GetRawInputDeviceInfo、RegisterRawInputDevices 和 GetRawInputData 等价物，但没有成功。我还徒劳地搜索了一个程序、函数或模块来获取连接到计算机的 HID 设备列表以挑选条形码扫描仪。这是第三周的开始，所以我跪下来请求帮助。你们中有没有人愿意分享一个模块，一个指向处理此问题的网站的链接？非常感谢任何帮助。

Answer 1

使用 GetRawInputDeviceList由于 pRawInputDeviceList 参数，来自 VBA 的 API 会非常棘手。除非您愿意克服重重困难来管理您自己的内存并手动处理原始内存中生成的 RAWINPUTDEVICELIST 数组，否则您最好从另一个方向来解决这个问题。

我接触过的大多数条形码扫描器都以键盘的形式出现在 Windows 中。一种可能的解决方案是使用 WMI 查询来枚举附加的 Win32_Keyboard设备:

Private Sub ShowKeyboardInfo()
    Dim WmiServer As Object
    Dim ResultSet As Object
    Dim Keyboard As Object
    Dim Query As String

    Query = "SELECT * From Win32_Keyboard"
    Set WmiServer = GetObject("winmgmts:root/CIMV2")
    Set ResultSet = WmiServer.ExecQuery(Query)

    For Each Keyboard In ResultSet
        Debug.Print Keyboard.Name & vbTab & _
                    Keyboard.Description & vbTab & _
                    Keyboard.DeviceID & vbTab & _
                    Keyboard.Status
    Next Keyboard
End Sub

注意:如果那里没有出现，您可以通过查询 CIM_USBDevice 来枚举所有 USB 设备。 : Query = "SELECT * From Win32_Keyboard"

编辑:根据评论，上述代码不会返回注册接收原始输入事件所需的句柄。不过，这应该可以帮助您入门 - RegisterRawInputDevices 和 GetRawInputData 方面超出了答案的范围。尝试一下，如果您遇到任何问题，请在另一个问题中发布您的代码。

声明:

Private Type RawInputDeviceList
    hDevice As Long
    dwType As Long
End Type

Private Type RidKeyboardInfo
    cbSize As Long
    dwType As Long
    dwKeyboardMode As Long
    dwNumberOfFunctionKeys As Long
    dwNumberOfIndicators As Long
    dwNumberOfKeysTotal As Long
End Type

Private Enum DeviceType
    TypeMouse = 0
    TypeKeyboard = 1
    TypeHID = 2
End Enum

Private Enum DeviceCommand
    DeviceName = &H20000007
    DeviceInfo = &H2000000B
    PreParseData = &H20000005
End Enum

Private Declare Function GetRawInputDeviceList Lib "user32" ( _
    ByVal pRawInputDeviceList As Long, _
    ByRef puiNumDevices As Long, _
    ByVal cbSize As Long) As Long

Private Declare Function GetRawInputDeviceInfo Lib "user32" Alias "GetRawInputDeviceInfoW" ( _
    ByVal hDevice As Long, _
    ByVal uiCommand As Long, _
    ByVal pData As Long, _
    ByRef pcbSize As Long) As Long

Private Declare Function GetLastError Lib "kernel32" () As Long

使用 GetRawInputDeviceInfo 检索设备名称的示例:

Private Sub SampleCode()
    Dim devices() As RawInputDeviceList

    devices = GetRawInputDevices
    Dim i As Long
    For i = 0 To UBound(devices)
        'Inspect the type - only looking for a keyboard.
        If devices(i).dwType = TypeKeyboard Then
            Dim buffer As String
            Dim size As Long
            'First call with a null pointer returns the string length in size.
            If GetRawInputDeviceInfo(devices(i).hDevice, DeviceName, 0&, size) = -1 Then
                Debug.Print "GetRawInputDeviceInfo error " & GetLastError()
            Else
                'Size the string buffer.
                buffer = String(size, Chr$(0))
                'The second call copies the name into the passed buffer.
                If GetRawInputDeviceInfo(devices(i).hDevice, DeviceName, StrPtr(buffer), size) = -1 Then
                    Debug.Print "GetRawInputDeviceInfo error " & GetLastError()
                Else
                    Debug.Print buffer
                End If
            End If
        End If
    Next i

End Sub

Private Function GetRawInputDevices() As RawInputDeviceList()
    Dim devs As Long
    Dim output() As RawInputDeviceList

    'First call with a null pointer returns the number of devices in devs
    If GetRawInputDeviceList(0&, devs, LenB(output(0))) = -1 Then
        Debug.Print "GetRawInputDeviceList error " & GetLastError()
    Else
        'Size the output array.
        ReDim output(devs - 1)
        'Second call actually fills the array.
        If GetRawInputDeviceList(VarPtr(output(0)), devs, LenB(output(0))) = -1 Then
            Debug.Print "GetRawInputDeviceList error " & GetLastError()
        Else
            GetRawInputDevices = output
        End If
    End If
End Function

抱歉横向滚动。