crs232.vb

通过串口实现PC机和下位机的通信

Imports System.Runtime.InteropServices
Imports System.Text
Imports System.Threading
Imports System.ComponentModel

Imports System.Windows.Forms

#Region "RS232"
Public Class Rs232 : Implements IDisposable
   '===================================================
   '
   '	Module				:	Rs232
   '	Description		:	Class for handling RS232 comunication with VB.Net
   '	Created				:	10/08/2001 - 8:45:25
   '	Author				:	Corrado Cavalli ([e-mail])
	'	WebSite				:	www.codeworks.it/net/index.htm
   '
   '	Notes					:	
   '-----------------------------------------------------------------------------------------------
	'																	*	Revisions *
	'
	'	02/12/2000		First internal alpha version built on framework beta1
	'
   '	1st Public release Beta2 (10/08/2001)
   '
   '	Rev.1	(28.02.2002)
   '	1.	Added ResetDev, SetBreak and ClearBreak to the EscapeCommFunction constants
   '	2.	Added the overloaded Open routine.
   '	3.	Added the modem status routines, properties and enum.
   '	4.	If a read times out, it now returns a EndOfStreamException (instead of a simple Exception).
   '	5.Compiled with VS.Net final

   '	Rev.2	(01.03.2002)
   '	Added Async support
   '
   '  Rev.3	(07.04.2002)
   '	Minor bugs fixed
   '
   '  Rev.3 (05/05/2002)
   '  Fixed BuildCommmDCB problem
   '
   '  Rev.4 (24/05/2002)
   '  Fixed problem with ASCII Encoding truncating 8th bit
   '
   '  Rev.5 (27/05/2002)
   '  Added IDisposable / Finalize implementation
   '
   '  Rev.6 (14/03/2003)
   '  Fixed problem on DCB fields Initialization
   '
   '  Rev.7 (26/03/2003)
   '  Added XON/XOFF support
   '
   '  Rev.8 (12/07/2003)
	'  Added support to COM port number greater than 4
	'
	'	Rev.9 (15/07/2003)
	'	Added CommEvent to detect incoming chars/events
	'	Updated both Tx/Rx method from Non-Ovelapped to Overlapped mode
	'	Removed unused Async methods and other stuff.
	'
	'	Rev.10 (21/07/2003)
    '    Fixed incorrect character handling when using EnableEvents()
   '
    '   Rev.11 (12/08/2003)
    '   Fixed some bugs signaled by users
   ' 
	'	Rev.12 (01/09/2003)
	'	Removed AutoReset of internal buffers and added PurgeBuffer() method
	'	
	'	Rev.13 (02/09/2003)
	'	Removed GetLastErrorUse in favour of Win32Exception()
	'
	'	Rev.14 (14/09/2003)
	'	Added IsPortAvailable() function
	'  Revised some API declaration
    '  Fixed problem with Win98/Me OS
   '
    '   Rev.15 (24/09/2003)
    '  	Fixed bug introduced on Rev.14
   '
    '   Rev.16 (12/10/2003)
    '	Added SetBreak/ClearBreak() methods
   '
    '   Rev.17 (02/11/2003)
    '   Fixed field on COMMCONFIG
	'
	'   Rev.18 (03/03/2004)
	'   Fixed bug: Testing mhRS for <>0 is not correct
	'
	'   Rev.19 (08/04/2004)
	'   Fixed bug: Fixed bug on DTR property


	'
    '===================================================  
   '// Class Members		
	Private mhRS As IntPtr = New IntPtr(0)	  '// Handle to Com Port									
   Private miPort As Integer = 1   '//  Default is COM1	
   Private miTimeout As Int32 = 70   '// Timeout in ms
   Private miBaudRate As Int32 = 9600
   Private meParity As DataParity = 0
   Private meStopBit As DataStopBit = 0
   Private miDataBit As Int32 = 8
   Private miBufferSize As Int32 = 512   '// Buffers size default to 512 bytes
   Private mabtRxBuf As Byte()   '//  Receive buffer	
   Private meMode As Mode  '//  Class working mode	
	Private moThreadTx As Thread
	Private moThreadRx As Thread
	Private moEvents As Thread
   Private miTmpBytes2Read As Int32
   Private meMask As EventMasks
   Private mbDisposed As Boolean
	Private mbUseXonXoff As Boolean
	Private mbEnableEvents As Boolean
	Private miBufThreshold As Int32 = 1
	Private muOvlE As OVERLAPPED
	Private muOvlW As OVERLAPPED
	Private muOvlR As OVERLAPPED
	'----------------------------------------------------------------------------------------

