usbcommunication.bas

usb HID类设备通讯源程序

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