form1.vb

VB.net开发的PPC下串口调试程序

Imports System.Runtime.InteropServices

Public Class Form1
    Inherits System.Windows.Forms.Form
    Friend WithEvents TextReceive As System.Windows.Forms.TextBox
    Friend WithEvents TextSend As System.Windows.Forms.TextBox
#Region " Windows 窗体设计器生成的代码 "

    Public Sub New()
        MyBase.New()

        '该调用是 Windows 窗体设计器所必需的。
        InitializeComponent()

        '在 InitializeComponent() 调用之后添加任何初始化

    End Sub

    '窗体重写 dispose 以清理组件列表。
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        MyBase.Dispose(disposing)
    End Sub

    '注意: 以下过程是 Windows 窗体设计器所必需的
    '可以使用 Windows 窗体设计器修改此过程。
    '不要使用代码编辑器修改它。
    Friend WithEvents Label1 As System.Windows.Forms.Label
    Friend WithEvents MainMenu1 As System.Windows.Forms.MainMenu
    Friend WithEvents 操作 As System.Windows.Forms.MenuItem
    Friend WithEvents MenuItem2 As System.Windows.Forms.MenuItem
    Friend WithEvents MenuItem1 As System.Windows.Forms.MenuItem
    Friend WithEvents MenuItem3 As System.Windows.Forms.MenuItem
    Friend WithEvents cmdSend As System.Windows.Forms.Button
    Private Sub InitializeComponent()
        Me.TextReceive = New System.Windows.Forms.TextBox
        Me.TextSend = New System.Windows.Forms.TextBox
        Me.Label1 = New System.Windows.Forms.Label
        Me.MainMenu1 = New System.Windows.Forms.MainMenu
        Me.操作 = New System.Windows.Forms.MenuItem
        Me.MenuItem1 = New System.Windows.Forms.MenuItem
        Me.MenuItem2 = New System.Windows.Forms.MenuItem
        Me.MenuItem3 = New System.Windows.Forms.MenuItem
        Me.cmdSend = New System.Windows.Forms.Button
        '
        'TextReceive
        '
        Me.TextReceive.Location = New System.Drawing.Point(16, 17)
        Me.TextReceive.Multiline = True
        Me.TextReceive.ScrollBars = System.Windows.Forms.ScrollBars.Vertical
        Me.TextReceive.Size = New System.Drawing.Size(208, 152)
        Me.TextReceive.Text = ""
        '
        'TextSend
        '
        Me.TextSend.Location = New System.Drawing.Point(16, 184)
        Me.TextSend.Size = New System.Drawing.Size(208, 21)
        Me.TextSend.Text = ""
        '
        'Label1
        '
        Me.Label1.Location = New System.Drawing.Point(16, 0)
        Me.Label1.Size = New System.Drawing.Size(64, 16)
        Me.Label1.Text = "接收区"
        '
        'MainMenu1
        '
        Me.MainMenu1.MenuItems.Add(Me.操作)
        '
        '操作
        '
        Me.操作.MenuItems.Add(Me.MenuItem1)
        Me.操作.MenuItems.Add(Me.MenuItem2)
        Me.操作.MenuItems.Add(Me.MenuItem3)
        Me.操作.Text = "操作"
        '
        'MenuItem1
        '
        Me.MenuItem1.Text = "打开串口"
        '
        'MenuItem2
        '
        Me.MenuItem2.Text = "关闭串口"
        '
        'MenuItem3
        '
        Me.MenuItem3.Text = "退出"
        '
        'cmdSend
        '
        Me.cmdSend.Location = New System.Drawing.Point(168, 216)
        Me.cmdSend.Size = New System.Drawing.Size(56, 24)
        Me.cmdSend.Text = "发送"
        '
        'Form1
        '
        Me.Controls.Add(Me.cmdSend)
        Me.Controls.Add(Me.Label1)
        Me.Controls.Add(Me.TextSend)
        Me.Controls.Add(Me.TextReceive)
        Me.Menu = Me.MainMenu1
        Me.Text = "VB.NET串口调试"

    End Sub

