hid.vb

visual basic 2005 express 写的上位机

        '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)

        Try

            '***
            '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)

            Debug.WriteLine(MyDebugging.ResultOfAPICall("HidD_GetPreparsedData"))
            Debug.WriteLine("")

            '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:
                Debug.WriteLine(MyDebugging.ResultOfAPICall("HidP_GetCaps"))

                Debug.WriteLine("")

                Debug.WriteLine("  Usage: " & Hex(Capabilities.Usage))
                Debug.WriteLine("  Usage Page: " & Hex(Capabilities.UsagePage))
                Debug.WriteLine("  Input Report Byte Length: " & Capabilities.InputReportByteLength)
                Debug.WriteLine("  Output Report Byte Length: " & Capabilities.OutputReportByteLength)
                Debug.WriteLine("  Feature Report Byte Length: " & Capabilities.FeatureReportByteLength)
                Debug.WriteLine("  Number of Link Collection Nodes: " & Capabilities.NumberLinkCollectionNodes)
                Debug.WriteLine("  Number of Input Button Caps: " & Capabilities.NumberInputButtonCaps)
                Debug.WriteLine("  Number of Input Value Caps: " & Capabilities.NumberInputValueCaps)
                Debug.WriteLine("  Number of Input Data Indices: " & Capabilities.NumberInputDataIndices)
                Debug.WriteLine("  Number of Output Button Caps: " & Capabilities.NumberOutputButtonCaps)
                Debug.WriteLine("  Number of Output Value Caps: " & Capabilities.NumberOutputValueCaps)
                Debug.WriteLine("  Number of Output Data Indices: " & Capabilities.NumberOutputDataIndices)
                Debug.WriteLine("  Number of Feature Button Caps: " & Capabilities.NumberFeatureButtonCaps)
                Debug.WriteLine("  Number of Feature Value Caps: " & Capabilities.NumberFeatureValueCaps)
                Debug.WriteLine("  Number of Feature Data Indices: " & Capabilities.NumberFeatureDataIndices)

                '***
                '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)


                Debug.WriteLine(MyDebugging.ResultOfAPICall("HidP_GetValueCaps"))
                Debug.WriteLine("")

                '(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)


                Debug.WriteLine(MyDebugging.ResultOfAPICall("HidD_FreePreparsedData"))
                Debug.WriteLine("")

            End If

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

        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 IsWindowsXpOrLater() As Boolean

        'Find out if the current operating system is Windows XP or later.
        '(Windows XP or later is required for HidD_GetInputReport and HidD_SetInputReport.)

        Try
            Dim MyEnvironment As OperatingSystem = Environment.OSVersion

            'Windows XP is version 5.1.
            Dim VersionXP As New System.Version(5, 1)

            If (Version.op_GreaterThanOrEqual(MyEnvironment.Version, VersionXP) = True) Then
                Debug.Write("The OS is Windows XP or later.")
                Return True
            Else
                Debug.Write("The OS is earlier than Windows XP.")
                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