crs232.vb

Corrado Cavalli为VB.NET写的串口通讯类。通过调用API的方法与串口通讯。我的有关串口通讯的程序都是用的这个类。

		'	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(miTmpBytes2Read)
	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