www.pudn.com > usbhidio2.rar > UsbCommunication.bas
Attribute VB_Name = "USBCommunication"
Option Explicit
Dim Capabilities As HIDP_CAPS
Dim DataString As String
Dim DetailData As Long
Dim DeviceAttributes As HIDD_ATTRIBUTES
Dim DevicePathName As String
Dim DeviceInfoSet As Long
Dim ErrorString As String
Dim EventObject As Long
Public HIDHandle As Long
Dim HIDOverlapped As OVERLAPPED
Dim IncreaseOfPacket As Integer
Dim LastDevice As Boolean
Dim UsefulMember As Byte
Public 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 DetailDataBuffer() As Byte
Dim OutputReportData(64) As Byte
Dim InputReportData() As Byte
Dim PreparsedData As Long
Public ProductInformation(3) As ProductSpec_typ
Public ReadHandle As Long
Public Result As Long
Dim Security As SECURITY_ATTRIBUTES
Dim Timeout As Boolean
Public Function FindTheHid() As Boolean
Dim Count As Integer
Dim GUIDString As String
Dim HidGuid As GUID
Dim Buffer(100) As Byte
Dim ProductName As String
Dim SerialNumber As String
Dim MemberIndex As Long
LastDevice = False
MyDeviceDetected = False
Security.lpSecurityDescriptor = 0
Security.bInheritHandle = True
Security.nLength = Len(Security)
Result = HidD_GetHidGuid(HidGuid) '取得HID类别的GUID
DeviceInfoSet = SetupDiGetClassDevs _
(HidGuid, _
vbNullString, _
0, _
(DIGCF_PRESENT Or DIGCF_DEVICEINTERFACE)) '传回所有已经连接并检测过的HID，包含其信息的结构数组的地址
'DataString = GetDataString(DeviceInfoSet, 32)
MemberIndex = 0
UsefulMember = 0
Do
ProductName = ""
SerialNumber = ""
MyDeviceInterfaceData.cbSize = LenB(MyDeviceInterfaceData)
Result = SetupDiEnumDeviceInterfaces _
(DeviceInfoSet, _
0, _
HidGuid, _
MemberIndex, _
MyDeviceInterfaceData) '读取识别一个HID接口的结构的指针
If Result = 0 Then
LastDevice = True
End If
If Result <> 0 Then
MyDeviceInfoData.cbSize = Len(MyDeviceInfoData)
Result = SetupDiGetDeviceInterfaceDetail _
(DeviceInfoSet, _
MyDeviceInterfaceData, _
0, _
0, _
Needed, _
0)
DetailData = Needed
MyDeviceInterfaceDetailData.cbSize = _
Len(MyDeviceInterfaceDetailData)
ReDim DetailDataBuffer(Needed)
Call RtlMoveMemory _
(DetailDataBuffer(0), _
MyDeviceInterfaceDetailData, _
4)
Result = SetupDiGetDeviceInterfaceDetail _
(DeviceInfoSet, _
MyDeviceInterfaceData, _
VarPtr(DetailDataBuffer(0)), _
DetailData, _
Needed, _
0) '传回一个结构，此结构的DevicePath成员是一个设备路径，应用此路径来开启与该设备的通行
DevicePathName = CStr(DetailDataBuffer())
DevicePathName = StrConv(DevicePathName, vbUnicode)
DevicePathName = Right$(DevicePathName, Len(DevicePathName) - 4)
HIDHandle = CreateFile _
(DevicePathName, _
GENERIC_READ Or GENERIC_WRITE, _
(FILE_SHARE_READ Or FILE_SHARE_WRITE), _
Security, _
OPEN_EXISTING, _
0&, _
0) '开启一个HID设备，取得设备的代号，使用设备的代号与设备交换数据。代号存在HIDHandle，将来存在ReadHandle中
DeviceAttributes.Size = LenB(DeviceAttributes)
Result = HidD_GetAttributes _
(HIDHandle, _
DeviceAttributes) '取得一个包含厂商和产品ID以及产品版本号码的结构指针
If HidD_GetProductString(HIDHandle, VarPtr(Buffer(0)), UBound(Buffer)) Then
For Count = 0 To 82 Step 2 '42 Byte
ProductName = ProductName & Chr(Buffer(Count))
Next Count
End If
If HidD_GetSerialNumberString(HIDHandle, VarPtr(Buffer(0)), UBound(Buffer)) Then
For Count = 0 To 30 Step 2 '16 Byte
SerialNumber = SerialNumber & Chr(Buffer(Count))
Next Count
End If
'DeviceAttributes.VersionNumber = DeviceAttributes.VersionNumber
If (DeviceAttributes.VendorID = MyVendorID) And _
(DeviceAttributes.ProductID = MyProductID) And _
(ProductName = DeviceName) Then
MyDeviceDetected = True '判断设备是否连接上
Call GetDeviceCapabilities
Call PrepareForOverlappedTransfer
ReadHandle = CreateFile _
(DevicePathName, _
(GENERIC_READ Or GENERIC_WRITE), _
(FILE_SHARE_READ Or FILE_SHARE_WRITE), _
Security, _
OPEN_EXISTING, _
FILE_FLAG_OVERLAPPED, _
0) '此设备代号存在ReadHandle中
'For Count = 1 To 64 Step 1
' OutputReportData(Count) = Count
'Next Count '"Requre UserAsddress" is in the OutputReportData()
'Call WriteReport
'Call ReadReport
'ProductInformation(UsefulMember).UserAddress = InputReportData(1)
'ProductInformation(UsefulMember).ProductSerialNumber = SerialNumber
'ProductInformation(UsefulMember).ReadCode = ReadHandle
'ProductInformation(UsefulMember).WriteCode = HIDHandle
UsefulMember = UsefulMember + 1
Else
Result = CloseHandle _
(HIDHandle)
End If
End If
MemberIndex = MemberIndex + 1
Loop Until (LastDevice = True)
Result = SetupDiDestroyDeviceInfoList _
(DeviceInfoSet) '释放SetupDiGetClassDevs所使用的资源
Call SameDeviceDetect
End Function
Public 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$ & "0"
End If
Result$ = Result$ & Hex$(ThisByte) & " "
Next Offset
GetDataString = Result$
End Function
Public Sub GetDeviceCapabilities()
Dim ppData(29) As Byte
Dim ppDataString As Variant
Result = HidD_GetPreparsedData _
(HIDHandle, _
PreparsedData) '取得一个包含设备能力信息的缓冲区的指针
Result = RtlMoveMemory _
(ppData(0), _
PreparsedData, _
30)
ppDataString = ppData()
ppDataString = StrConv(ppDataString, vbUnicode)
Result = HidP_GetCaps _
(PreparsedData, _
Capabilities) '传回一个包含设备能力信息的结构，主要是报表的内容
Dim ValueCaps(1023) As Byte
Result = HidP_GetValueCaps _
(HidP_Input, _
ValueCaps(0), _
Capabilities.NumberInputValueCaps, _
PreparsedData) '传回一个报表中关于每个数值的信息的结构数组的指针
Result = HidD_FreePreparsedData _
(PreparsedData) '释放HidD_GetPreparsedData所使用的资源
End Sub
Public Sub InitializeDisplay()
Dim Count As Long
frmMain.optDeviceSymbol1.Enabled = False
frmMain.optDeviceSymbol2.Enabled = False
frmMain.optDeviceSymbol3.Enabled = False
frmMain.cmdOnce.Enabled = False
frmMain.cmdOnce.Caption = "No device detected!"
For Count = 1 To 64 Step 1
OutputReportData(Count) = 13
Next Count
'OutputReportData(1) = 72 'H
'OutputReportData(2) = 97 'a
'OutputReportData(3) = 112 'p
'OutputReportData(4) = 112 'p
'OutputReportData(5) = 121 'y
'OutputReportData(6) = 32 '
'OutputReportData(7) = 78 'N
'OutputReportData(8) = 101 'e
'OutputReportData(9) = 119 'w
'OutputReportData(10) = 32 '
'OutputReportData(11) = 89 'Y
'OutputReportData(12) = 101 'e
'OutputReportData(13) = 97 'a
'OutputReportData(14) = 114 'r
'OutputReportData(15) = 33 '!
'OutputReportData(16) = 33 '!
'OutputReportData(17) = 33 '!
' OutputReportData(18) = 129 '
' OutputReportData(19) = 2 '
' OutputReportData(20) = 33 '
' OutputReportData(21) = 33 '
' OutputReportData(22) = 33 '
' OutputReportData(23) = 33 '
' OutputReportData(24) = 33 '
' OutputReportData(25) = 33 '
' OutputReportData(26) = 33 '
' OutputReportData(27) = 33 '
' OutputReportData(28) = 33 '
' OutputReportData(29) = 33 '
' OutputReportData(30) = 33 '
' OutputReportData(31) = 121 '
' OutputReportData(32) = 122 '
' OutputReportData(33) = 123 '
' OutputReportData(34) = 124 '
' OutputReportData(35) = 125 '
' OutputReportData(36) = 128 '
' OutputReportData(37) = 129 '
IncreaseOfPacket = 0
Call FindTheHid
End Sub
Public Sub PrepareForOverlappedTransfer()
If EventObject = 0 Then
EventObject = CreateEvent _
(Security, _
True, _
True, _
"")
End If
HIDOverlapped.Offset = 0
HIDOverlapped.OffsetHigh = 0
HIDOverlapped.hEvent = EventObject
End Sub
Public Sub ReadAndWriteToDevice()
Dim Count As Long
Dim EndCount As Long
EndCount = 2000
'********************************************************1 start value
For Count = 1 To 64 Step 1
OutputReportData(Count) = 13
Next Count
OutputReportData(1) = 77 'M1 00000
OutputReportData(2) = 49 '
OutputReportData(3) = 32 '
OutputReportData(4) = 48 '
OutputReportData(5) = 48 '
OutputReportData(6) = 48 '
OutputReportData(7) = 48 '
OutputReportData(8) = 48 '
Call WriteReport
Call ReadReport
'****************************************************2 setp
For Count = 1 To 64 Step 1
OutputReportData(Count) = 13
Next Count
OutputReportData(1) = 77 'M4 00001
OutputReportData(2) = 52 '
OutputReportData(3) = 32 '
OutputReportData(4) = 48 '
OutputReportData(5) = 48 '
OutputReportData(6) = 48 '
OutputReportData(7) = 48 '
OutputReportData(8) = 49 '
Call WriteReport
Call ReadReport
'****************************************************3 stop
For Count = 1 To 64 Step 1
OutputReportData(Count) = 13
Next Count
OutputReportData(1) = 77 'M5 02000
OutputReportData(2) = 53 '
OutputReportData(3) = 32 '
OutputReportData(4) = 48 '
OutputReportData(5) = 50 '
OutputReportData(6) = 48 '
OutputReportData(7) = 48 '
OutputReportData(8) = 48 '
Call WriteReport
Call ReadReport
'****************************************************4 if limit
For Count = 1 To 64 Step 1
OutputReportData(Count) = 13
Next Count
OutputReportData(1) = 77 'MF 03000
OutputReportData(2) = 70 '
OutputReportData(3) = 32 '
OutputReportData(4) = 48 '
OutputReportData(5) = 51 '
OutputReportData(6) = 48 '
OutputReportData(7) = 48 '
OutputReportData(8) = 48 '
Call WriteReport
Call ReadReport
'****************************************************5 IPO limit
For Count = 1 To 64 Step 1
OutputReportData(Count) = 13
Next Count
OutputReportData(1) = 77 'MP 03000
OutputReportData(2) = 80 '
OutputReportData(3) = 32 '
OutputReportData(4) = 48 '
OutputReportData(5) = 51 '
OutputReportData(6) = 48 '
OutputReportData(7) = 48 '
OutputReportData(8) = 48 '
Call WriteReport
Call ReadReport
'****************************************************6 MA
For Count = 1 To 64 Step 1
OutputReportData(Count) = 13
Next Count
OutputReportData(1) = 77 'MA
OutputReportData(2) = 65 '
Call WriteReport
Call ReadReport
'****************************************************7 N
For Count = 1 To 64 Step 1
OutputReportData(Count) = 13
Next Count
OutputReportData(1) = 78 'N
For Count = 1 To EndCount
If Count = 2 Then
Count = Count '''''''''''''''''''''''''''''''''''''''
End If
If MyDeviceDetected = True Then
Call WriteReport
If MyDeviceDetected = True Then
Call ReadReport
End If
End If
If MyDeviceDetected = False Then
Count = EndCount '''''''''''''''''''''如有出错,则退出此次操作
MyDeviceDetected = FindTheHid
End If
Next Count
'frmMain.lstResults.AddItem "MessageOk"
'frmMain.txtBytesReceived.SelText = IncreaseOfPacket
frmMain.lstResults.ListIndex = frmMain.lstResults.ListCount - 1 '垂直滚动条滑块置底 'frmMain!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
End Sub
Public Sub ReadReport()
Dim Count
Dim NumberOfBytesRead As Long
'Dim ReadBuffer() As Byte
'Dim UBoundReadBuffer As Integer
Dim ByteValue As String
Dim MessageOk As String
ReDim InputReportData(Capabilities.InputReportByteLength - 1)
frmMain.lstResults.ListIndex = frmMain.lstResults.ListCount - 1 '出错拉 'frmMain!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Result = ReadFile _
(ReadHandle, _
InputReportData(0), _
CLng(Capabilities.InputReportByteLength), _
NumberOfBytesRead, _
HIDOverlapped) '重叠读取输入报表
frmMain.lstResults.ListIndex = frmMain.lstResults.ListCount - 1 'frmMain!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'bAlertable = True
Result = WaitForSingleObject _
(EventObject, _
20000) '延时读取，传回码用来指示发生何种情况
Select Case Result
Case WAIT_OBJECT_0
Case WAIT_TIMEOUT
Result = CancelIo _
(ReadHandle)
CloseHandle (HIDHandle)
CloseHandle (ReadHandle)
frmMain.lstResults.AddItem " Data is not prepared!"
'frmMain!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'End If
MyDeviceDetected = False
Case Else
frmMain.lstResults.AddItem " Undefined error!"
'frmMain!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'End If
MyDeviceDetected = False
End Select
'IncreaseOfPacket = IncreaseOfPacket + 1
If MyDeviceDetected = True Then
frmMain.txtBytesReceived.SelText = IncreaseOfPacket + 1 & vbCrLf 'frmMain!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
IncreaseOfPacket = IncreaseOfPacket + 1
For Count = 1 To UBound(InputReportData)
If Len(Hex$(InputReportData(Count))) < 2 Then
ByteValue = "0" & Hex$(InputReportData(Count))
Else
ByteValue = Hex$(InputReportData(Count))
End If
MessageOk = MessageOk & Chr(InputReportData(Count))
If InputReportData(Count + 1) = 13 Then
Count = UBound(InputReportData)
End If
Next Count
frmMain.lstResults.AddItem MessageOk
End If
End Sub
Public Sub WriteReport()
Dim Count As Integer
'Dim NumberOfBytesRead As Long
'Dim NumberOfBytesToSend As Long
Dim NumberOfBytesWritten As Long
'Dim ReadBuffer() As Byte
Dim SendBuffer() As Byte
ReDim SendBuffer(Capabilities.OutputReportByteLength - 1)
SendBuffer(0) = 0
For Count = 1 To Capabilities.OutputReportByteLength - 1
SendBuffer(Count) = OutputReportData(Count)
Next Count
NumberOfBytesWritten = 0
Result = WriteFile _
(HIDHandle, _
SendBuffer(0), _
CLng(Capabilities.OutputReportByteLength), _
NumberOfBytesWritten, _
0)
If Result = False Then
MyDeviceDetected = False
End If
End Sub
Public Sub SameDeviceDetect()
Dim Count As Byte
Dim CountSub As Byte
Dim Message As String
'Message = "At least 2 Device use the same address!Please change your setting!"
'MsgBox Message, vbExclamation + vbOKOnly, "Error"
'Message = "There are at least 1 counterfeit product!"
'MsgBox Message, vbCritical + vbOKOnly, "Error"
'If MyDeviceDetected = True Then
'
' For Count = 0 To UsefulMember - 1
' For CountSub = Count + 1 To UsefulMember - 1
' If ProductInformation(Count).UserAddress = ProductInformation(CountSub).UserAddress Then
' Message = "At least 2 Device use the same address!Please change your setting!"
' MsgBox Message, vbExclamation + vbOKOnly, "Error"
' Count = UsefulMember - 1
' CountSub = UsefulMember - 1
' MyDeviceDetected = False
' End If
' Next CountSub
' Next Count 'At least 2 Device use the same address?
'
' For Count = 0 To UsefulMember - 1
' For CountSub = Count + 1 To UsefulMember - 1
' If ProductInformation(Count).ProductSerialNumber = ProductInformation(CountSub).ProductSerialNumber Then
' Message = "There are at least 1 counterfeit product!"
' MsgBox Message, vbCritical + vbOKOnly, "Error"
' Count = UsefulMember - 1
' CountSub = UsefulMember - 1
' MyDeviceDetected = False
' End If
' Next CountSub
' Next Count 'There are at least 1 counterfeit product?
' If MyDeviceDetected = True Then
' If UsefulMember > 2 Then
' frmMain.optDeviceSymbol1.Enabled = True
' frmMain.optDeviceSymbol2.Enabled = True
' frmMain.optDeviceSymbol3.Enabled = True
' frmMain.optDeviceSymbol1.Value = True
' HIDHandle = ProductInformation(0).WriteCode
' ReadHandle = ProductInformation(0).ReadCode
' frmMain.optDeviceSymbol1.Caption = "Device " & ProductInformation(0).UserAddress
' frmMain.optDeviceSymbol2.Caption = "Device " & ProductInformation(1).UserAddress
' frmMain.optDeviceSymbol3.Caption = "Device " & ProductInformation(2).UserAddress
' End If
' If UsefulMember > 1 Then
' frmMain.optDeviceSymbol1.Enabled = True
' frmMain.optDeviceSymbol2.Enabled = True
' frmMain.optDeviceSymbol1.Value = True
' HIDHandle = ProductInformation(0).WriteCode
' ReadHandle = ProductInformation(0).ReadCode
' frmMain.optDeviceSymbol1.Caption = "Device " & ProductInformation(0).UserAddress
' frmMain.optDeviceSymbol2.Caption = "Device " & ProductInformation(1).UserAddress
' End If
' If UsefulMember > 0 Then
' frmMain.optDeviceSymbol1.Enabled = True
' frmMain.optDeviceSymbol1.Value = True
' HIDHandle = ProductInformation(0).WriteCode
' ReadHandle = ProductInformation(0).ReadCode
' frmMain.optDeviceSymbol1.Caption = "Device " & ProductInformation(0).UserAddress
' End If
'
' frmMain.cmdOnce.Enabled = True
' frmMain.cmdOnce.Caption = "Transmit"
' End If
'End If
If MyDeviceDetected = True Then
frmMain.optDeviceSymbol1.Enabled = True
' frmMain.optDeviceSymbol2.Enabled = True
frmMain.optDeviceSymbol1.Value = True
' HIDHandle = ProductInformation(0).WriteCode
' ReadHandle = ProductInformation(0).ReadCode
' frmMain.optDeviceSymbol1.Caption = "Device " & ProductInformation(0).UserAddress
' frmMain.optDeviceSymbol2.Caption = "Device " & ProductInformation(1).UserAddress
frmMain.cmdOnce.Enabled = True
frmMain.cmdOnce.Caption = "Transmit"
End If
If MyDeviceDetected = False Then
frmMain.optDeviceSymbol1.Enabled = False
frmMain.optDeviceSymbol2.Enabled = False
frmMain.optDeviceSymbol3.Enabled = False
frmMain.optDeviceSymbol1.Caption = "No Device"
frmMain.optDeviceSymbol2.Caption = "No Device"
frmMain.optDeviceSymbol3.Caption = "No Device"
frmMain.cmdOnce.Enabled = False
frmMain.cmdOnce.Caption = "No device detected!"
End If
End Sub