'Simple RS232 Serial Port VB .Net class provided by Embedded Data Systems,
LLC.
'
'This code should be usable on both desktop and compact framework platforms
'by setting the constant 'COMPACT_FRAMEWORK' at compile time.
'This code may be freely copied providing you are using it to integrated
'products manufactured by Embedded Data Systems.
'This code is provided for sample purposes only, and is without warranty
'or guarantee of any kind.
Option Strict On
Public Class SerialPort
Implements IDisposable
#If COMPACT_FRAMEWORK Then
private Declare Function CreateFile Lib "coredll.dll" _
(ByVal lpFileName As String, ByVal dwDesiredAccess As Int32, _
ByVal dwShareMode As Int32, ByVal lpSecurityAttributes As IntPtr, _
ByVal dwCreationDisposition As Int32, ByVal dwFlagsAndAttributes As
Int32, _
ByVal hTemplateFile As IntPtr) As IntPtr
Private Declare Function GetCommState Lib "coredll.dll" (ByVal nCid As
IntPtr, ByRef lpDCB As DCB) As Boolean
Private Declare Function SetCommState Lib "coredll.dll" (ByVal nCid As
IntPtr, ByRef lpDCB As DCB) As Boolean
Private Declare Function GetCommTimeouts Lib "coredll.dll" (ByVal hFile As
IntPtr, ByRef lpCommTimeouts As COMMTIMEOUTS) As Boolean
Private Declare Function SetCommTimeouts Lib "coredll.dll" (ByVal hFile As
IntPtr, ByRef lpCommTimeouts As COMMTIMEOUTS) As Boolean
Private Declare Function WriteFile Lib "coredll.dll" (ByVal hFile As
IntPtr, ByVal lpBuffer As Byte(), ByVal nNumberOfBytesToWrite As Int32,
ByRef lpNumberOfBytesWritten As Int32, ByVal lpOverlapped As IntPtr) As
Boolean
Private Declare Function ReadFile Lib "coredll.dll" (ByVal hFile As
IntPtr, ByVal lpBuffer As Byte(), ByVal nNumberOfBytesToRead As Int32, ByRef
lpNumberOfBytesRead As Int32, ByVal lpOverlapped As IntPtr) As Boolean
Private Declare Function CloseHandle Lib "coredll.dll" (ByVal hObject As
IntPtr) As Boolean
#Else
Private Declare Auto Function CreateFile Lib "kernel32.dll" _
(ByVal lpFileName As String, ByVal dwDesiredAccess As Int32, _
ByVal dwShareMode As Int32, ByVal lpSecurityAttributes As IntPtr, _
ByVal dwCreationDisposition As Int32, ByVal dwFlagsAndAttributes As
Int32, _
ByVal hTemplateFile As IntPtr) As IntPtr
Private Declare Auto Function GetCommState Lib "kernel32.dll" (ByVal nCid
As IntPtr, ByRef lpDCB As DCB) As Boolean
Private Declare Auto Function SetCommState Lib "kernel32.dll" (ByVal nCid
As IntPtr, ByRef lpDCB As DCB) As Boolean
Private Declare Auto Function GetCommTimeouts Lib "kernel32.dll" (ByVal
hFile As IntPtr, ByRef lpCommTimeouts As COMMTIMEOUTS) As Boolean
Private Declare Auto Function SetCommTimeouts Lib "kernel32.dll" (ByVal
hFile As IntPtr, ByRef lpCommTimeouts As COMMTIMEOUTS) As Boolean
Private Declare Auto Function WriteFile Lib "kernel32.dll" (ByVal hFile As
IntPtr, ByVal lpBuffer As Byte(), ByVal nNumberOfBytesToWrite As Int32,
ByRef lpNumberOfBytesWritten As Int32, ByVal lpOverlapped As IntPtr) As
Boolean
Private Declare Auto Function ReadFile Lib "kernel32.dll" (ByVal hFile As
IntPtr, ByVal lpBuffer As Byte(), ByVal nNumberOfBytesToRead As Int32, ByRef
lpNumberOfBytesRead As Int32, ByVal lpOverlapped As IntPtr) As Boolean
Private Declare Auto Function CloseHandle Lib "kernel32.dll" (ByVal
hObject As IntPtr) As Boolean
#End If
Public Const NOPARITY As Int32 = 0 'No Parity
Public Const ONESTOPBIT As Int32 = 0 '1 Stop Bit
Private Structure DCB
Public DCBlength As Int32
Public BaudRate As Int32
Public fBitFields As Int32 'See Comments in Win32API.Txt
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 Byte
Public XoffChar As Byte
Public ErrorChar As Byte
Public EofChar As Byte
Public EvtChar As Byte
Public wReserved1 As Int16 'Reserved; Do Not Use
End Structure
Private fBinary As Integer = 1 'binary mode, no EOF check
Private fParity As Integer = 2 ' enable parity checking
Private fOutxCtsFlow As Integer = 4 'CTS output flow control
Private fOutxDsrFlow As Integer = 8 'DSR output flow control
Private fDTRControlDisable As Integer = 0 ' DTR flow control type (2 bits)
Private fDtrControlEnable As Integer = 16 ' Enables DTR Line, and leaves
it on.
Private fDTRControlHandshake As Integer = 32 'Standard DTR handshaking
Private fDsrSensitivity As Integer = 64 'DSR sensitivity
Private fTXContinueOnXoff As Integer = 128 'XOFF continues Tx
Private fOutX As Integer = 256 'XON/XOFF out flow control
Private fInX As Integer = 512 'XON/XOFF in flow control
Private fErrorChar As Integer = 1024 'enable error replacement
Private fNull As Integer = 2048 'enable null stripping
Private fRTSControlDisable As Integer = 0 'Flow control Line (2 bits)
Private fRTSControlEnable As Integer = 4096 'Enable RTS Flow control line,
and leave it on
Private fRTSControlHandshake As Integer = 8192 'Enables standard RTS
handshaking
Private fAbortOnError As Integer = 16384 'abort reads/writes on error
Private fDummy2 As Integer = 32768 'reserved
Private hSerialPort As IntPtr
Private MyDCB As DCB
Private MyCommTimeouts As COMMTIMEOUTS
Private oEncoder As New System.Text.ASCIIEncoding
Private oEnc As System.Text.Encoding = oEncoder.GetEncoding(1252)
Private portName As String
Private Const GENERIC_READ As Int32 = &H80000000
Private Const GENERIC_WRITE As Int32 = &H40000000
Private Const OPEN_EXISTING As Int32 = 3
Private Const FILE_ATTRIBUTE_NORMAL As Int32 = &H80
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
'Opens the serial port using the parameters supplied.
Public Sub New(ByVal portName As String, ByVal baudRate As Integer, ByVal
parity As Byte, ByVal byteSize As Byte, ByVal stopBits As Byte)
Me.portName = portName
openPort(portName, baudRate, parity, byteSize, stopBits)
End Sub
'Transmits up to 48 bytes out the port
Public Sub tx(ByVal whatToSend As String)
Dim bytesWritten As Int32
Dim outbuffer(48) As Byte
Dim success As Boolean
outbuffer = oEnc.GetBytes(whatToSend)
success = WriteFile(hSerialPort, outbuffer, outbuffer.Length,
bytesWritten, IntPtr.Zero)
If success = False Then
Throw New CommException("Unable to write to " & Me.portName)
End If
End Sub
'Reads from port until some data is recieved, or timeOut is exceeded
'Timeout is currently hardcoded at 3000 mS, in openPort()
Public Function rx() As String
Dim bytesRead As Int32
Dim inBuffer(48) As Byte
Dim retVal As String
Dim success As Boolean
success = ReadFile(hSerialPort, inBuffer, inBuffer.Length, bytesRead,
IntPtr.Zero)
If success = False Then
Throw New CommException("Unable to read from " & portName)
End If
retVal = oEnc.GetString(inBuffer, 0, bytesRead)
Return retVal
End Function
Private Sub openPort(ByVal portName As String, ByVal baudRate As Integer,
ByVal parity As Byte, ByVal byteSize As Byte, ByVal stopBits As Byte)
Dim Success As Boolean
' Obtain a handle to the serial port.
hSerialPort = CreateFile(portName, GENERIC_READ Or GENERIC_WRITE, 0,
IntPtr.Zero, OPEN_EXISTING, 0, IntPtr.Zero)
' Verify that the obtained handle is valid.
If hSerialPort.ToInt32 = -1 Then
Throw New CommException("Unable to obtain a handle to the COM port")
End If
' Retrieve the current control settings.
Success = GetCommState(hSerialPort, MyDCB)
If Success = False Then
Throw New CommException("Unable to retrieve the current control
settings")
End If
' Modify the properties of MyDCB
MyDCB.BaudRate = baudRate
MyDCB.ByteSize = byteSize
MyDCB.Parity = parity
MyDCB.StopBits = stopBits
MyDCB.fBitFields = MyDCB.fBitFields Or fRTSControlDisable Or
fDTRControlDisable
' Reconfigure port based on the properties of MyDCB.
Success = SetCommState(hSerialPort, MyDCB)
If Success = False Then
Throw New CommException("Unable to reconfigure COM")
End If
' Retrieve the current time-out settings.
Success = GetCommTimeouts(hSerialPort, MyCommTimeouts)
If Success = False Then
Throw New CommException("Unable to retrieve current time-out
settings")
End If
' Modify the properties of MyCommTimeouts
MyCommTimeouts.ReadIntervalTimeout = 5
MyCommTimeouts.ReadTotalTimeoutConstant = 3000
MyCommTimeouts.ReadTotalTimeoutMultiplier = 0
MyCommTimeouts.WriteTotalTimeoutConstant = 0
MyCommTimeouts.WriteTotalTimeoutMultiplier = 0
' Reconfigure the time-out settings, based on the properties of
MyCommTimeouts.
Success = SetCommTimeouts(hSerialPort, MyCommTimeouts)
If Success = False Then
Throw New CommException("Unable to reconfigure the time-out settings")
End If
'Flush any garbage on port
flushComIn()
End Sub
'Closes the physical port, and prepares this object for destruction
Public Sub Dispose() Implements System.IDisposable.Dispose
Static disposed As Boolean = False
' Release the handle to port.
CloseHandle(hSerialPort)
disposed = True
End Sub
'Flushes any data already received on the port
Public Sub flushComIn()
Dim ExistingCommTimeouts As COMMTIMEOUTS
Dim tempCommTimeouts As COMMTIMEOUTS
Dim success As Boolean
Dim BytesRead As Int32
Dim Buffer(32) As Byte
' Retrieve the current time-out settings.
success = GetCommTimeouts(hSerialPort, ExistingCommTimeouts)
With tempCommTimeouts
.ReadIntervalTimeout = 1
.WriteTotalTimeoutConstant = 0
.WriteTotalTimeoutMultiplier = 0
.ReadTotalTimeoutConstant = 1
End With
' Temporarily reconfigure the time-out settings
success = SetCommTimeouts(hSerialPort, tempCommTimeouts)
'Read data from port.
success = ReadFile(hSerialPort, Buffer, 32, BytesRead, IntPtr.Zero)
'Reset the time-out settings to previous values
success = SetCommTimeouts(hSerialPort, ExistingCommTimeouts)
End Sub
Class CommException
Inherits ApplicationException
Sub New(ByVal Reason As String)
MyBase.New(Reason)
End Sub
End Class
End Class
"evle" <ev****@msn.comwrote in message
news:%2****************@TK2MSFTNGP06.phx.gbl...
haw to read data from an Infrared Infrared Remote Control
