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