frmmain.frm

vb操作USB设备

        If (ThisByte And &HF0) = 0 Then
            Result$ = Result$ & "0"
        End If
        Result$ = Result$ & Hex$(ThisByte) & " "
    Next Offset
    
    GetDataString = Result$
End Function

Private Function GetErrorString(ByVal LastError As Long) As String

'Returns the error message for the last error.
'Adapted from Dan Appleman's "Win32 API Puzzle Book"

    Dim Bytes As Long
    Dim ErrorString As String
    ErrorString = String$(129, 0)
    Bytes = FormatMessage _
        (FORMAT_MESSAGE_FROM_SYSTEM, _
        0&, _
        LastError, _
        0, _
        ErrorString$, _
        128, _
        0)
        
    'Subtract two characters from the message to strip the CR and LF.
    If Bytes > 2 Then
        GetErrorString = Left$(ErrorString, Bytes - 2)
    End If

End Function

Private Sub cmdContinuous_Click()
'Enables the user to select 1-time or continuous data transfers.

    If cmdContinuous.Caption = "Continuous" Then
        'Change the command button to Cancel Continuous
        cmdContinuous.Caption = "Cancel Continuous"
        'Enable the timer to read and write to the device once/second.
        tmrContinuousDataCollect.Enabled = True
        Call ReadAndWriteToDevice
    Else
        'Change the command button to Continuous
        cmdContinuous.Caption = "Continuous"
        'Disable the timer that reads and writes to the device once/second.
        tmrContinuousDataCollect.Enabled = False
    End If

End Sub

Private Sub cmdOnce_Click()

    Call ReadAndWriteToDevice
    
End Sub
Private Sub DisplayResultOfAPICall(FunctionName As String)

'Display the results of an API call.

    Dim ErrorString As String
    
    lstResults.AddItem ""
    ErrorString = GetErrorString(Err.LastDllError)
    lstResults.AddItem FunctionName
    lstResults.AddItem "  Result = " & ErrorString
    
    'Scroll to the bottom of the list box.
    lstResults.ListIndex = lstResults.ListCount - 1

End Sub

Private Sub Form_Load()

    frmMain.Show
    tmrDelay.Enabled = False
    Call Startup
    
End Sub

Private Sub Form_Unload(Cancel As Integer)

    Call Shutdown
    
End Sub

Private Sub GetDeviceCapabilities()

'******************************************************************************
'HidD_GetPreparsedData
'Returns: a pointer to a buffer containing information about the device's capabilities.
'Requires: A handle returned by CreateFile.
'There's no need to access the buffer directly,
'but HidP_GetCaps and other API functions require a pointer to the buffer.
'******************************************************************************

    Dim ppData(29) As Byte
    Dim ppDataString As Variant
    
    'Preparsed Data is a pointer to a routine-allocated buffer.
    Result = HidD_GetPreparsedData _
        (HidDevice, _
        PreparsedData)
    Call DisplayResultOfAPICall("HidD_GetPreparsedData")
    
    'Copy the data at PreparsedData into a byte array.
    
    Result = RtlMoveMemory _
        (ppData(0), _
        PreparsedData, _
        30)
    Call DisplayResultOfAPICall("RtlMoveMemory")
    
    ppDataString = ppData()
    'Convert the data to Unicode.
    ppDataString = StrConv(ppDataString, vbUnicode)

'******************************************************************************
'HidP_GetCaps
'Find out the device's capabilities.
'For standard devices such as joysticks, you can find out the specific
'capabilities of the device.
'For a custom device, the software will probably know what the device is capable of,
'so this call only verifies the information.
'Requires: The pointer to a buffer containing the information.
'The pointer is returned by HidD_GetPreparsedData.
'Returns: a Capabilites structure containing the information.
'******************************************************************************
    Result = HidP_GetCaps _
        (PreparsedData, _
        Capabilities)
    
    Call DisplayResultOfAPICall("HidP_GetCaps")
    lstResults.AddItem "  Last error: " & ErrorString
    lstResults.AddItem "  Usage: " & Hex$(Capabilities.Usage)
    lstResults.AddItem "  Usage Page: " & Hex$(Capabilities.UsagePage)
    lstResults.AddItem "  Input Report Byte Length: " & Capabilities.InputReportByteLength
    lstResults.AddItem "  Output Report Byte Length: " & Capabilities.OutputReportByteLength
    lstResults.AddItem "  Feature Report Byte Length: " & Capabilities.FeatureReportByteLength
    lstResults.AddItem "  Number of Link Collection Nodes: " & Capabilities.NumberLinkCollectionNodes
    lstResults.AddItem "  Number of Input Button Caps: " & Capabilities.NumberInputButtonCaps
    lstResults.AddItem "  Number of Input Value Caps: " & Capabilities.NumberInputValueCaps
    lstResults.AddItem "  Number of Input Data Indices: " & Capabilities.NumberInputDataIndices
    lstResults.AddItem "  Number of Output Button Caps: " & Capabilities.NumberOutputButtonCaps
    lstResults.AddItem "  Number of Output Value Caps: " & Capabilities.NumberOutputValueCaps
    lstResults.AddItem "  Number of Output Data Indices: " & Capabilities.NumberOutputDataIndices
    lstResults.AddItem "  Number of Feature Button Caps: " & Capabilities.NumberFeatureButtonCaps
    lstResults.AddItem "  Number of Feature Value Caps: " & Capabilities.NumberFeatureValueCaps
    lstResults.AddItem "  Number of Feature Data Indices: " & Capabilities.NumberFeatureDataIndices

'******************************************************************************
'HidP_GetValueCaps
'Returns a buffer containing an array of HidP_ValueCaps structures.
'Each structure defines the capabilities of one value.
'This application doesn't use this data.
'******************************************************************************

'This is a guess. The byte array holds the structures.
    Dim ValueCaps(1023) As Byte
    
    Result = HidP_GetValueCaps _
        (HidP_Input, _
        ValueCaps(0), _
        Capabilities.NumberInputValueCaps, _
        PreparsedData)
       
    Call DisplayResultOfAPICall("HidP_GetValueCaps")

'lstResults.AddItem "ValueCaps= " & GetDataString((VarPtr(ValueCaps(0))), 180)
'To use this data, copy the byte array into an array of structures.

End Sub

Private Sub InitializeDisplay()
    Dim Count As Integer
    Dim ByteValue As String
    'Create a dropdown list box for each byte to send.
    For Count = 0 To 255
        If Len(Hex$(Count)) < 2 Then
            ByteValue = "0" & Hex$(Count)
        Else
            ByteValue = Hex$(Count)
        End If
        frmMain.cboByte0.AddItem ByteValue, Count
    Next Count
    For Count = 0 To 255
        If Len(Hex$(Count)) < 2 Then
            ByteValue = "0" & Hex$(Count)
        Else
            ByteValue = Hex$(Count)
        End If
        frmMain.cboByte1.AddItem ByteValue, Count
    Next Count
    'Select a default item for each box
    frmMain.cboByte0.ListIndex = 0
    frmMain.cboByte1.ListIndex = 128
End Sub

Private Sub ReadAndWriteToDevice()
'Sends two bytes to the device and reads two bytes back.

    Dim DeviceDetected As Boolean
    
    'Report Header
    lstResults.AddItem "HID Test Report"
    lstResults.AddItem Format(Now, "general date")

'Some data to send
'(if not using the combo boxes):
'OutputReportData(0) = &H12
'OutputReportData(1) = &H34
'OutputReportData(2) = &HF0
'OutputReportData(3) = &HF1
'OutputReportData(4) = &HF2
'OutputReportData(5) = &HF3
'OutputReportData(6) = &HF4
'OutputReportData(7) = &HF5

'Get the bytes to send from the combo boxes.
'Increment the values if the autoincrement check box is selected.
    If chkAutoincrement.Value = 1 Then
        If cboByte0.ListIndex < 255 Then
            cboByte0.ListIndex = cboByte0.ListIndex + 1
        Else
            cboByte0.ListIndex = 0
        End If
        If cboByte1.ListIndex < 255 Then
            cboByte1.ListIndex = cboByte1.ListIndex + 1
        Else
            cboByte1.ListIndex = 0
        End If
    End If

    OutputReportData(0) = cboByte0.ListIndex
    OutputReportData(1) = cboByte1.ListIndex

'Find the device
    DeviceDetected = FindTheHid
    If DeviceDetected = True Then
        'Learn the capabilities of the device
        Call GetDeviceCapabilities
        'Write a report to the device
        Call WriteReport
        
        'The firmware adds 1 to each received byte and sends the bytes back
        'to the host.
        'Add a delay to allow the host time to poll for the returned data.
        Timeout = False
        tmrDelay.Interval = 100
        tmrDelay.Enabled = True
        Do
            DoEvents
        Loop Until Timeout = True
        'Read a report from the device.
        Call ReadReport
    Else
    End If

'Scroll to the bottom of the list box.
lstResults.ListIndex = lstResults.ListCount - 1

End Sub

Private Sub ReadReport()

