第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

226 计算机高级接口实践 Dim NumberOfBytesWritten As Long Dim SendBuffer() As Byte

ReDim SendBuffer(Capabilities.OutputReportByteLength - 1)

'填写报表数据到数组SendBuffer Count = 0

SendBuffer(Count) = 0 '第一個位元組是Report ID Count = Count + 1

SendBuffer(Count) = &H55 Count = Count + 1

SendBuffer(Count) = &HAA Count = Count + 1

SendBuffer(Count) = &H1 Count = Count + 1

SendBuffer(Count) = &H8 Count = Count + 1

SendBuffer(Count) = Val(\Count = Count + 1

SendBuffer(Count) = Val(\Count = Count + 1

SendBuffer(Count) = Val(txtYear.Text) Count = Count + 1

SendBuffer(Count) = Val(txtMonth.Text) Count = Count + 1

SendBuffer(Count) = Val(txtDay.Text) Count = Count + 1

SendBuffer(Count) = Val(txtHour.Text) Count = Count + 1

SendBuffer(Count) = Val(txtMinute.Text) Count = Count + 1

SendBuffer(Count) = Val(txtSecond.Text) Count = Count + 1

'调用 WriteFile 函数,发送报表

NumberOfBytesWritten = 0

Result = WriteFile(HidDevice, SendBuffer(0), CLng(Capabilities.OutputReportByteLength), NumberOfBytesWritten, 0)

Call DisplayResultOfAPICall(\

lstResults.AddItem \ Output Report\End Sub

'************************************************************************************** '从HID读取报表

'注意：以下代码为非重叠调用，必须保证HID输出报表

'**************************************************************************************

Private Sub cmdReceive_click()

Dim Count

Dim NumberOfBytesRead As Long Dim ReadBuffer() As Byte

ReDim ReadBuffer(Capabilities.InputReportByteLength - 1)

'调用 ReadFile 函数，读取报表

Result = ReadFile(HidDevice, ReadBuffer(0), CLng(Capabilities.InputReportByteLength), NumberOfBytesRead, 0)

Call DisplayResultOfAPICall(\

lstResults.AddItem \ Input Report\

第8章 USB接口HID设备 227

'将输入报表的数据填写到显示介面的相应数据域 txtR1.Text = Hex$(ReadBuffer(5)) txtR2.Text = Hex$(ReadBuffer(6))

txtYear.Text = IIf(ReadBuffer(7) < 10, \txtMonth.Text = IIf(ReadBuffer(8) < 10, \txtDay.Text = IIf(ReadBuffer(9) < 10, \txtHour.Text = IIf(ReadBuffer(10) < 10, \txtMinute.Text = IIf(ReadBuffer(11) < 10, \txtSecond.Text = IIf(ReadBuffer(12) < 10, \End Sub

'************************************************************************************** '关闭设备，释放资源

'**************************************************************************************

Private Sub cmdClose_Click()

'调用 CloseHandle 关闭HID

Result = CloseHandle(HidDevice)

Call DisplayResultOfAPICall(\

'调用 SetupDiDestroyDeviceInfoList和HidD_FreePreparsedData 释放占用的资源

Result = SetupDiDestroyDeviceInfoList(DeviceInfoSet) Call DisplayResultOfAPICall(\Result = HidD_FreePreparsedData(PreparsedData)

Call DisplayResultOfAPICall(\

lstResults.Clear

cmdClose.Enabled = False cmdGetCaps.Enabled = False cmdTrans.Enabled = False cmdReceive.Enabled = False lblHID.Caption = \lblCaps.Caption = \

txtVendorID.Enabled = True txtProductID.Enabled = True End Sub

'************************************************************************************** '将当前日期和时间填写到界面的数据域

'**************************************************************************************

Private Sub cmdNow_Click()

txtHour.Text = IIf(Hour(Now()) < 10, \

txtMinute.Text = IIf(Minute(Now()) < 10, \txtSecond.Text = IIf(Second(Now()) < 10, \

txtYear.Text = IIf((Year(Now()) - 2000) < 10, \txtMonth.Text = IIf(Month(Now()) < 10, \txtDay.Text = IIf(Day(Now()) < 10, \End Sub

'************************************************************************************** '获得信息字符串

'**************************************************************************************

228 计算机高级接口实践 Private Function GetDataString(Address As Long, Bytes As Long) As String Dim Offset As Integer Dim Result$ Dim ThisByte As Byte For Offset = 0 To Bytes - 1 Call RtlMoveMemory(ByVal VarPtr(ThisByte), ByVal Address + Offset, 1) If (ThisByte And &HF0) = 0 Then Result$ = Result$ & \ End If Result$ = Result$ & Hex$(ThisByte) & \Next Offset GetDataString = Result$ End Function