crs232.vb

实现Text模式下短信的发送接收。有些较老的手机不支持PDU模式

        '
        '	Notes				:
        '===================================================
        Get
            If mhRS = -1 Then
                Throw New ApplicationException("Please initialize and open port before using this method")
            Else
                '// Retrieve modem status
                Dim lpModemStatus As Int32
                If Not GetCommModemStatus(mhRS, lpModemStatus) Then
                    Throw New ApplicationException("Unable to get modem status")
                Else
                    Return CType(lpModemStatus, ModemStatusBits)
                End If
            End If
        End Get
    End Property
    Public Function CheckLineStatus(ByVal Line As ModemStatusBits) As Boolean
        '===================================================
        '												?002 Corrado Cavalli All rights reserved
        '
        '	Description	:	Check status of a Modem Line
        '	Created			:	28/02/2002 - 10:25:17
        '	Author			:	Corrado Cavalli
        '
        '						*Parameters Info*
        '
        '	Notes				:
        '===================================================
        Return Convert.ToBoolean(ModemStatus And Line)
    End Function
    Public Property WorkingMode() As Mode
        '===================================================
        '												?002 Corrado Cavalli All rights reserved
        '
        '	Description	:	Set working mode (Overlapped/NonOverlapped)
        '	Created			:	28/02/2002 - 15:01:18
        '	Author			:	Corrado Cavalli
        '
        '						*Parameters Info*
        '
        '	Notes				:
        '===================================================
        Get
            Return meMode
        End Get
        Set(ByVal Value As Mode)
            meMode = Value
        End Set
    End Property
    Public Overloads Sub AsyncWrite(ByVal Buffer() As Byte)
        '===================================================
        '												?002 Corrado Cavalli All rights reserved
        '
        '	Description	:	Write bytes using another thread, TxCompleted raised when done
        '	Created			:	01/03/2002 - 12:00:56
        '	Author			:	Corrado Cavalli
        '
        '						*Parameters Info*
        '
        '	Notes				:
        '===================================================
        If meMode <> Mode.Overlapped Then Throw New ApplicationException("Async Methods allowed only when WorkingMode=Overlapped")
        If mbWaitOnWrite = True Then Throw New ApplicationException("Unable to send message because of pending transmission.")
        mabtTmpTxBuf = Buffer
        moThreadTx = New Thread(AddressOf _W)
        moThreadTx.Start()
    End Sub
    Public Overloads Sub AsyncWrite(ByVal Buffer As String)
        '===================================================
        '												?002 Corrado Cavalli All rights reserved
        '
        '	Description	:	Overloaded Async Write
        '	Created			:	01/03/2002 - 12:00:56
        '	Author			:	Corrado Cavalli
        '
        '						*Parameters Info*
        '
        '	Notes				:
        '===================================================
        Dim oEncoder As New System.Text.ASCIIEncoding
        '-------------------------------------------------------------
        Dim aByte() As Byte = oEncoder.GetBytes(Buffer)
        Me.AsyncWrite(aByte)
    End Sub
    Public Overloads Sub AsyncRead(ByVal Bytes2Read As Int32)
        '===================================================
        '												?002 Corrado Cavalli All rights reserved
        '
        '	Description	:	Read bytes using a different thread, RxCompleted raised when done
        '	Created			:	01/03/2002 - 12:00:56
        '	Author			:	Corrado Cavalli
        '
        '						*Parameters Info*
        '
        '	Notes				:
        '===================================================
        If meMode <> Mode.Overlapped Then Throw New ApplicationException("Async Methods allowed only when WorkingMode=Overlapped")
        miTmpBytes2Read = Bytes2Read
        moThreadTx = New Thread(AddressOf _R)
        moThreadTx.Start()
    End Sub


#Region "Thread related functions"
    Public Sub _W()
        '===================================================
        '												?002 Corrado Cavalli All rights reserved
        '
        '	Description	:	Method invoked by thread to perform an async write
        '	Created			:	01/03/2002 - 12:23:08
        '	Author			:	Corrado Cavalli
        '
        '						*Parameters Info*
        '
        '	Notes				:	Do not invoke this method from code
        '===================================================
        Write(mabtTmpTxBuf)
    End Sub
    Public Sub _R()
        '===================================================
        '												?002 Corrado Cavalli All rights reserved
        '
        '	Description	:	Method invoked by thread to perform an async read
        '	Created			:	01/03/2002 - 12:23:08
        '	Author			:	Corrado Cavalli
        '
        '						*Parameters Info*
        '
        '	Notes				:	Do not invoke this method from code
        '===================================================
        Dim iRet As Int32 = Read()
    End Sub
#End Region



#Region "Private Routines"
    Private Sub pSetTimeout()
        '===================================================
        '												?001 Corrado Cavalli All rights reserved
        '
        '		Description:		Set comunication timeouts
        '		Created			:		21/09/2001 - 11:46:40
        '		Author				:		Corrado Cavalli
        '
        '												*Parameters Info*
        '
        '		Notes				:
        '===================================================
        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
    Private Sub pHandleOverlappedRead(ByVal Bytes2Read As Int32)
        '===================================================
        '												?002 Corrado Cavalli All rights reserved
        '
        '	Description	:	Handles overlapped read
        '	Created			:	28/02/2002 - 16:03:06
        '	Author			:	Corrado Cavalli
        '
        '						*Parameters Info*
        '
        '	Notes				:
        '===================================================
        Dim iReadChars, iRc, iRes, iLastErr As Int32
        '-----------------------------------------------------------------------
        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
    Private Function pHandleOverlappedWrite(ByVal Buffer() As Byte) As Boolean
        '===================================================
        '												?002 Corrado Cavalli All rights reserved
        '
        '	Description	:	Handles overlapped Write
        '	Created			:	28/02/2002 - 16:03:06
        '	Author			:	Corrado Cavalli
        '
        '						*Parameters Info*
        '
        '	Notes				:
        '===================================================
        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
    Private Function pErr2Text(ByVal lCode As Int32) As String
        '===================================================
        '												?002 Corrado Cavalli All rights reserved
        '
        '	Description	:	Translates API Code to text
        '	Created			:	01/03/2002 - 11:47:46
        '	Author			:	Corrado Cavalli
        '
        '						*Parameters Info*
        '
        '	Notes				:
        '===================================================

        Dim sRtrnCode As New StringBuilder(256)
        Dim lRet As Int32
        '----------------------
        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

#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
	'		Author				:		Corrado Cavalli
	'
	'		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
	'===================================================
	'												?002 Corrado Cavalli All rights reserved
	'
	'	Description	:	Timeout customized exception
	'	Created			:	28/02/2002 - 10:43:43
	'	Author			:	Corrado Cavalli
	'
	'						*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