📄 crs232.vb
字号:
<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)
'===================================================
' ?003 ALSTOM FIR S.p.A All rights reserved
'
' Description : Purge Communication Buffer
' Created : 01/09/03 - 10:37:39
' Author : Corrado Cavalli
'
' *Parameters Info*
'
' Notes : This method will clear any character into buffer, use TxAbort/RxAbort
' to terminate any pending overlapped Tx/Rx operation.
'===================================================
If (mhRS.ToInt32 > 0) Then PurgeComm(mhRS, Mode)
End Sub
Public Overridable Property Timeout() As Integer
'===================================================
'
' Description: Comunication timeout in seconds
' Created : 21/09/2001 - 11:26:50
'
' *Parameters Info*
'
' Notes :
'===================================================
Get
Return miTimeout
End Get
Set(ByVal Value As Integer)
miTimeout = CInt(IIf(Value = 0, 500, Value))
'// If Port is open updates it on the fly
pSetTimeout()
End Set
End Property
Public Property Parity() As DataParity
'===================================================
'
' Description : Comunication parity
' Created : 21/09/2001 - 11:27:15
'
' *Parameters Info*
'
' Notes :
'===================================================
Get
Return meParity
End Get
Set(ByVal Value As DataParity)
meParity = Value
End Set
End Property
Public Property StopBit() As DataStopBit
'===================================================
'
' Description: Comunication StopBit
' Created : 21/09/2001 - 11:27:37
'
' *Parameters Info*
'
' 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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -