⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 usbcommunication.bas

📁 usb HID类设备通讯源程序
💻 BAS
📖 第 1 页 / 共 2 页
字号:
 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

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -