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

📄 d2xxaccess.vb

📁 free sources for gsm
💻 VB
字号:
Imports System.Threading
Imports System.Text
Public Class D2XXAccess

    Inherits System.Windows.Forms.Form
    Friend WithEvents radDescription As System.Windows.Forms.RadioButton

#Region " Windows Form Designer generated code "

    Public Sub New()

        MyBase.New()

        'This call is required by the Windows Form Designer.
        InitializeComponent()

        'Add any initialization after the InitializeComponent() call

    End Sub

    Protected dwListDescFlags As Integer
    Protected m_hPort As Integer
    Protected pThreadRead As Thread
    Protected pThreadWrite As Thread
    Protected fContinue As Boolean

    'Form overrides dispose to clean up the component list.
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        MyBase.Dispose(disposing)
    End Sub

    'NOTE: The following procedure is required by the Windows Form Designer
    'It can be modified using the Windows Form Designer.  
    'Do not modify it using the code editor.
    Friend WithEvents radSerial As System.Windows.Forms.RadioButton
    Friend WithEvents radNumber As System.Windows.Forms.RadioButton
    Friend WithEvents cmbDevList As System.Windows.Forms.ComboBox
    Friend WithEvents btnOpen As System.Windows.Forms.Button
    Friend WithEvents btnClose As System.Windows.Forms.Button
    Friend WithEvents btnWrite As System.Windows.Forms.Button
    Friend WithEvents tbNumBytes As System.Windows.Forms.TextBox
    Friend WithEvents Bytes As System.Windows.Forms.Label
    Friend WithEvents Label1 As System.Windows.Forms.Label
    Friend WithEvents lbDataBytes As System.Windows.Forms.ListBox
    Private Sub InitializeComponent()
        Me.radDescription = New System.Windows.Forms.RadioButton
        Me.radSerial = New System.Windows.Forms.RadioButton
        Me.radNumber = New System.Windows.Forms.RadioButton
        Me.cmbDevList = New System.Windows.Forms.ComboBox
        Me.btnOpen = New System.Windows.Forms.Button
        Me.btnClose = New System.Windows.Forms.Button
        Me.lbDataBytes = New System.Windows.Forms.ListBox
        Me.btnWrite = New System.Windows.Forms.Button
        Me.tbNumBytes = New System.Windows.Forms.TextBox
        Me.Bytes = New System.Windows.Forms.Label
        Me.Label1 = New System.Windows.Forms.Label
        '
        'radDescription
        '
        Me.radDescription.Location = New System.Drawing.Point(6, 2)
        Me.radDescription.Size = New System.Drawing.Size(79, 14)
        Me.radDescription.Text = "Description"
        '
        'radSerial
        '
        Me.radSerial.Location = New System.Drawing.Point(90, 3)
        Me.radSerial.Size = New System.Drawing.Size(51, 13)
        Me.radSerial.Text = "Serial"
        '
        'radNumber
        '
        Me.radNumber.Location = New System.Drawing.Point(143, 2)
        Me.radNumber.Size = New System.Drawing.Size(67, 15)
        Me.radNumber.Text = "Number"
        '
        'cmbDevList
        '
        Me.cmbDevList.Location = New System.Drawing.Point(6, 24)
        Me.cmbDevList.Size = New System.Drawing.Size(127, 21)
        '
        'btnOpen
        '
        Me.btnOpen.Location = New System.Drawing.Point(149, 27)
        Me.btnOpen.Size = New System.Drawing.Size(52, 18)
        Me.btnOpen.Text = "Open"
        '
        'btnClose
        '
        Me.btnClose.Location = New System.Drawing.Point(149, 46)
        Me.btnClose.Size = New System.Drawing.Size(52, 18)
        Me.btnClose.Text = "Close"
        '
        'lbDataBytes
        '
        Me.lbDataBytes.Location = New System.Drawing.Point(6, 81)
        Me.lbDataBytes.Size = New System.Drawing.Size(87, 132)
        '
        'btnWrite
        '
        Me.btnWrite.Location = New System.Drawing.Point(7, 55)
        Me.btnWrite.Size = New System.Drawing.Size(52, 18)
        Me.btnWrite.Text = "Write"
        '
        'tbNumBytes
        '
        Me.tbNumBytes.Location = New System.Drawing.Point(66, 55)
        Me.tbNumBytes.Size = New System.Drawing.Size(32, 20)
        Me.tbNumBytes.Text = "255"
        '
        'Bytes
        '
        Me.Bytes.Location = New System.Drawing.Point(104, 58)
        Me.Bytes.Size = New System.Drawing.Size(34, 20)
        Me.Bytes.Text = "Bytes"
        '
        'Label1
        '
        Me.Label1.Font = New System.Drawing.Font("Microsoft Sans Serif", 8.0!, System.Drawing.FontStyle.Regular)
        Me.Label1.Location = New System.Drawing.Point(106, 85)
        Me.Label1.Size = New System.Drawing.Size(97, 93)
        Me.Label1.Text = "Use Loopback Serial Cable to test application. Write upto 256 rolling count bytes" & _
        " to port and display results in List."
        '
        'D2XXAccess
        '
        Me.ClientSize = New System.Drawing.Size(215, 221)
        Me.Controls.Add(Me.Label1)
        Me.Controls.Add(Me.Bytes)
        Me.Controls.Add(Me.tbNumBytes)
        Me.Controls.Add(Me.btnWrite)
        Me.Controls.Add(Me.lbDataBytes)
        Me.Controls.Add(Me.btnClose)
        Me.Controls.Add(Me.btnOpen)
        Me.Controls.Add(Me.cmbDevList)
        Me.Controls.Add(Me.radNumber)
        Me.Controls.Add(Me.radSerial)
        Me.Controls.Add(Me.radDescription)
        Me.Text = "D2XXAccess"

    End Sub

    Public Shared Sub Main()
        Application.Run(New D2XXAccess)
    End Sub

#End Region

    Private Sub ReadThread()
        Dim cBuf(1) As Byte
        Dim dwRet As Long
        Dim ftStatus As FT_STATUS

        While fContinue = True
            If m_hPort = 0 Then
                Exit Sub
            End If
            ftStatus = FT_Read(m_hPort, cBuf, 1, dwRet)

            If dwRet = 1 Then
                lbDataBytes.Items.Add(BitConverter.ToString(cBuf, 0, 1))
            End If
        End While

    End Sub

    Private Sub btnOpen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnOpen.Click
        Dim dwOpenFlag As Integer
        Dim iCurrentIndex As Integer
        Dim ftStatus As FT_STATUS

        If Not m_hPort Then
            dwOpenFlag = dwListDescFlags And Not FT_LIST_BY_INDEX
            dwOpenFlag = dwListDescFlags And Not FT_LIST_ALL

            If dwOpenFlag = 0 Then
                iCurrentIndex = cmbDevList.SelectedIndex()
                ftStatus = FT_Open(iCurrentIndex, m_hPort)
            Else
                Dim ascii As New ASCIIEncoding
                ftStatus = FT_OpenEx(ascii.GetBytes(cmbDevList.Text), dwOpenFlag, m_hPort)
            End If

            If ftStatus = D2XX_mod.FT_STATUS.FT_OK Then
                ' Set up the port
                FT_SetBaudRate(m_hPort, 9600)
                FT_Purge(m_hPort, D2XX_mod.FT_PURGE_.FT_PURGE_RX Or D2XX_mod.FT_PURGE_.FT_PURGE_TX)
                FT_SetTimeouts(m_hPort, 3000, 3000)
                ' Start up the read and write thread
                fContinue = True
                pThreadRead = New Thread(AddressOf ReadThread)
                pThreadRead.Start()
                ' Enable buttons that can be pressed
                btnClose.Enabled = True
                btnOpen.Enabled = False
                btnWrite.Enabled = True
                radDescription.Enabled = False
                radSerial.Enabled = False
                radNumber.Enabled = False
            Else
                MsgBox("Failed To Open Port")
            End If

        End If
    End Sub

    Private Function ListUnopenDevices() As Boolean
        Dim ftStatus As FT_STATUS
        Dim numDevs As Integer = 0
        Dim i As Integer
        Dim cBuf(64) As Byte
        Dim iCurrentIndex As Integer

        iCurrentIndex = cmbDevList.SelectedIndex()
        cmbDevList.Items.Clear()

        ftStatus = FT_ListDevices(numDevs, 0, FT_LIST_NUMBER_ONLY)
        If ftStatus = D2XX_mod.FT_STATUS.FT_OK Then
            If dwListDescFlags = FT_LIST_ALL Then
                For i = 0 To numDevs - 1
                    cmbDevList.Items.Add(i)
                Next
            Else
                For i = 0 To numDevs - 1
                    ftStatus = FT_ListDevices(i, cBuf, dwListDescFlags)
                    If ftStatus = D2XX_mod.FT_STATUS.FT_OK Then
                        Dim ascii As New ASCIIEncoding
                        Dim str As String

                        str = ascii.GetString(cBuf, 0, cBuf.Length)
                        cmbDevList.Items.Add(str)
                    Else
                        MsgBox("Error list devs " + Convert.ToString(ftStatus))
                        ListUnopenDevices = False
                        Exit Function
                    End If
                Next
            End If
            ListUnopenDevices = True
        Else
            ListUnopenDevices = False
        End If

        cmbDevList.SelectedIndex = iCurrentIndex

    End Function

    Private Sub D2XXAccess_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        m_hPort = 0
        fContinue = False
        dwListDescFlags = FT_LIST_ALL
        radNumber.Checked = True
        btnClose.Enabled = False
        btnOpen.Enabled = True
        btnWrite.Enabled = False
        radDescription.Enabled = True
        radSerial.Enabled = True
        radNumber.Enabled = True
        If ListUnopenDevices() = False Then
            MsgBox("Error Listing Devices")
        End If
    End Sub

    Private Sub radSerial_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles radSerial.CheckedChanged
        dwListDescFlags = FT_LIST_BY_INDEX Or FT_OPEN_BY_SERIAL_NUMBER
        If ListUnopenDevices() = False Then
            MsgBox("Error Listing Devices")
        End If
    End Sub

    Private Sub radDescription_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles radDescription.CheckedChanged
        dwListDescFlags = FT_LIST_BY_INDEX Or FT_OPEN_BY_DESCRIPTION
        If ListUnopenDevices() = False Then
            MsgBox("Error Listing Devices")
        End If
    End Sub

    Private Sub radNumber_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles radNumber.CheckedChanged
        dwListDescFlags = FT_LIST_ALL
        If ListUnopenDevices() = False Then
            MsgBox("Error Listing Devices")
        End If
    End Sub

    Private Sub btnWrite_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnWrite.Click
        Dim dwRet As Long
        Dim ftStatus As FT_STATUS
        Dim i As Integer
        Dim cBuf(255) As Byte

        lbDataBytes.Items.Clear()

        For i = 0 To cBuf.GetUpperBound(0)
            cBuf(i) = i
        Next

        i = tbNumBytes.Text
        ftStatus = FT_Write(m_hPort, cBuf, i + 1, dwRet)
        If ftStatus <> D2XX_mod.FT_STATUS.FT_OK Then
            MsgBox("Failed To Write")
        End If
    End Sub

    Private Sub btnClose_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnClose.Click
        If m_hPort Then
            fContinue = False
            ' it will stop in 3 seconds - not sure if this is proper
            pThreadRead.CurrentThread().Sleep(3000)
            FT_Close(m_hPort)
            m_hPort = 0
        End If
        radNumber.Checked = True
        btnClose.Enabled = False
        btnOpen.Enabled = True
        btnWrite.Enabled = False
        radDescription.Enabled = True
        radSerial.Enabled = True
        radNumber.Enabled = True
    End Sub
End Class

⌨️ 快捷键说明

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