#Region "Enums"
	'// Parity Data
	Public Enum DataParity
		Parity_None = 0
		Pariti_Odd
		Parity_Even
		Parity_Mark
	End Enum
	'// StopBit Data
	Public Enum DataStopBit
		StopBit_1 = 1
		StopBit_2
	End Enum
	<Flags()> Public Enum PurgeBuffers
		RXAbort = &H2
		RXClear = &H8
		TxAbort = &H1
		TxClear = &H4
	End Enum
	Private Enum Lines
		SetRts = 3
		ClearRts = 4
		SetDtr = 5
		ClearDtr = 6
		ResetDev = 7		 '	// Reset device if possible
		SetBreak = 8		 '	// Set the device break line.
		ClearBreak = 9		 '	// Clear the device break line.
	End Enum
	'// Modem Status
	<Flags()> Public Enum ModemStatusBits
		ClearToSendOn = &H10
		DataSetReadyOn = &H20
		RingIndicatorOn = &H40
		CarrierDetect = &H80
	End Enum
	'// Working mode
	Public Enum Mode
		NonOverlapped
		Overlapped
	End Enum
	'// Comm Masks
	<Flags()> Public Enum EventMasks
		RxChar = &H1
		RXFlag = &H2
		TxBufferEmpty = &H4
		ClearToSend = &H8
		DataSetReady = &H10
		CarrierDetect = &H20
		Break = &H40
		StatusError = &H80
		Ring = &H100
	End Enum

#End Region
#Region "Structures"
	<StructLayout(LayoutKind.Sequential, Pack:=1)> Private Structure DCB
		Public DCBlength As Int32
		Public BaudRate As Int32
		Public Bits1 As Int32
		Public wReserved As Int16
		Public XonLim As Int16
		Public XoffLim As Int16
		Public ByteSize As Byte
		Public Parity As Byte
		Public StopBits As Byte
		Public XonChar As Char
		Public XoffChar As Char
		Public ErrorChar As Char
		Public EofChar As Char
		Public EvtChar As Char
		Public wReserved2 As Int16
	End Structure
	<StructLayout(LayoutKind.Sequential, Pack:=1)> Private Structure COMMTIMEOUTS
		Public ReadIntervalTimeout As Int32
		Public ReadTotalTimeoutMultiplier As Int32
		Public ReadTotalTimeoutConstant As Int32
		Public WriteTotalTimeoutMultiplier As Int32
		Public WriteTotalTimeoutConstant As Int32
	End Structure
    <StructLayout(LayoutKind.Sequential, Pack:=8)> Private Structure COMMCONFIG
        Public dwSize As Int32
        Public wVersion As Int16
        Public wReserved As Int16
        Public dcbx As DCB
        Public dwProviderSubType As Int32
        Public dwProviderOffset As Int32
        Public dwProviderSize As Int32
        Public wcProviderData As Int16
    End Structure
    <StructLayout(LayoutKind.Sequential, Pack:=1)> Public Structure OVERLAPPED
        Public Internal As Int32
        Public InternalHigh As Int32
        Public Offset As Int32
        Public OffsetHigh As Int32
        Public hEvent As IntPtr
    End Structure
    <StructLayout(LayoutKind.Sequential, Pack:=1)> Private Structure COMSTAT
        Dim fBitFields As Int32
        Dim cbInQue As Int32
        Dim cbOutQue As Int32
    End Structure

#End Region
#Region "Constants"
	Private Const PURGE_RXABORT As Integer = &H2
	Private Const PURGE_RXCLEAR As Integer = &H8
	Private Const PURGE_TXABORT As Integer = &H1
	Private Const PURGE_TXCLEAR As Integer = &H4
	Private Const GENERIC_READ As Integer = &H80000000
	Private Const GENERIC_WRITE As Integer = &H40000000
	Private Const OPEN_EXISTING As Integer = 3
	Private Const INVALID_HANDLE_VALUE As Integer = -1
	Private Const IO_BUFFER_SIZE As Integer = 1024
	Private Const FILE_FLAG_OVERLAPPED As Int32 = &H40000000
	Private Const ERROR_IO_PENDING As Int32 = 997
	Private Const WAIT_OBJECT_0 As Int32 = 0
	Private Const ERROR_IO_INCOMPLETE As Int32 = 996
	Private Const WAIT_TIMEOUT As Int32 = &H102&
	Private Const INFINITE As Int32 = &HFFFFFFFF


#End Region
#Region "Win32API"
	'// Win32 API
   <DllImport("kernel32.dll", SetlastError:=True)> Private Shared Function SetCommState(ByVal hCommDev As IntPtr, ByRef lpDCB As DCB) As Int32
   End Function
   <DllImport("kernel32.dll", SetlastError:=True)> Private Shared Function GetCommState(ByVal hCommDev As IntPtr, ByRef lpDCB As DCB) As Int32
   End Function
   <DllImport("kernel32.dll", SetlastError:=True, CharSet:=CharSet.Auto)> Private Shared Function BuildCommDCB(ByVal lpDef As String, ByRef lpDCB As DCB) As Int32
   End Function
   <DllImport("kernel32.dll", SetlastError:=True)> Private Shared Function SetupComm(ByVal hFile As IntPtr, ByVal dwInQueue As Int32, ByVal dwOutQueue As Int32) As Int32
   End Function
   <DllImport("kernel32.dll", SetlastError:=True)> Private Shared Function SetCommTimeouts(ByVal hFile As IntPtr, ByRef lpCommTimeouts As COMMTIMEOUTS) As Int32
   End Function
   <DllImport("kernel32.dll", SetlastError:=True)> Private Shared Function GetCommTimeouts(ByVal hFile As IntPtr, ByRef lpCommTimeouts As COMMTIMEOUTS) As Int32
   End Function
   <DllImport("kernel32.dll", SetlastError:=True)> Private Shared Function ClearCommError(ByVal hFile As IntPtr, ByRef lpErrors As Int32, ByRef lpComStat As COMSTAT) As Int32
   End Function
   <DllImport("kernel32.dll", SetlastError:=True)> Private Shared Function PurgeComm(ByVal hFile As IntPtr, ByVal dwFlags As Int32) As Int32
   End Function
   <DllImport("kernel32.dll", SetlastError:=True)> Private Shared Function EscapeCommFunction(ByVal hFile As IntPtr, ByVal ifunc As Long) As Boolean
   End Function
   <DllImport("kernel32.dll", SetlastError:=True)> Private Shared Function WaitCommEvent(ByVal hFile As IntPtr, ByRef Mask As EventMasks, ByRef lpOverlap As OVERLAPPED) As Int32
   End Function
   <DllImport("kernel32.dll", SetlastError:=True)> Private Shared Function WriteFile(ByVal hFile As IntPtr, ByVal Buffer As Byte(), ByVal nNumberOfBytesToWrite As Integer, ByRef lpNumberOfBytesWritten As Integer, ByRef lpOverlapped As OVERLAPPED) As Integer
   End Function
	<DllImport("kernel32.dll", SetlastError:=True)> Private Shared Function ReadFile(ByVal hFile As IntPtr, <Out()> ByVal Buffer As Byte(), ByVal nNumberOfBytesToRead As Integer, ByRef lpNumberOfBytesRead As Integer, ByRef lpOverlapped As OVERLAPPED) As Integer
	End Function
	<DllImport("kernel32.dll", SetlastError:=True, CharSet:=CharSet.Auto)> Private Shared Function CreateFile(ByVal lpFileName As String, ByVal dwDesiredAccess As Integer, ByVal dwShareMode As Integer, ByVal lpSecurityAttributes As Integer, ByVal dwCreationDisposition As Integer, ByVal dwFlagsAndAttributes As Integer, ByVal hTemplateFile As Integer) As IntPtr
	End Function
	<DllImport("kernel32.dll", SetlastError:=True)> Private Shared Function CloseHandle(ByVal hObject As IntPtr) As Boolean
	End Function
	<DllImport("kernel32.dll", SetlastError:=True)> Public Shared Function GetCommModemStatus(ByVal hFile As IntPtr, ByRef lpModemStatus As Int32) As Boolean
	End Function
	<DllImport("kernel32.dll", SetlastError:=True)> Private Shared Function SetEvent(ByVal hEvent As IntPtr) As Boolean
	End Function
	<DllImport("kernel32.dll", SetlastError:=True, CharSet:=CharSet.Auto)> Private Shared Function CreateEvent(ByVal lpEventAttributes As IntPtr, ByVal bManualReset As Int32, ByVal bInitialState As Int32, ByVal lpName As String) As IntPtr
	End Function
	<DllImport("kernel32.dll", SetlastError:=True)> Private Shared Function WaitForSingleObject(ByVal hHandle As IntPtr, ByVal dwMilliseconds As Int32) As Int32
	End Function
	<DllImport("kernel32.dll", SetlastError:=True)> Private Shared Function GetOverlappedResult(ByVal hFile As IntPtr, ByRef lpOverlapped As OVERLAPPED, ByRef lpNumberOfBytesTransferred As Int32, ByVal bWait As Int32) As Int32
	End Function
	<DllImport("kernel32.dll", SetlastError:=True)> Private Shared Function SetCommMask(ByVal hFile As IntPtr, ByVal lpEvtMask As Int32) As Int32
	End Function
	<DllImport("kernel32.dll", SetlastError:=True, CharSet:=CharSet.Auto)> Private Shared Function GetDefaultCommConfig(ByVal lpszName As String, ByRef lpCC As COMMCONFIG, ByRef lpdwSize As Integer) As Boolean
   End Function
   <DllImport("kernel32.dll", SetlastError:=True)> Private Shared Function SetCommBreak(ByVal hFile As IntPtr) As Boolean
   End Function
   <DllImport("kernel32.dll", SetlastError:=True)> Private Shared Function ClearCommBreak(ByVal hFile As IntPtr) As Boolean
   End Function


#End Region
#Region "Events"
	Public Event CommEvent As CommEventHandler
#End Region
#Region "Delegates"
	Public Delegate Sub CommEventHandler(ByVal source As Rs232, ByVal Mask As EventMasks)
#End Region

	Public Property Port() As Integer
		'===================================================
		'
		'		Description	:		Comunication Port
		'		Created			:		21/09/2001 - 11:25:49
		'
		'												*Parameters Info*
		'
		'		Notes				:
		'===================================================
		Get
			Return miPort
		End Get
		Set(ByVal Value As Integer)
			miPort = Value
		End Set
	End Property
	Public Sub PurgeBuffer(ByVal Mode As PurgeBuffers)
		'===================================================
		'