hid.vb

visual basic 2005 express 写的上位机

            '             OutputReportBuffer - contains the report ID and report to send.

            'Returns    : True on success. False on failure.


            Dim NumberOfBytesWritten As Integer
            Dim Result As Boolean


            'The host will use an interrupt transfer if the the HID has an interrupt OUT
            'endpoint (requires USB 1.1 or later) AND the OS is NOT Windows 98 Gold (original version). 
            'Otherwise the the host will use a control transfer.
            'The application doesn't have to know or care which type of transfer is used.

            NumberOfBytesWritten = 0

            '***
            'API function: WriteFile

            'Purpose: writes an Output report to the device.

            'Accepts:
            'A handle returned by CreateFile
            'The output report byte length returned by HidP_GetCaps.
            'An integer to hold the number of bytes written.

            'Returns: True on success, False on failure.
            '***

            Result = WriteFile(writeHandle, outputReportBuffer(0), UBound(outputReportBuffer) + 1, NumberOfBytesWritten, 0)


            If (Result = True) Then

                'On success, display the data written.

            Else
                'On failure, close the handles.

                If (writeHandle <> 0) Then
                    CloseHandle(writeHandle)

                End If
            End If

            'Return True on success, False on failure.

            Return CBool(Result)

        End Function

    End Class


    Class OutputReportViaControlTransfer
        Inherits HostReport

        Protected Overrides Function ProtectedWrite(ByVal hidHandle As Integer, ByVal outputReportBuffer() As Byte) As Boolean

            'Purpose    : writes an Output report to the device using a control transfer.

            'Accepts    : hidHandle - a handle to the device.
            '             outputReportBuffer - contains the report ID and report to send.

            'Returns    : True on success. False on failure.

            Dim Success As Boolean
            '***
            'API function: HidD_SetOutputReport

            'Purpose: 
            'Attempts to send an Output report to the device using a control transfer.
            'Requires Windows XP or later.

            'Accepts:
            'A handle to a HID
            'A pointer to a buffer containing the report ID and report
            'The size of the buffer. 

            'Returns: true on success, false on failure.
            '***

            Success = HidD_SetOutputReport(hidHandle, outputReportBuffer(0), UBound(outputReportBuffer) + 1)

            Return Success



        End Function

    End Class


    Friend Function FlushQueue(ByVal hidHandle As Integer) As Boolean

        'Purpose    : Remove any Input reports waiting in the buffer.

        'Accepts    : hidHandle - a handle to a device.           

        'Returns    : True on success, False on failure.

        Dim Result As Boolean

            '***
            'API function: HidD_FlushQueue

            'Purpose: Removes any Input reports waiting in the buffer.

            'Accepts: a handle to the device.

            'Returns: True on success, False on failure.
            '***

            Result = HidD_FlushQueue(hidHandle)


            Return Result


    End Function


    Friend Function GetDeviceCapabilities _
        (ByVal hidHandle As Integer) _
        As HIDP_CAPS

        'Purpose    : Retrieves a structure with information about a device's capabilities. 

        'Accepts    : HIDHandle - a handle to a device.      

        'Returns    : An HIDP_CAPS structure.

        Dim PreparsedDataBytes(29) As Byte
        Dim PreparsedDataString As String
        Dim PreparsedDataPointer As IntPtr
        Dim Result As Integer
        Dim Success As Boolean
        Dim ValueCaps(1023) As Byte '(the array size is a guess)

        '***
        'API function: HidD_GetPreparsedData

        'Purpose: retrieves a pointer to a buffer containing information about the device's capabilities.
        'HidP_GetCaps and other API functions require a pointer to the buffer.

        'Requires: 
        'A handle returned by CreateFile.
        'A pointer to a buffer.

        'Returns:
        'True on success, False on failure.
        '***

        Success = HidD_GetPreparsedData(hidHandle, PreparsedDataPointer)


        'Copy the data at PreparsedDataPointer into a byte array.

        PreparsedDataString = System.Convert.ToBase64String(PreparsedDataBytes)


        '***
        'API function: HidP_GetCaps

        'Purpose: find out a device's capabilities.
        'For standard devices such as joysticks, you can find out the specific
        'capabilities of the device.
        'For a custom device where the software knows what the device is capable of,
        'this call may be unneeded.

        'Accepts:
        'A pointer returned by HidD_GetPreparsedData
        'A pointer to a HIDP_CAPS structure.

        'Returns: True on success, False on failure.
        '***

        Result = HidP_GetCaps(PreparsedDataPointer, Capabilities)
        If (Result <> 0) Then
            ' Debug data:

            '***
            'API function: HidP_GetValueCaps

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

            'Accepts:
            'A report type enumerator from hidpi.h,
            'A pointer to a buffer for the returned array,
            'The NumberInputValueCaps member of the device's HidP_Caps structure,
            'A pointer to the PreparsedData structure returned by HidD_GetPreparsedData.

            'Returns: True on success, False on failure.
            '***

            Result = HidP_GetValueCaps(HidP_Input, ValueCaps(0), Capabilities.NumberInputValueCaps, PreparsedDataPointer)


            '(To use this data, copy the ValueCaps byte array into an array of structures.)

            '***
            'API function: HidD_FreePreparsedData

            'Purpose: frees the buffer reserved by HidD_GetPreparsedData.

            'Accepts: A pointer to the PreparsedData structure returned by HidD_GetPreparsedData.

            'Returns: True on success, False on failure.
            '***

            Success = HidD_FreePreparsedData(PreparsedDataPointer)



        End If



        Return Capabilities

    End Function


    Friend Function GetHIDUsage _
        (ByVal MyCapabilities As HIDP_CAPS) _
        As String

        'Purpose    : Creates a 32-bit Usage from the Usage Page and Usage ID. 
        '           : Determines whether the Usage is a system mouse or keyboard.
        '           : Can be modified to detect other Usages.

        'Accepts    : MyCapabilities - a HIDP_CAPS structure retrieved with HidP_GetCaps.      

        'Returns    : A string describing the Usage.

        Dim Usage As Integer
        Dim UsageDescription As String = ""

        Try

            'Create32-bit Usage from Usage Page and Usage ID.

            Usage = MyCapabilities.UsagePage * 256 + MyCapabilities.Usage

            If Usage = CInt(&H102) Then UsageDescription = "mouse"
            If Usage = CInt(&H106) Then UsageDescription = "keyboard"

        Catch ex As Exception
            Call HandleException(ModuleName, ex)
        End Try

        Return UsageDescription

    End Function


    Friend Function GetNumberOfInputBuffers _
      (ByVal hidDeviceObject As Integer, _
      ByRef numberOfInputBuffers As Integer) _
      As Boolean

        'Purpose    : Retrieves the number of Input reports the host can store.

        'Accepts    : hidDeviceObject - a handle to a device 
        '           : numberBuffers - an integer to hold the returned value.          

        'Returns    : True on success, False on failure.

        Dim Success As Boolean

        Try

            If Not (IsWindows98Gold()) Then
                '***
                'API function: HidD_GetNumInputBuffers

                'Purpose: retrieves the number of Input reports the host can store.
                'Not supported by Windows 98 Gold.
                'If the buffer is full and another report arrives, the host drops the 
                'oldest report.

                'Accepts: a handle to a device and an integer to hold the number of buffers. 

                'Returns: True on success, False on failure.
                '***

                Success = HidD_GetNumInputBuffers(hidDeviceObject, numberOfInputBuffers)

            Else

                'Under Windows 98 Gold, the number of buffers is fixed at 2.

                numberOfInputBuffers = 2
                Success = True
            End If

            Return Success

        Catch ex As Exception
            Call HandleException(ModuleName, ex)
        End Try

    End Function


    Friend Function SetNumberOfInputBuffers _
         (ByVal hidDeviceObject As Integer, _
         ByVal numberBuffers As Integer) _
         As Boolean

        'Purpose    : sets the number of input reports the host will store.
        '           : Requires Windows XP or later.

        'Accepts    : hidDeviceObject - a handle to the device.
        '           : numberBuffers - the requested number of input reports. 

        'Returns    : True on success. False on failure.

        Dim Success As Boolean

        Try

            If Not (IsWindows98Gold()) Then

                '***
                'API function: HidD_SetNumInputBuffers

                'Purpose: Sets the number of Input reports the host can store.
                'If the buffer is full and another report arrives, the host drops the 
                'oldest report.

                'Requires:
                'A handle to a HID
                'An integer to hold the number of buffers. 

                'Returns: true on success, false on failure.
                '***

                HidD_SetNumInputBuffers _
                     (hidDeviceObject, _
                     numberBuffers)

                Return Success

            Else

                'Not supported under Windows 98 Gold.

                Return False
            End If

        Catch ex As Exception
            Call HandleException(ModuleName, ex)
        End Try

    End Function



    Friend Function IsWindows98Gold() As Boolean

        'Find out if the current operating system is Windows 98 Gold (original version).
        'Windows 98 Gold does not support the following:
        '  Interrupt OUT transfers (WriteFile uses control transfers and Set_Report).
        '  HidD_GetNumInputBuffers and HidD_SetNumInputBuffers

        '(Not yet tested on a Windows 98 Gold system.)

        Try
            Dim MyEnvironment As OperatingSystem = Environment.OSVersion

            'Windows 98 Gold is version 4.10 with a build number less than 2183.

            Dim Version98SE As New System.Version(4, 10, 2183)

            If (Version.op_LessThan(MyEnvironment.Version, Version98SE) = True) Then
                Debug.Write("The OS is Windows 98 Gold.")
                Return True
            Else
                Debug.Write("The OS is more recent than Windows 98 Gold.")
                Return False
            End If

        Catch ex As Exception
            Call HandleException(ModuleName, ex)
        End Try

    End Function

    Shared Sub HandleException(ByVal moduleName As String, ByVal e As Exception)

        'Purpose    : Provides a central mechanism for exception handling.
        '           : Displays a message box that describes the exception.

        'Accepts    : moduleName - the module where the exception occurred.
        '           : e - the exception

        Dim Message As String
        Dim Caption As String

        Try
            'Create an error message.

            Message = "Exception: " & e.Message & ControlChars.CrLf & _
            "Module: " & moduleName & ControlChars.CrLf & _
             "Method: " & e.TargetSite.Name

            'Specify a caption.

            Caption = "Unexpected Exception"

            'Display the message in a message box.

            MessageBox.Show(Message, Caption, MessageBoxButtons.OK)
            Debug.Write(Message)
        Finally
        End Try
    End Sub

End Class