rs232.txt

VS2005

                    Dim sParity As String = "NOEM"
                    sParity = sParity.Substring(meParity, 1)
                    ' 设置 DCB 状态
                    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
                    ' 设置缓冲区 (Rx,Tx)
                    iRc = SetupComm(mhRS, miBufferSize, miBufferSize)
                    ' 设置超时
                    pSetTimeout()
                Else
                    ' 引发初始化问题
                    Throw New CIOChannelException( _
                        "Unable to open COM" & miPort.ToString)
                End If
            Catch Ex As Exception
                ' 一般错误
                Throw New CIOChannelException(Ex.Message, Ex)
            End Try
        Else
            ' 端口未定义，无法打开
            Throw New ApplicationException("COM Port not defined, " + _
                "use Port property to set it before invoking InitPort")
        End If
    End Sub

    ' 此子例程打开并初始化 Comm 端口（重载以
    ' 支持参数）。
    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

    ' 此函数将 API 错误代码转换为文本。
    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

    ' 此子例程处理重叠的读取。
    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
            ' 无法创建事件
            Throw New ApplicationException( _
                "Error creating event for overlapped read.")
        Else
            ' 重叠的读取
            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
                        ' 设置标志
                        mbWaitOnRead = True
                    End If
                Else
                    ' 成功完成读取
                    RaiseEvent DataReceived(Me, mabtRxBuf)
                End If
            End If
        End If
        ' 等待操作完成
        If mbWaitOnRead Then
            iRes = WaitForSingleObject(muOverlapped.hEvent, miTimeout)
            Select Case iRes
                Case WAIT_OBJECT_0
                    ' 向对象发出了信号，操作完成
                    If GetOverlappedResult(mhRS, muOverlapped, _
                        iReadChars, 0) = 0 Then

                        ' 操作错误
                        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
                        ' 操作完成
                        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

    ' 此子例程处理重叠的写入。
    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
            ' 无法创建事件
            Throw New ApplicationException( _
                "Error creating event for overlapped write.")
        Else
            ' 重叠的写入
            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
                    ' 写入被挂起
                    iRes = WaitForSingleObject(muOverlappedW.hEvent, INFINITE)
                    Select Case iRes
                        Case WAIT_OBJECT_0
                            ' 向对象发出了信号，操作完成
                            If GetOverlappedResult(mhRS, muOverlappedW, _
                                iBytesWritten, 0) = 0 Then

                                bErr = True
                            Else
                                ' 通知 Async tx 完成，停止线程
                                mbWaitOnRead = False
                                RaiseEvent TxCompleted(Me)
                            End If
                    End Select
                End If
            Else
                ' 等待操作立即完成
                bErr = False
            End If
        End If
        CloseHandle(muOverlappedW.hEvent)
        Return bErr
    End Function

    ' 此子例程设置 Comm 端口超时。
    Private Sub pSetTimeout()
        Dim uCtm As COMMTIMEOUTS
        ' 设置 ComTimeout
        If mhRS = -1 Then
            Exit Sub
        Else
            ' 动态更改安装
            With uCtm
                .ReadIntervalTimeout = 0
                .ReadTotalTimeoutMultiplier = 0
                .ReadTotalTimeoutConstant = miTimeout
                .WriteTotalTimeoutMultiplier = 10
                .WriteTotalTimeoutConstant = 100
            End With
            SetCommTimeouts(mhRS, uCtm)
        End If
    End Sub

    ' 此函数返回指定从 Comm 端口读取的字节数 
    ' 的整数。它接收指定想要读取的字节数的
    ' 参数。
    Public Function Read(ByVal Bytes2Read As Integer) As Integer
        Dim iReadChars, iRc As Integer

        ' 如果未指定 Bytes2Read，则使用 Buffersize
        If Bytes2Read = 0 Then Bytes2Read = miBufferSize
        If mhRS = -1 Then
            Throw New ApplicationException( _
                "Please initialize and open port before using this method")
        Else
            ' 从端口获取字节
            Try
                ' 清除缓冲区
                'PurgeComm(mhRS, PURGE_RXCLEAR Or PURGE_TXCLEAR)
                ' 为重叠的操作创建一个事件
                If meMode = Mode.Overlapped Then
                    pHandleOverlappedRead(Bytes2Read)
                Else
                    ' 非重叠模式
                    ReDim mabtRxBuf(Bytes2Read - 1)
                    iRc = ReadFile(mhRS, mabtRxBuf, Bytes2Read, iReadChars, Nothing)
                    If iRc = 0 Then
                        ' 读取错误
                        Throw New ApplicationException( _
                            "ReadFile error " & iRc.ToString)
                    Else
                        ' 处理超时或返回输入字符
                        If iReadChars < Bytes2Read Then
                            Exit Try '返回输入字符小于规定时 退出 
                            Throw New IOTimeoutException("Timeout error")
                        Else
                            mbWaitOnRead = True
                            Return (iReadChars)
                        End If
                    End If
                End If
            Catch Ex As Exception
                ' 其他一般错误
                Throw New ApplicationException("Read Error: " & Ex.Message, Ex)
            End Try
        End If
    End Function

    ' 此子例程将传入的字节数组写入到
    ' 要进行写入的 Comm 端口中。
    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
            ' 将数据传输到 COM 端口
            Try
                If meMode = Mode.Overlapped Then
                    ' 重叠的写入
                    If pHandleOverlappedWrite(Buffer) Then
                        Throw New ApplicationException( _
                            "Error in overllapped write")
                    End If
                Else
                    ' 清除 IO 缓冲区
                    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

    ' 此子例程将传入的字符串写入到
    ' 要进行写入的 Comm 端口中。
    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