📄 crs232.vb
字号:
'
' Notes :
'===================================================
If portNumber <= 0 Then
Return False
Else
Dim cfg As COMMCONFIG
Dim cfgsize As Int32 = Marshal.SizeOf(cfg)
cfg.dwSize = cfgsize
Dim ret As Boolean = GetDefaultCommConfig("COM" + portNumber.ToString, cfg, cfgsize)
Return ret
End If
End Function
Public Sub SetBreak()
'===================================================
' ?003 www.codeworks.it All rights reserved
'
' Description : Set COM in break modem
' Created : 12/10/03 - 10:00:57
' Author : Corrado Cavalli
'
' *Parameters Info*
'
'
' Notes :
'===================================================
If mhRS.ToInt32 > 0 Then
If SetCommBreak(mhRS) = False Then Throw New Win32Exception
End If
End Sub
Public Sub ClearBreak()
'===================================================
' ?003 www.codeworks.it All rights reserved
'
' Description : Clear COM break mode
' Created : 12/10/03 - 10:02:57
' Author : Corrado Cavalli
'
' *Parameters Info*
'
'
' Notes :
'===================================================
If mhRS.ToInt32 > 0 Then
If ClearCommBreak(mhRS) = False Then Throw New Win32Exception
End If
End Sub
Public ReadOnly Property InBufferCount() As Int32
'===================================================
' ?003 www.codeworks.it All rights reserved
'
' Description : Returns the number of bytes inside Rx buffer
' Created : 20/04/05 - 10:02:57
' Author : Corrado Cavalli/Jean-Pierre ZANIER
'
'
'===================================================
Get
Dim comStat As COMSTAT
Dim lpErrCode As Int32
Dim iRc As Int32
comStat.cbInQue = 0
If mhRS.ToInt32 > 0 Then
iRc = ClearCommError(mhRS, lpErrCode, comStat)
Return comStat.cbInQue
End If
Return 0
End Get
End Property
#Region "Finalize"
Protected Overrides Sub Finalize()
'===================================================
'
' Description : Closes COM port if object is garbage collected and still owns
' COM port reosurces
'
' Created : 27/05/2002 - 19:05:56
'
' *Parameters Info*
'
' Notes :
'===================================================
Try
If Not mbDisposed Then
If mbEnableEvents Then Me.DisableEvents()
Close()
End If
Finally
MyBase.Finalize()
End Try
End Sub
#End Region
#Region "Private Routines"
Private Sub pSetTimeout()
'===================================================
'
' Description: Set comunication timeouts
' Created : 21/09/2001 - 11:46:40
'
' *Parameters Info*
'
' Notes :
'===================================================
Dim uCtm As COMMTIMEOUTS
'// Set ComTimeout
If mhRS.ToInt32 <= 0 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 pDispose() Implements IDisposable.Dispose
'===================================================
'
' Description : Handles correct class disposing Write
' Created : 27/05/2002 - 19:03:06
'
' *Parameters Info*
'
' Notes :
'===================================================
If (Not mbDisposed AndAlso (mhRS.ToInt32 > 0)) Then
'// Closes Com Port releasing resources
Try
Me.Close()
Finally
mbDisposed = True
'// Suppress unnecessary Finalize overhead
GC.SuppressFinalize(Me)
End Try
End If
End Sub
Private Sub pEventsWatcher()
'===================================================
' ?003 www.codeworks.it All rights reserved
'
' Description : Watches for all events raising events when they arrive to the port
' Created : 15/07/03 - 11:45:13
' Author : Corrado Cavalli
'
' *Parameters Info*
'
' Notes :
'===================================================
'// Events to watch
Dim lMask As EventMasks = EventMasks.Break Or EventMasks.CarrierDetect Or EventMasks.ClearToSend Or _
EventMasks.DataSetReady Or EventMasks.Ring Or EventMasks.RxChar Or EventMasks.RXFlag Or _
EventMasks.StatusError
Dim lRetMask As EventMasks, iBytesRead, iTotBytes, iErrMask As Int32, iRc As Int32, aBuf As New ArrayList
Dim uComStat As COMSTAT
'-----------------------------------
'// Creates Event
muOvlE = New Overlapped
Dim hOvlE As GCHandle = GCHandle.Alloc(muOvlE, GCHandleType.Pinned)
muOvlE.hEvent = CreateEvent(Nothing, 1, 0, Nothing)
If muOvlE.hEvent.ToInt32 = 0 Then Throw New ApplicationException("Error creating event for overlapped reading")
'// Set mask
SetCommMask(mhRS, lMask)
'// Looks for RxChar
While mbEnableEvents = True
WaitCommEvent(mhRS, lMask, muOvlE)
Select Case WaitForSingleObject(muOvlE.hEvent, INFINITE)
Case WAIT_OBJECT_0
'// Event (or abort) detected
If mbEnableEvents = False Then Exit While
If (lMask And EventMasks.RxChar) > 0 Then
'// Read incoming data
ClearCommError(mhRS, iErrMask, uComStat)
If iErrMask = 0 Then
Dim ovl As New Overlapped
Dim hOvl As GCHandle = GCHandle.Alloc(ovl, GCHandleType.Pinned)
ReDim mabtRxBuf(uComStat.cbInQue - 1)
If ReadFile(mhRS, mabtRxBuf, uComStat.cbInQue, iBytesRead, ovl) > 0 Then
If iBytesRead > 0 Then
'// Some bytes read, fills temporary buffer
If iTotBytes < miBufThreshold Then
aBuf.AddRange(mabtRxBuf)
iTotBytes += iBytesRead
End If
'// Threshold reached?, raises event
If iTotBytes >= miBufThreshold Then
'//Copies temp buffer into Rx buffer
ReDim mabtRxBuf(iTotBytes - 1)
aBuf.CopyTo(mabtRxBuf)
'// Raises event
Try
Me.OnCommEventReceived(Me, lMask)
Finally
iTotBytes = 0
aBuf.Clear()
End Try
End If
End If
End If
If (hOvl.IsAllocated) Then hOvl.Free()
End If
Else
'// Simply raises OnCommEventHandler event
Me.OnCommEventReceived(Me, lMask)
End If
Case Else
Dim sErr As String = New Win32Exception().Message
Throw New ApplicationException(sErr)
End Select
End While
'// Release Event Handle
CloseHandle(muOvlE.hEvent)
muOvlE.hEvent = IntPtr.Zero
If (hOvlE.IsAllocated) Then hOvlE.Free()
muOvlE = Nothing
End Sub
#End Region
#Region "Protected Routines"
Protected Sub OnCommEventReceived(ByVal source As Rs232, ByVal mask As EventMasks)
'===================================================
' ?003 www.codeworks.it All rights reserved
'
' Description : Raises CommEvent
' Created : 15/07/03 - 15:09:50
' Author : Corrado Cavalli
'
' *Parameters Info*
'
' Notes :
'===================================================
Dim del As CommEventHandler = Me.CommEventEvent
If (Not del Is Nothing) Then
Dim SafeInvoker As ISynchronizeInvoke
Try
SafeInvoker = DirectCast(del.Target, ISynchronizeInvoke)
Catch
End Try
If (Not SafeInvoker Is Nothing) Then
SafeInvoker.Invoke(del, New Object() {source, mask})
Else
del.Invoke(source, mask)
End If
End If
End Sub
#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
'
' 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
'===================================================
'
' Description : Timeout customized exception
' Created : 28/02/2002 - 10:43:43
'
' *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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -