rs232.vb

VB.Net串口通讯的实例

                    iRc = GetCommState(mhRS, uDcb)
                    ' Updates COM Settings
                    Dim sParity As String = "NOEM"
                    sParity = sParity.Substring(meParity, 1)
                    ' Set DCB State
                    Dim sDCBState As String = String.Format( _
                        "baud={0} parity={1} data={2} stop={3}", _
                        miBaudRate, sParity, miDataBit, CInt(meStopBit))
                    iRc = BuildCommDCB(sDCBState, uDcb)
                    iRc = SetCommState(mhRS, uDcb)
                    If iRc = 0 Then
                        Dim sErrTxt As String = pErr2Text(GetLastError())
                        Throw New CIOChannelException( _
                            "Unable to set COM state0" & sErrTxt)
                    End If
                    ' Setup Buffers (Rx,Tx)
                    iRc = SetupComm(mhRS, miBufferSize, miBufferSize)
                    ' Set Timeouts
                    pSetTimeout()
                Else
                    ' Raise Initialization problems
                    Throw New CIOChannelException( _
                        "Unable to open COM" & miPort.ToString)
                End If
            Catch Ex As Exception
                ' Generica error
                Throw New CIOChannelException(Ex.Message, Ex)
            End Try
        Else
            ' Port not defined, cannot open
            Throw New ApplicationException("COM Port not defined, " + _
                "use Port property to set it before invoking InitPort")
        End If
    End Sub

    ' This subroutine opens and initializes the Comm Port (overloaded
    '   to support parameters).
    Public Overloads Sub Open(ByVal Port As Integer, _
        ByVal BaudRate As Integer, ByVal DataBit As Integer, _
        ByVal Parity As DataParity, ByVal StopBit As DataStopBit, _
        ByVal BufferSize As Integer)

        Me.Port = Port
        Me.BaudRate = BaudRate
        Me.DataBit = DataBit
        Me.Parity = Parity
        Me.StopBit = StopBit
        Me.BufferSize = BufferSize
        Open()
    End Sub

    ' This function translates an API error code to text.
    Private Function pErr2Text(ByVal lCode As Integer) As String
        Dim sRtrnCode As New StringBuilder(256)
        Dim lRet As Integer

        lRet = FormatMessage(&H1000, 0, lCode, 0, sRtrnCode, 256, 0)
        If lRet > 0 Then
            Return sRtrnCode.ToString
        Else
            Return "Error not found."
        End If

    End Function

    ' This subroutine handles overlapped reads.
    Private Sub pHandleOverlappedRead(ByVal Bytes2Read As Integer)
        Dim iReadChars, iRc, iRes, iLastErr As Integer
        muOverlapped.hEvent = CreateEvent(Nothing, 1, 0, Nothing)
        If muOverlapped.hEvent = 0 Then
            ' Can't create event
            Throw New ApplicationException( _
                "Error creating event for overlapped read.")
        Else
            ' Ovellaped reading
            If mbWaitOnRead = False Then
                ReDim mabtRxBuf(Bytes2Read - 1)
                iRc = ReadFile(mhRS, mabtRxBuf, Bytes2Read, _
                    iReadChars, muOverlapped)
                If iRc = 0 Then
                    iLastErr = GetLastError()
                    If iLastErr <> ERROR_IO_PENDING Then
                        Throw New ArgumentException("Overlapped Read Error: " & _
                            pErr2Text(iLastErr))
                    Else
                        ' Set Flag
                        mbWaitOnRead = True
                    End If
                Else
                    ' Read completed successfully
                    RaiseEvent DataReceived(Me, mabtRxBuf)
                End If
            End If
        End If
        ' Wait for operation to be completed
        If mbWaitOnRead Then
            iRes = WaitForSingleObject(muOverlapped.hEvent, miTimeout)
            Select Case iRes
                Case WAIT_OBJECT_0
                    ' Object signaled,operation completed
                    If GetOverlappedResult(mhRS, muOverlapped, _
                        iReadChars, 0) = 0 Then

                        ' Operation error
                        iLastErr = GetLastError()
                        If iLastErr = ERROR_IO_INCOMPLETE Then
                            Throw New ApplicationException( _
                                "Read operation incomplete")
                        Else
                            Throw New ApplicationException( _
                                "Read operation error " & iLastErr.ToString)
                        End If
                    Else
                        ' Operation completed
                        RaiseEvent DataReceived(Me, mabtRxBuf)
                        mbWaitOnRead = False
                    End If
                Case WAIT_TIMEOUT
                    Throw New IOTimeoutException("Timeout error")
                Case Else
                    Throw New ApplicationException("Overlapped read error")
            End Select
        End If
    End Sub

    ' This subroutine handles overlapped writes.
    Private Function pHandleOverlappedWrite(ByVal Buffer() As Byte) As Boolean
        Dim iBytesWritten, iRc, iLastErr, iRes As Integer, bErr As Boolean
        muOverlappedW.hEvent = CreateEvent(Nothing, 1, 0, Nothing)
        If muOverlappedW.hEvent = 0 Then
            ' Can't create event
            Throw New ApplicationException( _
                "Error creating event for overlapped write.")
        Else
            ' Overllaped write
            PurgeComm(mhRS, PURGE_RXCLEAR Or PURGE_TXCLEAR)
            mbWaitOnRead = True
            iRc = WriteFile(mhRS, Buffer, Buffer.Length, _
                iBytesWritten, muOverlappedW)
            If iRc = 0 Then
                iLastErr = GetLastError()
                If iLastErr <> ERROR_IO_PENDING Then
                    Throw New ArgumentException("Overlapped Read Error: " & _
                        pErr2Text(iLastErr))
                Else
                    ' Write is pending
                    iRes = WaitForSingleObject(muOverlappedW.hEvent, INFINITE)
                    Select Case iRes
                        Case WAIT_OBJECT_0
                            ' Object signaled,operation completed
                            If GetOverlappedResult(mhRS, muOverlappedW, _
                                iBytesWritten, 0) = 0 Then

                                bErr = True
                            Else
                                ' Notifies Async tx completion,stops thread
                                mbWaitOnRead = False
                                RaiseEvent TxCompleted(Me)
                            End If
                    End Select
                End If
            Else
                ' Wait operation completed immediatly
                bErr = False
            End If
        End If
        CloseHandle(muOverlappedW.hEvent)
        Return bErr
    End Function

    ' This subroutine sets the Comm Port timeouts.
    Private Sub pSetTimeout()
        Dim uCtm As COMMTIMEOUTS
        ' Set ComTimeout
        If mhRS = -1 Then
            Exit Sub
        Else
            ' Changes setup on the fly
            With uCtm
                .ReadIntervalTimeout = 0
                .ReadTotalTimeoutMultiplier = 0
                .ReadTotalTimeoutConstant = miTimeout
                .WriteTotalTimeoutMultiplier = 10
                .WriteTotalTimeoutConstant = 100
            End With
            SetCommTimeouts(mhRS, uCtm)
        End If
    End Sub

    ' This function returns an integer specifying the number of bytes 
    '   read from the Comm Port. It accepts a parameter specifying the number
    '   of desired bytes to read.
    Public Function Read(ByVal Bytes2Read As Integer) As Integer
        Dim iReadChars, iRc As Integer

        ' If Bytes2Read not specified uses Buffersize
        If Bytes2Read = 0 Then Bytes2Read = miBufferSize
        If mhRS = -1 Then
            Throw New ApplicationException( _
                "Please initialize and open port before using this method")
        Else
            ' Get bytes from port
            Try
                ' Purge buffers
                'PurgeComm(mhRS, PURGE_RXCLEAR Or PURGE_TXCLEAR)
                ' Creates an event for overlapped operations
                If meMode = Mode.Overlapped Then
                    pHandleOverlappedRead(Bytes2Read)
                Else
                    ' Non overlapped mode
                    ReDim mabtRxBuf(Bytes2Read - 1)
                    iRc = ReadFile(mhRS, mabtRxBuf, Bytes2Read, iReadChars, Nothing)
                    If iRc = 0 Then
                        ' Read Error
                        Throw New ApplicationException( _
                            "ReadFile error " & iRc.ToString)
                    Else
                        ' Handles timeout or returns input chars
                        If iReadChars < Bytes2Read Then
                            Throw New IOTimeoutException("Timeout error")
                        Else
                            mbWaitOnRead = True
                            Return (iReadChars)
                        End If
                    End If
                End If
            Catch Ex As Exception
                ' Others generic erroes
                Throw New ApplicationException("Read Error: " & Ex.Message, Ex)
            End Try
        End If
    End Function

    ' This subroutine writes the passed array of bytes to the 
    '   Comm Port to be written.
    Public Overloads Sub Write(ByVal Buffer As Byte())
        Dim iBytesWritten, iRc As Integer

        If mhRS = -1 Then
            Throw New ApplicationException( _
                "Please initialize and open port before using this method")
        Else
            ' Transmit data to COM Port
            Try
                If meMode = Mode.Overlapped Then
                    ' Overlapped write
                    If pHandleOverlappedWrite(Buffer) Then
                        Throw New ApplicationException( _
                            "Error in overllapped write")
                    End If
                Else
                    ' Clears IO buffers
                    PurgeComm(mhRS, PURGE_RXCLEAR Or PURGE_TXCLEAR)
                    iRc = WriteFile(mhRS, Buffer, Buffer.Length, _
                        iBytesWritten, Nothing)
                    If iRc = 0 Then
                        Throw New ApplicationException( _
                            "Write Error - Bytes Written " & _
                            iBytesWritten.ToString & " of " & _
                            Buffer.Length.ToString)
                    End If
                End If
            Catch Ex As Exception
                Throw
            End Try
        End If
    End Sub

    ' This subroutine writes the passed string to the 
    '   Comm Port to be written.
    Public Overloads Sub Write(ByVal Buffer As String)
        Dim oEncoder As New System.Text.ASCIIEncoding()
        Dim aByte() As Byte = oEncoder.GetBytes(Buffer)
        Me.Write(aByte)
    End Sub

#End Region

End Class