VBA 和 GetRawInputDeviceList
VBA and GetRawInputDeviceList
我在 Access 2013 中工作,并尝试获取 VBA 的 GetRawInputDeviceList、GetRawInputDeviceInfo、RegisterRawInputDevices 和 GetRawInputData 等效项,但没有成功。我还徒劳地搜索了一个程序、函数或模块来获取连接到计算机的 HID 设备列表以挑选条形码扫描仪。这是第三周的开始,所以我跪下来请求帮助。你们有没有愿意分享的模块,一个 link 到处理这个问题的网站?非常感谢任何帮助。
使用 VBA 中的 GetRawInputDeviceList API 会非常棘手,因为有 pRawInputDeviceList 参数。除非您愿意克服重重困难来管理您自己的内存并手动处理原始内存中生成的 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"
编辑: 根据评论,上面的代码不会 return 注册接收原始输入事件所需的句柄。不过,这应该可以帮助您入门 - RegisterRawInputDevices 和 GetRawInputData 方面超出了答案的范围。尝试一下,如果你 运行 遇到任何问题 post 你的代码在另一个问题中。
声明:
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
抱歉横向滚动。
我在 Access 2013 中工作,并尝试获取 VBA 的 GetRawInputDeviceList、GetRawInputDeviceInfo、RegisterRawInputDevices 和 GetRawInputData 等效项,但没有成功。我还徒劳地搜索了一个程序、函数或模块来获取连接到计算机的 HID 设备列表以挑选条形码扫描仪。这是第三周的开始,所以我跪下来请求帮助。你们有没有愿意分享的模块,一个 link 到处理这个问题的网站?非常感谢任何帮助。
使用 VBA 中的 GetRawInputDeviceList API 会非常棘手,因为有 pRawInputDeviceList 参数。除非您愿意克服重重困难来管理您自己的内存并手动处理原始内存中生成的 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"
编辑: 根据评论,上面的代码不会 return 注册接收原始输入事件所需的句柄。不过,这应该可以帮助您入门 - RegisterRawInputDevices 和 GetRawInputData 方面超出了答案的范围。尝试一下,如果你 运行 遇到任何问题 post 你的代码在另一个问题中。
声明:
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
抱歉横向滚动。