frmmain.vb

visual basic 2005 express 写的上位机

#End Region
#Region "Upgrade Support "
    Private Shared m_vb6FormDefInstance As frmMain
    Private Shared m_InitializingDefInstance As Boolean
    Public Shared Property DefInstance() As frmMain
        Get
            If m_vb6FormDefInstance Is Nothing OrElse m_vb6FormDefInstance.IsDisposed Then
                m_InitializingDefInstance = True
                m_vb6FormDefInstance = New frmMain()
                m_InitializingDefInstance = False
            End If
            DefInstance = m_vb6FormDefInstance
        End Get
        Set(ByVal Value As frmMain)
            m_vb6FormDefInstance = Value
        End Set
    End Property
#End Region

    'Project: usbhidio_vbdotnet
    'Version: 2.3
    'Date: 8/29/05
    '
    'This version is written using Visual Basic 2005 Express Edition, Beta 2, available from:
    ' http://lab.msdn.microsoft.com/express
    'This version does not compile and run on earlier editions of Visual Studio.

    'Purpose: 
    'Demonstrates USB communications with a generic HID-class device

    'Description:
    'Finds an attached device that matches the vendor and product IDs in the form's 
    'text boxes.
    'Retrieves the device's capabilities.
    'Sends and requests HID reports.

    'Uses RegisterDeviceNotification() and WM_DEVICE_CHANGE messages
    'to detect when a device is attached or removed.
    'RegisterDeviceNotification doesn't work under Windows 98 (not sure why).

    'A list box displays the data sent and received,
    'along with error and status messages.

    'Combo boxes select data to send, and 1-time or timed, periodic transfers.

    'You can change the size of the host's Input report buffer and request to use control
    'transfers only to exchange Input and Output reports.

    'To view additional debugging messages, in the Visual Studio development environment,
    'select the Debug build (Build > Configuration Manager > Active Solution Configuration)
    'and view the Output window (View > Other Windows > Output)

    'The application uses a Delegate and the BeginInvoke and EndInvoke methods to read
    'Input reports asynchronously, so the application's main thread doesn't have to
    'wait for the device to return an Input report when the HID driver's buffer is empty. 

    'If you want to only receive data or only send data, comment out the unwanted code 
    '(In ExchangeInputAndOutputReports or ExchangeFeatureReports, comment out
    'the "Success = " line and the "If Success" block that follows it).

    'This project includes the following modules:
    'frmMain.vb - routines specific to the form.
    'Hid.vb - routines specific to HID communications.
    'DeviceManagement.vb - routines for obtaining a handle to a device from its GUID
    'and receiving device notifications. This routines are not specific to HIDs.
    'Debugging.vb - contains a routine for displaying API error messages.

    'HidDeclarations.vb - Declarations for API functions used by Hid.vb.
    'FileIODeclarations.vb - Declarations for file-related API functions.
    'DeviceManagementDeclarations.vb - Declarations for API functions used by DeviceManagement.vb.
    'DebuggingDeclarations.vb - Declarations for API functions used by Debugging.vb.

    'Companion device firmware for several device CPUs is available from www.Lvr.com/hidpage.htm.
    'You can use any generic HID (not a system mouse or keyboard) that sends and receives reports.

    'New in version 2.3:
    'In the asychronous ReadFiles, the GetInputReportData callback routine uses marshaling to 
    'perform actions on the form, which runs in a different thread. 
    'The marshaling is required by the .NET Framework 2.0. 
    'I also fixed a few other things that the compiler complained about.

    'New in version 2.2:
    'The application obtains separate handles for device information/Feature reports,
    'Input reports, and Output reports. This enables getting information about
    'mice and keyboards.
    'The application detects if the device is a mouse or keyboard
    'and warns that Windows 2000/XP will not allow exchanging Input or Output reports.
    'The list box's contents are trimmed when they get too large. 

    'For more information about HIDs and USB, and additional example device firmware to use
    'with this application, visit Lakeview Research at http://www.Lvr.com .

    'Send comments, bug reports, etc. to [e-mail] .

    'This application has been tested under Windows 98SE, Windows 2000, and Windows XP.

    Dim DeviceNotificationHandle As IntPtr
    Dim ExclusiveAccess As Boolean
    Dim HIDHandle As Integer
    Dim HIDUsage As String
    Dim MyDeviceDetected As Boolean
    Dim MyDevicePathName As String
    Dim MyHID As New Hid()
    Dim ReadHandle As Integer
    Dim WriteHandle As Integer

    'Dim InputReportBuffer As Byte()

    'Used only in viewing results of API calls in debug.write statements:


    Dim MyDeviceManagement As New DeviceManagement()

    Friend frmMy As frmMain

    'Define a class of delegates that point to the Hid.DeviceReport.Read function.
    'This delegate has the same parameters as Hid.DeviceReport.Read.
    'Used for asynchronous reads from the device.

    Private Delegate Sub ReadInputReportDelegate _
        (ByVal readHandle As Integer, _
        ByVal hidHandle As Integer, _
        ByVal writeHandle As Integer, _
        ByRef myDeviceDetected As Boolean, _
        ByRef readBuffer() As Byte, _
        ByRef success As Boolean)

    'This delegate has the same parameters as AccessForm.
    'Used in accessing the application's form from a different thread.

    Private Delegate Sub MarshalToForm _
        (ByVal action As String, _
        ByVal textToAdd As String)


    Friend Sub OnDeviceChange(ByVal m As Message)

        'Purpose    : Called when a WM_DEVICECHANGE message has arrived,
        '           : indicating that a device has been attached or removed.

        'Accepts    : m - a message with information about the device



        Try
            If (m.WParam.ToInt32 = DBT_DEVICEARRIVAL) Then

                'If WParam contains DBT_DEVICEARRIVAL, a device has been attached.


                'Find out if it's the device we're communicating with.


            ElseIf (m.WParam.ToInt32 = DBT_DEVICEREMOVECOMPLETE) Then

                'If WParam contains DBT_DEVICEREMOVAL, a device has been removed.

                Debug.WriteLine("A device has been removed.")

                'Find out if it's the device we're communicating with.

                If MyDeviceManagement.DeviceNameMatch(m, MyDevicePathName) Then

                    'Set MyDeviceDetected False so on the next data-transfer attempt,
                    'FindTheHid() will be called to look for the device 
                    'and get a new handle.

                    frmMy.MyDeviceDetected = False
                End If
            End If

            Call ScrollToBottomOfListBox()

        Catch ex As Exception
            Call HandleException(Me.Name, ex)
        End Try
    End Sub


    Private Function FindTheHid() As Boolean

        'Purpose    : Uses a series of API calls to locate a HID-class device
        '           ; by its Vendor ID and Product ID.

        'Returns    : True if the device is detected, False if not detected.

        Dim DeviceFound As Boolean
        Dim DevicePathName(127) As String
        Dim GUIDString As String
        Dim HidGuid As System.Guid
        Dim LastDevice As Boolean
        Dim MemberIndex As Integer
        Dim MyProductID As Short
        Dim MyVendorID As Short
        Dim Result As Boolean
        Dim Security As SECURITY_ATTRIBUTES
        Dim Success As Boolean

        'Try

        HidGuid = Guid.Empty
        LastDevice = False
        MyDeviceDetected = False

        'Values for the SECURITY_ATTRIBUTES structure:

        Security.lpSecurityDescriptor = 0
        Security.bInheritHandle = CInt(True)
        Security.nLength = Len(Security)

        GetVendorAndProductIDsFromTextBoxes(MyVendorID, MyProductID)

        HidD_GetHidGuid(HidGuid)

        GUIDString = HidGuid.ToString

        DeviceFound = MyDeviceManagement.FindDeviceFromGuid(HidGuid, DevicePathName)

        If DeviceFound = True Then
            MemberIndex = 0
            Do

                HIDHandle = CreateFile(DevicePathName(MemberIndex), 0, FILE_SHARE_READ Or FILE_SHARE_WRITE, Security, OPEN_EXISTING, 0, 0)

                If (HIDHandle <> INVALID_HANDLE_VALUE) Then

                    MyHID.DeviceAttributes.Size = Marshal.SizeOf(MyHID.DeviceAttributes)
                    Result = HidD_GetAttributes(HIDHandle, MyHID.DeviceAttributes)

                    If Result Then
                        If (MyHID.DeviceAttributes.VendorID = MyVendorID) And (MyHID.DeviceAttributes.ProductID = MyProductID) Then
                            Call ScrollToBottomOfListBox()
                            MyDeviceDetected = True
                            MyDevicePathName = DevicePathName(MemberIndex)
                        Else
                            MyDeviceDetected = False
                            Result = CloseHandle(HIDHandle)
                        End If
                    Else
                        MyDeviceDetected = False
                        Result = CloseHandle(HIDHandle)
                    End If

                End If


                'Keep looking until we find the device or there are no more left to examine.

                MemberIndex = MemberIndex + 1

            Loop Until ((MyDeviceDetected = True) Or (MemberIndex = UBound(DevicePathName) + 1))
        End If

        If MyDeviceDetected Then

            'The device was detected.
            'Register to receive notifications if the device is removed or attached.

            Success = MyDeviceManagement.RegisterForDeviceNotifications(MyDevicePathName, frmMy.Handle, HidGuid, DeviceNotificationHandle)

            'Learn the capabilities of the device.

            MyHID.Capabilities = MyHID.GetDeviceCapabilities(HIDHandle)

            If Success Then

                'Find out if the device is a system mouse or keyboard.

                HIDUsage = MyHID.GetHIDUsage(MyHID.Capabilities)

                'Get and display the Input report buffer size.

                GetInputReportBufferSize()
                cmdInputReportBufferSize.Enabled = True

                'Get handles to use in requesting Input and Output reports.

                ReadHandle = CreateFile(MyDevicePathName, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, Security, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0)


                If (ReadHandle = INVALID_HANDLE_VALUE) Then

                    ExclusiveAccess = True

                    Call ScrollToBottomOfListBox()

                Else

                    WriteHandle = CreateFile(MyDevicePathName, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, Security, OPEN_EXISTING, 0, 0)

                    MyHID.FlushQueue(ReadHandle)

                End If

            End If

        Else

            'The device wasn't detected.

            cmdInputReportBufferSize.Enabled = False
            cmdOnce.Enabled = True

            Call ScrollToBottomOfListBox()
        End If
        Return MyDeviceDetected

        'Catch ex As Exception
        '    Call HandleException(Me.Name, ex)
        'End Try
    End Function


    Private Sub AccessForm(ByVal action As String, ByVal formText As String)

        'Purpose    : In asynchronous ReadFiles, the callback function GetInputReportData  
        '           : uses this routine to access the application's Form, which runs in 
        '           : a different thread.
        '           : The routine performs various application-specific functions that
        '           : involve accessing the application's form.

        'Accepts    : action - a string that names the action to perform on the form
        '           : formText - text that the form displays or the code uses for 
        '           : another purpose. Actions that don't use text ignore this parameter.  

        Try

            ' Select an action to perform on the form:

            Select Case action


                Case "EnableCmdOnce"

                    cmdOnce.Enabled = True


                Case Else

            End Select

        Catch ex As Exception
            Call HandleException(Me.Name, ex)
        End Try

    End Sub


    Private Sub cmdContinuous_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdContinuous.Click

        ''Start or stop a series of periodic transfers.

        'If cmdContinuous.Text = "Continuous" Then
        '    cmdContinuous.Text = "Cancel Continuous"
        '    tmrContinuousDataCollect.Enabled = True