comm.vb

用VB.NET2003编写的基于WINDOWS API 函数的PDA串行通讯子程序库

            If (mintHandle <> INVALID_HANDLE_VALUE) Then
                ReDim mbytRxBuffer(BytesToRead - 1)
                intResult = ReadFile(mintHandle, mbytRxBuffer, BytesToRead, lpNumberOfBytesRead, Nothing)
                If (intResult = 0) Then
                    mintHandle = INVALID_HANDLE_VALUE
                    Throw New ArgumentException("Error reading COM" + mintPort.ToString() + ":")
                End If
                Return lpNumberOfBytesRead
            End If
        Catch Ex As Exception
            ' Others generic erroes
            Throw New ApplicationException("Read Error: " & Ex.Message, Ex)
        End Try

    End Function
    Public WriteOnly Property Dtr(ByVal mhRS As Integer) As Boolean
        Set(ByVal Value As Boolean)
            If Not mhRS = -1 Then
                If Value Then
                    EscapeCommFunction(mhRS, Lines.SetDtr)
                Else
                    EscapeCommFunction(mhRS, Lines.ClearDtr)
                End If
            End If
        End Set
    End Property
    Public WriteOnly Property Rts(ByVal mhRS As Integer) As Boolean
        Set(ByVal Value As Boolean)
            If Not mhRS = -1 Then
                If Value Then
                    EscapeCommFunction(mhRS, Lines.SetRts)
                Else
                    EscapeCommFunction(mhRS, Lines.ClearRts)
                End If
            End If
        End Set
    End Property

    Public Sub Comm(ByVal port As Integer, ByVal baudrate As Integer, ByVal parity As String, ByVal databits As Integer, ByVal stopbits As Integer)
        On Error GoTo Exitsub
        mintPort = port
        mintBaudRate = baudrate
        Select Case parity
            Case "E"
                mbytParity = EVENPARITY
            Case "M"
                mbytParity = MARKPARITY
            Case "O"
                mbytParity = ODDPARITY
            Case "S"
                mbytParity = SPACEPARITY
            Case Else
                mbytParity = NOPARITY
        End Select

        Select Case databits
            Case 5
                mbytDataBits = DATABITS_5
            Case 6
                mbytDataBits = DATABITS_6
            Case 7
                mbytDataBits = DATABITS_7
            Case Else
                mbytDataBits = DATABITS_8
        End Select

        Select Case stopbits
            Case 2
                mbytStopBits = STOPBITS_15
            Case 3
                mbytStopBits = STOPBITS_20
            Case Else
                mbytStopBits = STOPBITS_10
        End Select
Exits:
        Exit Sub
Exitsub:
        If (Err.Number <> 0) And Err.Number <> 32755 Then
            MsgBox(Err.Description)
        End If
        If (Err.Number <> 0) Then
            ComStop = True
            Resume Exits
        End If
    End Sub

    Public Sub Output(ByVal mintHandle As Integer, ByVal Value As Byte())
        On Error GoTo Exitsub
        Dim intResult As Integer
        Dim lpNumberOfBytesWritten As Integer = 0
        Dim lpOverlapped As OVERLAPPED = New OVERLAPPED
        lpOverlapped = Nothing
        If (mintHandle <> INVALID_HANDLE_VALUE) Then

            mbytTxBuffer = Value
            intResult = WriteFile(mintHandle, mbytTxBuffer, mbytTxBuffer.Length, lpNumberOfBytesWritten, lpOverlapped)

        End If
Exits:
        Exit Sub
Exitsub:
        If (Err.Number <> 0) And Err.Number <> 32755 Then
            MsgBox(Err.Description)
        End If
        If (Err.Number <> 0) Then
            ComStop = True
            Resume Exits
        End If
    End Sub
    Public Function Open(ByVal Port As Integer, _
        ByVal BaudRate As Integer, ByVal Parity As Byte, ByVal DataBit As Byte, ByVal StopBit As Byte, ByVal BufferSize As Integer, ByVal timeout As Integer) As Integer
        ' Get Dcb block,Update with current data
        Dim intHandle As Integer = INVALID_HANDLE_VALUE
        Dim uDcb As DCB, iRc As Integer
        Me.Port = Port
        Me.BaudRate = BaudRate
        Me.DataBit = DataBit
        Me.Parity = Parity
        Me.StopBit = StopBit
        ' Initializes Com Port
        If Port > 0 Then
            Try
                ' Creates a COM Port stream handle 
                intHandle = CreateFile("COM" + Port.ToString() + ":", GENERIC_READ Or GENERIC_WRITE, 0, 0, OPEN_EXISTING, 0, 0)
                If intHandle <> -1 Then
                    ' Clear all comunication errors
                    Dim lpErrCode As Integer
                    'iRc = ClearCommError(intHandle, lpErrCode, 0)
                    ' Clears I/O buffers
                    iRc = PurgeComm(intHandle, PurgeBuffers.RXClear Or _
                        PurgeBuffers.TxClear)
                    ' Gets COM Settings
                    iRc = GetCommState(intHandle, uDcb)
                    ' Updates COM Settings
                    uDcb.BaudRate = mintBaudRate
                    uDcb.bits1 = 4113
                    uDcb.EofChar = 0
                    uDcb.ErrorChar = 0
                    uDcb.EvtChar = 0
                    uDcb.Parity = 0
                    uDcb.StopBits = 0
                    uDcb.wReserved = 0
                    uDcb.wReserved1 = 0
                    iRc = SetCommState(intHandle, uDcb)
                    If iRc = 0 Then
                        Throw New ApplicationException("Unable to set COM state")
                    End If
                    Dim lpCommTimeouts As COMMTIMEOUTS = New COMMTIMEOUTS
                    iRc = GetCommTimeouts(intHandle, lpCommTimeouts)

                    ' Set Timeouts
                    'lpCommTimeouts.ReadIntervalTimeout = &HFFFFFFFF
                    'lpCommTimeouts.ReadTotalTimeoutMultiplier = 0
                    lpCommTimeouts.ReadTotalTimeoutConstant = 500
                    lpCommTimeouts.WriteTotalTimeoutMultiplier = 10
                    lpCommTimeouts.WriteTotalTimeoutConstant = 100
                    iRc = SetCommTimeouts(intHandle, lpCommTimeouts)
                    iRc = GetCommState(intHandle, uDcb)
                    iRc = SetupComm(intHandle, 256, 256)

                Else
                    ' Raise Initialization problems
                    Throw New ApplicationException("Unable to open COM" & miPort.ToString)
                End If
            Catch Ex As Exception
                ' Generica error
                Throw New ApplicationException(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
        Return intHandle
    End Function


    Public Function Close(ByVal handle As Integer) As Integer
        On Error GoTo Exitsub
        Dim intResult As Integer
        If (handle <> INVALID_HANDLE_VALUE) Then

            intResult = CloseHandle(handle)
            If (intResult < 0) Then

                Throw New ArgumentException("Unable to close serial port.")
            Else
                hlcom = -1
            End If

            Return INVALID_HANDLE_VALUE
        End If
Exits:
        Exit Function
Exitsub:
        If (Err.Number <> 0) And Err.Number <> 32755 Then
            MsgBox(Err.Description)
        End If
        If (Err.Number <> 0) Then
            ComStop = True
            Resume Exits
        End If

    End Function

    Public Function Comin(ByVal mintHandle As Integer, ByVal InputDataLen As Integer) As Boolean
        On Error GoTo Exitsub
        Dim Start As Double
        Dim i As Integer, ll As Integer
        ReDim ComData(InputDataLen - 1)
        Start = Microsoft.VisualBasic.DateAndTime.Timer
        ComLen = 0
        Do
            ll = Input(mintHandle, InputDataLen)
            If ll > 0 Then
                If InputDataLen = 0 Then
                    ComData = mbytRxBuffer
                    ComLen = ll
                    Exit Do
                End If
                For i = ComLen To ComLen + ll - 1
                    ComData(i) = mbytRxBuffer(i - ComLen)
                Next i
                ComLen += ll
            End If
            If ComLen = InputDataLen Then Exit Do
            Application.DoEvents()
        Loop While Microsoft.VisualBasic.DateAndTime.Timer - Start < 1
        If ComLen < InputDataLen Then
            ComStop = True
            Return False
        Else
            ComStop = False
            Return True
        End If
Exits:
        Exit Function
Exitsub:
        If (Err.Number <> 0) And Err.Number <> 32755 Then
            MsgBox(Err.Description)
        End If
        If (Err.Number <> 0) Then
            ComStop = True
            Resume Exits
        End If
    End Function

#End Region
End Class