'Read data from the device.

    Dim Count
    Dim NumberOfBytesRead As Long
    'Allocate a buffer for the report.
    'Byte 0 is the report ID.
    Dim ReadBuffer() As Byte
    Dim UBoundReadBuffer As Integer

'******************************************************************************
'ReadFile
'Returns: the report in ReadBuffer.
'Requires: a device handle returned by CreateFile,
'the Input report length in bytes returned by HidP_GetCaps.
'******************************************************************************

'ReadFile is a blocking call. The application will hang until the device
'sends the requested amount of data. To prevent hanging, be sure that
'the device always has data to send.

    Dim ByteValue As String
'The ReadBuffer array begins at 0, so subtract 1 from the number of bytes.
    ReDim ReadBuffer(Capabilities.InputReportByteLength - 1)
    
'Pass the address of the first byte of the read buffer.
    Result = ReadFile _
    (HidDevice, _
    ReadBuffer(0), _
    CLng(Capabilities.InputReportByteLength), _
    NumberOfBytesRead, _
    0)
    Call DisplayResultOfAPICall("ReadFile")

    lstResults.AddItem " Report ID: " & ReadBuffer(0)
    lstResults.AddItem " Report Data:"

    txtBytesReceived.Text = ""
    For Count = 1 To UBound(ReadBuffer)
    'Add a leading 0 to values 0 - Fh.
        If Len(Hex$(ReadBuffer(Count))) < 2 Then
            ByteValue = "0" & Hex$(ReadBuffer(Count))
        Else
            ByteValue = Hex$(ReadBuffer(Count))
        End If
        lstResults.AddItem " " & ByteValue
        'Display the received bytes in the text box.
        txtBytesReceived.SelStart = Len(txtBytesReceived.Text)
        txtBytesReceived.SelText = ByteValue & vbCrLf
    
    Next Count
End Sub

Private Sub Shutdown()
    'Includes actions that must execute when the program ends.
    
    'Close the open handle to the device.
    Result = CloseHandle _
        (HidDevice)
    Call DisplayResultOfAPICall("CloseHandle (HidDevice)")
    
    'Free memory used by SetupDiGetClassDevs
    'Nonzero = success
    Result = SetupDiDestroyDeviceInfoList _
        (DeviceInfoSet)
    Call DisplayResultOfAPICall("DestroyDeviceInfoList")
    
    Result = HidD_FreePreparsedData _
        (PreparsedData)
    Call DisplayResultOfAPICall("HidD_FreePreparsedData")

End Sub

Private Sub Startup()
    Call InitializeDisplay
    tmrContinuousDataCollect.Enabled = False
    tmrContinuousDataCollect.Interval = 1000
End Sub

Private Sub tmrContinuousDataCollect_Timer()

    Call ReadAndWriteToDevice

End Sub

Private Sub tmrDelay_Timer()
    Timeout = True
    tmrDelay.Enabled = False
End Sub

Private Sub WriteReport()
'Send data to the device.

    Dim Count As Integer
    Dim NumberOfBytesRead As Long
    Dim NumberOfBytesToSend As Long
    Dim NumberOfBytesWritten As Long
    Dim ReadBuffer() As Byte
    Dim SendBuffer() As Byte
    
    'The SendBuffer array begins at 0, so subtract 1 from the number of bytes.
    ReDim SendBuffer(Capabilities.OutputReportByteLength - 1)

'******************************************************************************
'WriteFile
'Sends a report to the device.
'Returns: success or failure.
'Requires: the handle returned by CreateFile and
'The output report byte length returned by HidP_GetCaps
'******************************************************************************

'The first byte is the Report ID
    SendBuffer(0) = 0
    
    'The next bytes are data
    For Count = 1 To Capabilities.OutputReportByteLength - 1
        SendBuffer(Count) = OutputReportData(Count - 1)
    Next Count
    
    NumberOfBytesWritten = 0
    
    Result = WriteFile _
        (HidDevice, _
        SendBuffer(0), _
        CLng(Capabilities.OutputReportByteLength), _
        NumberOfBytesWritten, _
        0)
    Call DisplayResultOfAPICall("WriteFile")
    
    lstResults.AddItem " OutputReportByteLength = " & Capabilities.OutputReportByteLength
    lstResults.AddItem " NumberOfBytesWritten = " & NumberOfBytesWritten
    lstResults.AddItem " Report ID: " & SendBuffer(0)
    lstResults.AddItem " Report Data:"
    
    For Count = 1 To UBound(SendBuffer)
        lstResults.AddItem " " & Hex$(SendBuffer(Count))
    Next Count

End Sub