📄 crs232.vb
字号:
' Notes :
'===================================================
Get
Return meStopBit
End Get
Set(ByVal Value As DataStopBit)
meStopBit = Value
End Set
End Property
Public Property BaudRate() As Integer
'===================================================
'
' Description: Comunication BaudRate
' Created : 21/09/2001 - 11:28:00
'
' *Parameters Info*
'
' Notes :
'===================================================
Get
Return miBaudRate
End Get
Set(ByVal Value As Integer)
miBaudRate = Value
End Set
End Property
Public Property DataBit() As Integer
'===================================================
'
' Description : Comunication DataBit
' Created : 21/09/2001 - 11:28:20
'
' *Parameters Info*
'
' Notes :
'===================================================
Get
Return miDataBit
End Get
Set(ByVal Value As Integer)
miDataBit = Value
End Set
End Property
Public Property BufferSize() As Integer
'===================================================
'
' Description : Receive Buffer size
' Created : 21/09/2001 - 11:33:05
'
' *Parameters Info*
'
' Notes :
'===================================================
Get
Return miBufferSize
End Get
Set(ByVal Value As Integer)
miBufferSize = Value
End Set
End Property
Public Overloads Sub Open()
'===================================================
'
' Description : Initializes and Opens comunication port
' Created : 21/09/2001 - 11:33:40
'
' *Parameters Info*
'
' Notes :
'===================================================
'// Get Dcb block,Update with current data
Dim uDcb As DCB, iRc As Int32
'// Set working mode
meMode = Mode.Overlapped
Dim iMode As Int32 = Convert.ToInt32(IIf(meMode = Mode.Overlapped, FILE_FLAG_OVERLAPPED, 0))
'// Initializes Com Port
If miPort > 0 Then
Try
'// Creates a COM Port stream handle
mhRS = CreateFile("\\.\COM" & miPort.ToString, GENERIC_READ Or GENERIC_WRITE, 0, 0, OPEN_EXISTING, iMode, 0)
If (mhRS.ToInt32 > 0) Then
'// Clear all comunication errors
Dim lpErrCode As Int32
iRc = ClearCommError(mhRS, lpErrCode, New COMSTAT)
'// Clears I/O buffers
iRc = PurgeComm(mhRS, PurgeBuffers.RXClear Or PurgeBuffers.TxClear)
'// Gets COM Settings
iRc = GetCommState(mhRS, uDcb)
'// Updates COM Settings
Dim sParity As String = "NOEM"
sParity = sParity.Substring(meParity, 1)
'// Set DCB State
Dim sDCBState As String = String.Format("baud={0} parity={1} data={2} stop={3}", miBaudRate, sParity, miDataBit, CInt(meStopBit))
iRc = BuildCommDCB(sDCBState, uDcb)
uDcb.Parity = CByte(meParity)
'// Set Xon/Xoff State
If mbUseXonXoff Then
uDcb.Bits1 = 768
Else
uDcb.Bits1 = 0
End If
iRc = SetCommState(mhRS, uDcb)
If iRc = 0 Then
Dim sErrTxt As String = New Win32Exception().Message
Throw New CIOChannelException("Unable to set COM state " & sErrTxt)
End If
'// Setup Buffers (Rx,Tx)
iRc = SetupComm(mhRS, miBufferSize, miBufferSize)
'// Set Timeouts
pSetTimeout()
'//Enables events if required
If mbEnableEvents Then Me.EnableEvents()
Else
'// Raise Initialization problems
Dim sErrTxt As String = New Win32Exception().Message
Throw New CIOChannelException("Unable to open COM" + miPort.ToString + ControlChars.CrLf + sErrTxt)
End If
Catch Ex As Exception
'// Generica error
Throw New CIOChannelException(Ex.Message, Ex)
End Try
Else
'// Port not defined, cannot open
Throw New ApplicationException("COM Port not defined,use Port property to set it before invoking InitPort")
End If
End Sub
Public Overloads Sub Open(ByVal Port As Integer, ByVal BaudRate As Integer, ByVal DataBit As Integer, ByVal Parity As DataParity, ByVal StopBit As DataStopBit, ByVal BufferSize As Integer)
'===================================================
'
' Description: Opens comunication port (Overloaded method)
' Created : 21/09/2001 - 11:33:40
'
' *Parameters Info*
'
' Notes :
'===================================================
Me.Port = Port
Me.BaudRate = BaudRate
Me.DataBit = DataBit
Me.Parity = Parity
Me.StopBit = StopBit
Me.BufferSize = BufferSize
Open()
End Sub
Public Sub Close()
'===================================================
'
' Description: Close comunication channel
' Created : 21/09/2001 - 11:38:00
'
' *Parameters Info*
'
' Notes :
'===================================================
If mhRS.ToInt32 > 0 Then
If mbEnableEvents = True Then
Me.DisableEvents()
End If
Dim ret As Boolean = CloseHandle(mhRS)
If Not ret Then Throw New Win32Exception
mhRS = New IntPtr(0)
End If
End Sub
ReadOnly Property IsOpen() As Boolean
'===================================================
'
' Description: Returns Port Status
' Created : 21/09/2001 - 11:38:51
'
' *Parameters Info*
'
' Notes :
'===================================================
Get
Return CBool(mhRS.ToInt32 > 0)
End Get
End Property
Public Overloads Sub Write(ByVal Buffer As Byte())
'===================================================
'
' Description: Transmit a stream
' Created : 21/09/2001 - 11:39:51
'
' *Parameters Info*
' Buffer : Array of Byte() to write
' Notes :
'===================================================
Dim iRc, iBytesWritten As Integer, hOvl As GCHandle
'-----------------------------------------------------------------
muOvlW = New Overlapped
If mhRS.ToInt32 <= 0 Then
Throw New ApplicationException("Please initialize and open port before using this method")
Else
'// Creates Event
Try
hOvl = GCHandle.Alloc(muOvlW, GCHandleType.Pinned)
muOvlW.hEvent = CreateEvent(Nothing, 1, 0, Nothing)
If muOvlW.hEvent.ToInt32 = 0 Then Throw New ApplicationException("Error creating event for overlapped writing")
'// Clears IO buffers and sends data
iRc = WriteFile(mhRS, Buffer, Buffer.Length, 0, muOvlW)
If iRc = 0 Then
If Marshal.GetLastWin32Error <> ERROR_IO_PENDING Then
Throw New ApplicationException("Write command error")
Else
'// Check Tx results
If GetOverlappedResult(mhRS, muOvlW, iBytesWritten, 1) = 0 Then
Throw New ApplicationException("Write pending error")
Else
'// All bytes sent?
If iBytesWritten <> Buffer.Length Then Throw New ApplicationException("Write Error - Bytes Written " & iBytesWritten.ToString & " of " & Buffer.Length.ToString)
End If
End If
End If
Finally
'//Closes handle
CloseHandle(muOvlW.hEvent)
If (hOvl.IsAllocated = True) Then hOvl.Free()
End Try
End If
End Sub
Public Overloads Sub Write(ByVal Buffer As String)
'===================================================
'
' Description : Writes a string to RS232
' Created : 04/02/2002 - 8:46:42
'
' *Parameters Info*
'
' Notes : 24/05/2002 Fixed problem with ASCII Encoding
'===================================================
Dim oEncoder As New System.Text.ASCIIEncoding
Dim oEnc As Encoding = oEncoder.GetEncoding(1252)
'-------------------------------------------------------------
Dim aByte() As Byte = oEnc.GetBytes(Buffer)
Me.Write(aByte)
End Sub
Public Function Read(ByVal Bytes2Read As Integer) As Integer
'===================================================
'
' Description: Read Bytes from Port
' Created : 21/09/2001 - 11:41:17
'
' *Parameters Info*
' Bytes2Read : Bytes to read from port
' Returns : Number of readed chars
'
' Notes :
'===================================================
Dim iReadChars, iRc As Integer, bReading As Boolean, hOvl As GCHandle
'--------------------------------------------------------------
'// If Bytes2Read not specified uses Buffersize
If Bytes2Read = 0 Then Bytes2Read = miBufferSize
muOvlR = New Overlapped
If mhRS.ToInt32 <= 0 Then
Throw New ApplicationException("Please initialize and open port before using this method")
Else
'// Get bytes from port
Try
hOvl = GCHandle.Alloc(muOvlR, GCHandleType.Pinned)
muOvlR.hEvent = CreateEvent(Nothing, 1, 0, Nothing)
If muOvlR.hEvent.ToInt32 = 0 Then Throw New ApplicationException("Error creating event for overlapped reading")
'// Clears IO buffers and reads data
ReDim mabtRxBuf(Bytes2Read - 1)
iRc = ReadFile(mhRS, mabtRxBuf, Bytes2Read, iReadChars, muOvlR)
If iRc = 0 Then
If Marshal.GetLastWin32Error() <> ERROR_IO_PENDING Then
Throw New ApplicationException("Read pending error")
Else
'// Wait for characters
iRc = WaitForSingleObject(muOvlR.hEvent, miTimeout)
Select Case iRc
Case WAIT_OBJECT_0
'// Some data received...
If GetOverlappedResult(mhRS, muOvlR, iReadChars, 0) = 0 Then
Throw New ApplicationException("Read pending error.")
Else
Return iReadChars
End If
Case WAIT_TIMEOUT
Throw New IOTimeoutException("Read Timeout.")
Case Else
Throw New ApplicationException("General read error.")
End Select
End If
Else
Return (iReadChars)
End If
Finally
'//Closes handle
CloseHandle(muOvlR.hEvent)
If (hOvl.IsAllocated) Then hOvl.Free()
End Try
End If
End Function
Overridable ReadOnly Property InputStream() As Byte()
'===================================================
'
' Description: Returns received data as Byte()
' Created : 21/09/2001 - 11:45:06
'
' *Parameters Info*
'
' Notes :
'===================================================
Get
Return mabtRxBuf
End Get
End Property
Overridable ReadOnly Property InputStreamString() As String
'===================================================
'
' Description : Return a string containing received data
' Created : 04/02/2002 - 8:49:55
'
' *Parameters Info*
'
' Notes :
'===================================================
Get
Dim oEncoder As New System.Text.ASCIIEncoding
Dim oEnc As Encoding = oEncoder.GetEncoding(1252)
'-------------------------------------------------------------
If Not Me.InputStream Is Nothing Then Return oEnc.GetString(Me.InputStream)
End Get
End Property
Public Sub ClearInputBuffer()
'===================================================
'
' Description: Clears Input buffer
' Created : 21/09/2001 - 11:45:34
'
' *Parameters Info*
'
' Notes : Gets all character until end of buffer
'===================================================
If mhRS.ToInt32 > 0 Then
PurgeComm(mhRS, PURGE_RXCLEAR)
End If
End Sub
Public WriteOnly Property Rts() As Boolean
'===================================================
'
' Description: Set/Resets RTS Line
' Created : 21/09/2001 - 11:45:34
'
' *Parameters Info*
'
' Notes :
'===================================================
Set(ByVal Value As Boolean)
If mhRS.ToInt32 > 0 Then
If Value Then
EscapeCommFunction(mhRS, Lines.SetRts)
Else
EscapeCommFunction(mhRS, Lines.ClearRts)
End If
End If
End Set
End Property
Public WriteOnly Property Dtr() As Boolean
'===================================================
'
' Description: Set/Resets DTR Line
' Created : 21/09/2001 - 11:45:34
'
' *Parameters Info*
'
' Notes :
'===================================================
Set(ByVal Value As Boolean)
If mhRS.ToInt32 > 0 Then
If Value Then
EscapeCommFunction(mhRS, Lines.SetDtr)
Else
EscapeCommFunction(mhRS, Lines.ClearDtr)
End If
End If
End Set
End Property
Public ReadOnly Property ModemStatus() As ModemStatusBits
'===================================================
'
' Description : Gets Modem status
' Created : 28/02/2002 - 8:58:04
'
' *Parameters Info*
'
' Notes :
'===================================================
Get
If mhRS.ToInt32 <= 0 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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -