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