crs232.vb

vb.net 开发的WinCE下的串口通讯类

        '												*Parameters Info*
        '
        '		Notes				:
        '===================================================
        Dim uCtm As COMMTIMEOUTS
        '// Set ComTimeout
        If m_hcom.ToInt32 = 0 Or m_hcom.ToInt32 = INVALID_HANDLE_VALUE Then
            Exit Sub
        Else
            '// Changes setup on the fly
            With uCtm
                .ReadIntervalTimeout = 0
                .ReadTotalTimeoutMultiplier = 0
                .ReadTotalTimeoutConstant = miTimeout
                .WriteTotalTimeoutMultiplier = 10
                .WriteTotalTimeoutConstant = 100
            End With
            SetCommTimeouts(m_hcom, uCtm)
        End If
    End Sub
#End Region

#Region " 托管、事件、 线程 和 线程委派 的处理 "

#Region "Delegates 事件顶级托管声明"
    Public Delegate Sub CommEventHandler(ByVal source As Rs232, ByVal Mask As EventMasks)
#End Region

#Region "Com  Events  事件句柄声明"
    Public Event CommEvent As CommEventHandler
#End Region



#Region "Com Events 事件线程和 线程委派 的实现"


    Public Sub EnableEvents()
        '===================================================
        '
        '	Description	:	Enables monitoring of incoming events
        '	Created			:	15/07/2003 - 12:00:56
        '
        '						*Parameters Info*
        '
        '	Notes				:
        '===================================================
        If m_hcom.ToInt32 = 0 Or m_hcom.ToInt32 = INVALID_HANDLE_VALUE Then
            Throw New ApplicationException("Please initialize and open port before using this method")
        Else
            If moEvents Is Nothing Then
                mbEnableEvents = True
                moEvents = New Thread(AddressOf pEventsWatcher)
                'moEvents.IsBackground = True
                moEvents.Start()
            End If
        End If
    End Sub
    Public Sub DisableEvents()
        '===================================================
        '
        '	Description	:	Disables monitoring of incoming events
        '	Created			:	15/07/2003 - 12:00:56
        '
        '						*Parameters Info*
        '
        '	Notes				:
        '===================================================
        If mbEnableEvents = True Then
            SyncLock Me
                mbEnableEvents = False     '// This should kill the thread
            End SyncLock
            '// Let WaitCommEvent exit...
            If muOvlE.hEvent.ToInt32 <> 0 Then SetEvent(muOvlE.hEvent)
            moEvents = Nothing
        End If
    End Sub
#Region "Protected Routines"
    Protected Sub OnCommEventReceived(ByVal source As Rs232, ByVal mask As EventMasks)
        '===================================================
        '												?003 www.codeworks.it All rights reserved
        '
        '	Description	:	Raises CommEvent
        '	Created			:	2005-8-13   14:10
        '	Author			:	Corrado Cavalli
        '
        '   *Parameters Info*
        '
        '       writer :韩俊峰
        '       company:重庆联康科技有限公司	
        '===================================================
        Dim del As CommEventHandler = Me.CommEventEvent
        If (Not del Is Nothing) Then
            '***************************************************************
            '*
            '*//注销说明：
            '*              WinCE.net 不支持 异步操作(重叠操作)，PC里面支持
            '*              WinCE.net 中vb.net 的 .net  Framework 框架中没有 
            '*              system.Imports System.ComponentModel.ISynchronizeInvoke类
            '*              也就是：提供同步或异步操作的委托方法 类(ISynchronizeInvoke)
            '
            'Dim SafeInvoker As ISynchronizeInvoke
            'Try
            '    SafeInvoker = DirectCast(del.Target, ISynchronizeInvoke)
            'Catch
            'End Try
            'If (Not SafeInvoker Is Nothing) Then
            '    SafeInvoker.Invoke(del, New Object() {source, mask})
            'Else
            '*
            '****************************************************************
            del.Invoke(source, mask)
            'End If
        End If
    End Sub
#End Region
#End Region

#Region "Private Routines"

    Private Sub pDispose() Implements IDisposable.Dispose
        '===================================================
        '
        '	Description	:	Handles correct class disposing Write
        '	Created			:	27/05/2002 - 19:03:06
        '
        '						*Parameters Info*
        '
        '	Notes				:
        '===================================================
        If (Not mbDisposed AndAlso (m_hcom.ToInt32 <> 0 And m_hcom.ToInt32 <> INVALID_HANDLE_VALUE)) Then
            '// Closes Com Port releasing resources
            Try
                Me.Close()
            Finally
                mbDisposed = True
                '// Suppress unnecessary Finalize overhead
                GC.SuppressFinalize(Me)
            End Try
        End If
    End Sub
    Private Sub pEventsWatcher()
        '===================================================
        '												?003 www.codeworks.it All rights reserved
        '
        '	Description	:	Watches for all events raising events when they arrive to the port
        '	Created			:	15/07/03 - 11:45:13
        '	Author			:	Corrado Cavalli
        '
        '						*Parameters Info*
        '
        '	Notes				:
        '===================================================
        '// Events to watch
        Dim lMask As EventMasks = EventMasks.Break Or EventMasks.CarrierDetect Or EventMasks.ClearToSend Or _
        EventMasks.DataSetReady Or EventMasks.Ring Or EventMasks.RxChar Or EventMasks.RXFlag Or _
        EventMasks.StatusError
        Dim lRetMask As EventMasks, iBytesRead, iTotBytes, iErrMask As Int32, iRc As Int32, aBuf As New ArrayList
        Dim uComStat As COMSTAT
        '-----------------------------------
        '// Creates Event
        muOvlE = New OVERLAPPED
        Dim hOvlE As GCHandle = GCHandle.Alloc(muOvlE, GCHandleType.Pinned)
        muOvlE.hEvent = CreateEvent(Nothing, 1, 0, Nothing)
        If muOvlE.hEvent.ToInt32 = 0 Then Throw New ApplicationException("Error creating event for overlapped reading")
        '// Set mask
        SetCommMask(m_hcom, lMask)
        '// Looks for RxChar
        While mbEnableEvents = True
            WaitCommEvent(m_hcom, lMask, muOvlE)
            Select Case WaitForSingleObject(muOvlE.hEvent, INFINITE)
                Case WAIT_OBJECT_0
                    '// Event (or abort) detected
                    If mbEnableEvents = False Then Exit While
                    If (lMask And EventMasks.RxChar) > 0 Then
                        '// Read incoming data
                        ClearCommError(m_hcom, iErrMask, uComStat)
                        If iErrMask = 0 Then
                            Dim ovl As New OVERLAPPED
                            Dim hOvl As GCHandle = GCHandle.Alloc(ovl, GCHandleType.Pinned)
                            ReDim mabtRxBuf(uComStat.cbInQue - 1)
                            If ReadFile(m_hcom, mabtRxBuf, uComStat.cbInQue, iBytesRead, ovl) > 0 Then
                                If iBytesRead > 0 Then
                                    '// Some bytes read, fills temporary buffer
                                    If iTotBytes < miBufThreshold Then
                                        aBuf.AddRange(mabtRxBuf)
                                        iTotBytes += iBytesRead
                                    End If
                                    '// Threshold reached?, raises event
                                    If iTotBytes >= miBufThreshold Then
                                        '//Copies temp buffer into Rx buffer
                                        ReDim mabtRxBuf(iTotBytes - 1)
                                        aBuf.CopyTo(mabtRxBuf)
                                        '// Raises event
                                        Try
                                            Me.OnCommEventReceived(Me, lMask)
                                        Finally
                                            iTotBytes = 0
                                            aBuf.Clear()
                                        End Try
                                    End If
                                End If
                            End If
                            If (hOvl.IsAllocated) Then hOvl.Free()
                        End If
                    Else
                        '// Simply raises OnCommEventHandler event
                        Me.OnCommEventReceived(Me, lMask)
                    End If
                Case Else
                    Dim sErr As String = New Win32Exception().Message
                    Throw New ApplicationException(sErr)
            End Select
        End While
        '// Release Event Handle
        CloseHandle(muOvlE.hEvent)
        muOvlE.hEvent = IntPtr.Zero
        If (hOvlE.IsAllocated) Then hOvlE.Free()
        muOvlE = Nothing
    End Sub



#End Region

#Region "Finalize"
    Protected Overrides Sub Finalize()
        '===================================================
        '
        '	Description	:	Closes COM port if object is garbage collected and still owns
        '                       COM port reosurces
        '
        '	Created			:	27/05/2002 - 19:05:56
        '
        '						*Parameters Info*
        '
        '	Notes				:
        '===================================================
        Try
            If Not mbDisposed Then
                If mbEnableEvents Then Me.DisableEvents()
                Close()
            End If
        Finally
            MyBase.Finalize()
        End Try
    End Sub
#End Region

#End Region
End Class
#End Region

#Region "Exceptions 类  异常事件处理"
Public Class CIOChannelException : Inherits ApplicationException
    '===================================================
    '
    '		Module			:		CChannellException
    '		Description:		Customized Channell Exception
    '		Created			:		17/10/2001 - 10:32:37
    '
    '		Notes				:		This exception is raised when NACK error found
    '===================================================
    Sub New(ByVal Message As String)
        MyBase.New(Message)
    End Sub
    Sub New(ByVal Message As String, ByVal InnerException As Exception)
        MyBase.New(Message, InnerException)
    End Sub
End Class
Public Class IOTimeoutException : Inherits CIOChannelException
    '===================================================
    '
    '	Description	:	Timeout customized exception
    '	Created			:	28/02/2002 - 10:43:43
    '
    '						*Parameters Info*
    '
    '	Notes				:
    '===================================================
    Sub New(ByVal Message As String)
        MyBase.New(Message)
    End Sub
    Sub New(ByVal Message As String, ByVal InnerException As Exception)
        MyBase.New(Message, InnerException)
    End Sub
End Class

#End Region