内容发布更新时间 : 2024/12/23 2:16:56星期一 下面是文章的全部内容请认真阅读。
第8章 USB接口HID设备 221
Dim LastDevice As Boolean
Dim MyDeviceDetected As Boolean
Dim MyDeviceInfoData As SP_DEVINFO_DATA
Dim MyDeviceInterfaceDetailData As SP_DEVICE_INTERFACE_DETAIL_DATA Dim MyDeviceInterfaceData As SP_DEVICE_INTERFACE_DATA Dim Needed As Long
Dim OutputReportData(7) As Byte Dim PreparsedData As Long Dim Result As Long Dim Timeout As Boolean
Dim MyVendorID As Long 'VID、PID Dim MyProductID As Long
'************************************************************************************** '查找全部的HID设备，直到找到VID、PID符合的一个HID '如果找到，MyDeviceDetected为True
'**************************************************************************************
Function FindTheHid() As Boolean
Dim Count As Integer Dim GUIDString As String Dim HidGuid As GUID Dim MemberIndex As Long
LastDevice = False
MyDeviceDetected = False
'调用 HidD_GetHidGuid 函数获得GUID
Result = HidD_GetHidGuid(HidGuid)
Call DisplayResultOfAPICall(\
GUIDString = Hex$(HidGuid.Data1) & \
For Count = 0 To 7
If HidGuid.Data4(Count) >= &H10 Then
GUIDString = GUIDString & Hex$(HidGuid.Data4(Count)) & \ Else
GUIDString = GUIDString & \ End If Next Count
lstResults.AddItem \ GUID for system HIDs: \lstResults.AddItem \ \
'调用 SetupDiGetClassDevs 函数获得指向HID信息集的指针
DeviceInfoSet = SetupDiGetClassDevs(HidGuid, vbNullString, 0, (DIGCF_PRESENT Or DIGCF_DEVICEINTERFACE))
Call DisplayResultOfAPICall(\DataString = GetDataString(DeviceInfoSet, 32)
lstResults.AddItem \ DeviceInfoSet:\
'下面循环，从MemberIndex=0开始，查找指定HID MemberIndex = 0
222 计算机高级接口实践 Do
'调用 SetupDiEnumDeviceInterfaces 函数获得 SP_DEVICE_INTERFACE_DATA 结构指针
MyDeviceInterfaceData.cbSize = LenB(MyDeviceInterfaceData)
Result = SetupDiEnumDeviceInterfaces(DeviceInfoSet, 0, HidGuid, MemberIndex, MyDeviceInterfaceData)
Call DisplayResultOfAPICall(\ If Result = 0 Then LastDevice = True
'如果调用成功 If Result <> 0 Then
'显示获得的信息
lstResults.AddItem \ DeviceInfoSet for device #\ lstResults.AddItem \ cbSize = \ lstResults.AddItem \ InterfaceClassGuid.Data1 _ = \ lstResults.AddItem \ InterfaceClassGuid.Data2 _ = \ lstResults.AddItem \ InterfaceClassGuid.Data3 _ = \ lstResults.AddItem \ Flags = \
'调用 SetupDiGetDeviceInterfaceDetail函数，获得SP_DEVICE_INTERFACE_DETAIL_DATA结构 '注意：该函数需要调用两次，最后获得设备路径
MyDeviceInfoData.cbSize = Len(MyDeviceInfoData)
Result = SetupDiGetDeviceInterfaceDetail(DeviceInfoSet, MyDeviceInterfaceData, 0, 0, Needed, 0)
DetailData = Needed
Call DisplayResultOfAPICall(\ lstResults.AddItem \ (OK to say too small)\
lstResults.AddItem \ Required buffer size for the data: \
'存储结构的长度
MyDeviceInterfaceDetailData.cbSize = Len(MyDeviceInterfaceDetailData)
ReDim DetailDataBuffer(Needed)
'存储结构的前4和字节，cbSize
Call RtlMoveMemory(DetailDataBuffer(0), MyDeviceInterfaceDetailData, 4)
'再一次调用
Result = SetupDiGetDeviceInterfaceDetail(DeviceInfoSet, _ MyDeviceInterfaceData, VarPtr(DetailDataBuffer(0)), DetailData, Needed, 0)
Call DisplayResultOfAPICall(\
lstResults.AddItem \ MyDeviceInterfaceDetailData.cbSize: \
DevicePathName = CStr(DetailDataBuffer())
DevicePathName = StrConv(DevicePathName, vbUnicode) '转换成Unicode DevicePathName = Right$(DevicePathName, Len(DevicePathName) - 4) '删除4个字节 lstResults.AddItem \ Device pathname: \ lstResults.AddItem \ \
'调用 CreateFile 函数，获得设备句柄：HidDevice
第8章 USB接口HID设备 223
HidDevice = CreateFile(DevicePathName, GENERIC_READ Or GENERIC_WRITE, _ (FILE_SHARE_READ Or FILE_SHARE_WRITE), 0, OPEN_EXISTING, 0, 0)
Call DisplayResultOfAPICall(\
lstResults.AddItem \ Returned handle: \
'调用 HidD_GetAttributes 获得HID的VID、PID
DeviceAttributes.Size = LenB(DeviceAttributes)
Result = HidD_GetAttributes(HidDevice, DeviceAttributes)
Call DisplayResultOfAPICall(\ If Result <> 0 Then
lstResults.AddItem \ HIDD_ATTRIBUTES structure filled without error.\ Else
lstResults.AddItem \ Error in filling HIDD_ATTRIBUTES structure.\ End If
lstResults.AddItem \ Structure size: \
lstResults.AddItem \ Vendor ID: \ lstResults.AddItem \ Product ID: \
lstResults.AddItem \ Version Number: \
'看看是不是指定的VID、PID
If (DeviceAttributes.VendorID = MyVendorID) And (DeviceAttributes.ProductID = MyProductID) Then lstResults.AddItem \ My device detected \
lstResults.AddItem \ -------------------------------------------------------------------------------------------\ lblHID.Caption = \ MyDeviceDetected = True cmdGetCaps.Enabled = True cmdClose.Enabled = True txtVendorID.Enabled = False txtProductID.Enabled = False Else
MyDeviceDetected = False
Result = CloseHandle(HidDevice)
DisplayResultOfAPICall (\ End If End If
MemberIndex = MemberIndex + 1 '准备查找下一个
Loop Until (LastDevice = True) Or (MyDeviceDetected = True)
End Function
'************************************************************************************** '获得上一个API函数的执行信息
'**************************************************************************************
Private Function GetErrorString(ByVal LastError As Long) As String
Dim Bytes As Long
Dim ErrorString As String ErrorString = String$(129, 0)
Bytes = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0&, LastError, 0, ErrorString$, 128, 0)
If Bytes > 2 Then '去掉其中的回车 GetErrorString = Left$(ErrorString, Bytes - 2)
224 计算机高级接口实践 End If
End Function
'************************************************************************************** '清除数据域显示
'**************************************************************************************
Private Sub cmdClear_Click()
txtR1.Text = \txtR2.Text = \txtYear.Text = \txtMonth.Text = \txtDay.Text = \txtHour.Text = \txtMinute.Text = \txtSecond.Text = \End Sub
'************************************************************************************** '查找HID
'**************************************************************************************
Private Sub cmdFindHID_Click() Call FindTheHid End Sub
'************************************************************************************** '显示API函数的执行结果
'**************************************************************************************
Private Sub DisplayResultOfAPICall(FunctionName As String)
Dim ErrorString As String lstResults.AddItem \
ErrorString = GetErrorString(Err.LastDllError) lstResults.AddItem FunctionName
lstResults.AddItem \ Result = \End Sub
'************************************************************************************** '程序初始化
'**************************************************************************************
Private Sub Form_Load() frmMain.Show
tmrDelay.Enabled = False lstResults.Clear
MyVendorID = &H45E MyProductID = &H930A End Sub
'************************************************************************************** '获得HID的能力信息
'**************************************************************************************
Private Sub cmdGetCaps_click()
第8章 USB接口HID设备 225
Dim ppData(29) As Byte Dim ppDataString As Variant
'调用 HidD_GetPreparsedData 获得一个缓冲区指针
Result = HidD_GetPreparsedData(HidDevice, PreparsedData) Call DisplayResultOfAPICall(\
Result = RtlMoveMemory(ppData(0), PreparsedData, 30) Call DisplayResultOfAPICall(\
ppDataString = ppData()
ppDataString = StrConv(ppDataString, vbUnicode)
'调用 HidP_GetCaps 获得HID_CAPS 结构数据
Result = HidP_GetCaps(PreparsedData, Capabilities)
Call DisplayResultOfAPICall(\lstResults.AddItem \ Last error: \
lstResults.AddItem \ Usage: \
lstResults.AddItem \ Usage Page: \
lstResults.AddItem \ Input Report Byte Length: \lstResults.AddItem \ Output Report Byte Length: \lstResults.AddItem \ Feature Report Byte Length: \
lstResults.AddItem \ Number of Link Collection Nodes: \lstResults.AddItem \ Number of Input Button Caps: \lstResults.AddItem \ Number of Input Value Caps: \lstResults.AddItem \ Number of Input Data Indices: \lstResults.AddItem \ Number of Output Button Caps: \lstResults.AddItem \ Number of Output Value Caps: \lstResults.AddItem \ Number of Output Data Indices: \lstResults.AddItem \ Number of Feature Button Caps: \lstResults.AddItem \ Number of Feature Value Caps: \lstResults.AddItem \ Number of Feature Data Indices: \
'调用 HidP_GetValueCaps 获得HID能力的数值
Dim ValueCaps(1023) As Byte
Result = HidP_GetValueCaps(HidP_Input, ValueCaps(0), Capabilities.NumberInputValueCaps, PreparsedData)
Call DisplayResultOfAPICall(\
lstResults.AddItem \ -------------------------------------------------------------------------------------------\lblCaps.Caption = \
cmdTrans.Enabled = True cmdReceive.Enabled = True End Sub
'************************************************************************************** '输出报表到HID
'**************************************************************************************
Private Sub cmdTrans_Click()
Dim Count As Integer
Dim NumberOfBytesToSend As Long