#End Region
    Public Class dcb
        Friend DCBlength As UInt32
        Friend BaudRate As UInt32
        Friend fBinary As UInt32
        Friend fParity As UInt32
        Friend fOutxCtsFlow As UInt32
        Friend fOutxDsrFlow As UInt32
        Friend fDtrControl As UInt32
        Friend fDsrSensitivity As UInt32
        Friend fTXContinueOnXoff As UInt32
        Friend fOutX As UInt32
        Friend fInX As UInt32
        Friend fErrorChar As UInt32
        Friend fNull As UInt32
        Friend fRtsControl As UInt32
        Friend fAbortOnError As UInt32
        Friend fDummy2 As UInt32
        Friend wReserved As UInt32
        Friend XonLim As UInt32
        Friend XoffLim As UInt32
        Friend ByteSize As Byte
        Friend Parity As Byte
        Friend StopBits As Byte
        Friend XonChar As Char
        Friend XoffChar As Char
        Friend ErrorChar As Char
        Friend EofChar As Char
        Friend EvtChar As Char
        Friend wReserved1 As UInt16
    End Class

    <DllImport("coredll.dll")> _
    Private Shared Function CreateFile _
    (ByVal lpFileName As String, _
     ByVal dwDesiredAccess As Integer, _
     ByVal dwShareMode As Integer, _
     ByVal lpSecurityAttributes As Integer, _
     ByVal dwCreationDisposition As Integer, _
     ByVal dwFlagAndAttributes As Integer, _
     ByVal hTemplateFile As Integer) As Integer
    End Function

    <DllImport("coredll.dll")> _
    Private Shared Function GetCommState _
    (ByVal hFile As Integer, _
     ByVal mdcb As dcb) As Integer
    End Function

    <DllImport("coredll.dll")> _
    Private Shared Function SetCommState _
    (ByVal hFile As Integer, _
     ByVal mdcb As dcb) As Integer
    End Function

    <DllImport("coredll.dll")> _
    Private Shared Function ReadFile _
    (ByVal hFile As Integer, _
     ByVal Buffer() As Byte, _
     ByVal nNumberOfBytesToRead As Integer, _
     ByRef lpNumberOfBytesRead As Integer, _
     ByRef lpOverlapped As Integer) As Integer
    End Function

    <DllImport("coredll.dll")> _
    Private Shared Function WriteFile _
    (ByVal hFile As Integer, _
     ByVal Buffer() As Byte, _
     ByVal nNumberOfBytesToWrite As Integer, _
     ByRef lpNumberOfBytesWritten As Integer, _
     ByVal lpOverlapped As Integer) As Boolean
    End Function

    <DllImport("coredll.dll")> _
    Private Shared Function CloseHandle _
    (ByVal hObject As Integer) As Integer
    End Function

    Dim inoutfileHandler As Long
    Dim numReadWrite As Integer
    Dim t1 As System.Threading.Thread
    Dim stopThread As Boolean = False

    Dim pdcb As dcb

    Public Sub openPort()
        Dim ioPort As Short = 1
        inoutfileHandler = CreateFile _
        ("COM" & ioPort & ":", _
         &HC0000000, 0, 0, 3, 0, 0)
        pdcb = New dcb
        '设置波特率
        GetCommState(inoutfileHandler, pdcb)
        pdcb.BaudRate.Parse("115200")
        SetCommState(inoutfileHandler, pdcb)

        stopThread = False
        t1 = New Threading.Thread _
        (AddressOf receiveLoop)
        t1.Start()
    End Sub

    Public Function send(ByVal message As String) _
    As Integer
        Dim value As String = message & vbCrLf
        Dim retCode As Integer = WriteFile _
        (inoutfileHandler, _
         stringToByteArray(value), _
         value.Length(), _
         numReadWrite, _
         0)
        Return retCode
    End Function

    Public Sub closePort()
        stopThread = True
        CloseHandle(inoutfileHandler)
    End Sub

    Public Sub receiveLoop()
        Dim inbuff(300) As Byte
        Dim retCode As Integer = ReadFile _
        (inoutfileHandler, _
         inbuff, _
         inbuff.Length, _
         numReadWrite, _
         0)
        Application.DoEvents()
        While True
            If retCode = 0 Or stopThread Then
                Exit While
            Else
                Dim updateDelegate As New _
                 myDelegate _
                 (AddressOf displayReceivedMessage)

                updateDelegate.Invoke _
                (byteArrayToString(inbuff))
                ReDim inbuff(300)
                retCode = ReadFile(inoutfileHandler, inbuff, inbuff.Length, numReadWrite, 0)
                Application.DoEvents()
            End If
        End While
    End Sub

    Public Delegate Sub myDelegate(ByVal str As String)

    Public Function stringToByteArray _
    (ByVal str As String) As Byte()
        Dim s As Char()
        s = str.ToCharArray
        Dim b(s.Length - 1) As Byte
        Dim i As Integer
        For i = 0 To s.Length - 1
            b(i) = Convert.ToByte(s(i))
        Next
        Return b
    End Function

    Function byteArrayToString _
    (ByVal b() As Byte) As String
        Dim str As String
        Dim enc As System.Text.ASCIIEncoding
        enc = New System.Text.ASCIIEncoding
        str = enc.GetString(b, 0, b.Length())
        Return str
    End Function

    Public Sub displayReceivedMessage(ByVal str As String)
        If str.Length > 0 Then
            TextReceive.Text += str
        End If
    End Sub

    Private Sub MenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem1.Click
        openPort()
        MenuItem1.Enabled = False
        MenuItem2.Enabled = True
    End Sub

    Private Sub MenuItem2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem2.Click
        closePort()
        MenuItem1.Enabled = True
        MenuItem2.Enabled = False
    End Sub

    Private Sub MenuItem3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem3.Click
        Me.Close()
    End Sub


    Private Sub cmdSend_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdSend.Click
        If send(TextSend.Text) = 0 Then
            MsgBox("发送数据出错！")
        End If
    End Sub
End Class