第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