以下是vb.net写的串口 通讯模块代码,主要分类打开串口,关闭串口,发送数据,数据转换,包括了ASCII和CRC16?MODBUS通讯协议两种:
Imports System.IO.Ports
Module SerialModule
Public SendHex As String = "" '发送中的缓存数据
Public PlcName As String = "COM1", PlcNum As Integer = 1, PlcCOM As New IO.Ports.SerialPort '显示屏串口与屏号
Public WeighNum As Integer = 1, Weigh1 As Integer = 0, Weigh2 As Integer = 0, Weigh3 As Integer = 0, Weigh4 As Integer = 0, Weigh5 As Integer = 0, Weigh6 As Integer = 0
Public Car1Min As Integer = 1000, Car1Max As Integer = 1800, Car1Dist As Integer = 100
Public Car2Min As Integer = 1000, Car2Max As Integer = 1800, Car2Dist As Integer = 100
'Function StrDup(Str As String, Optional len As Integer = 4, Optional Character As String = "0") As String
' Dim n As Integer = len - Str.Length
' If n <= 0 Then Return Str.Substring(0, len)
' Return Strings.StrDup(n, Character) & Str
'End Function
Sub PortList(Combox As ComboBox, Optional COMM As String = "")
For Each R As String In SerialPort.GetPortNames()
Combox.Items.Add(R)
Next
Combox.Text = COMM
End Sub
Function PortOpen(Port As SerialPort, COMM As String) As Boolean
If Port.IsOpen = True Then Port.Close()
Try
Port.PortName = COMM
Port.Open()
Catch ex As Exception
End Try
Return Port.IsOpen
End Function
Sub PortClose(Port As SerialPort)
If Port.IsOpen = True Then Port.Close()
End Sub
Function PortSendHex(Port As SerialPort, data As String, Optional ReadLen As Integer = 10) As String
Dim WStr As String = data.Replace("-", "")
WStr &= CRC16(WStr)
SendHex = WStr
If Port.IsOpen = False Then Return ""
Dim bytes() As Byte = HexToByte(WStr), Buffer As Byte() = New Byte(8192) {}, Len As Integer, RStr As String = "", StartTick As Long = Now.Ticks
Port.Write(bytes, 0, bytes.Length)
Do
Threading.Thread.Sleep(1)
Len = Port.BytesToRead
If Len > 0 Then
Port.Read(Buffer, 0, Len)
For i As Integer = 0 To Len - 1
RStr &= Buffer(i).ToString("X2")
Next
End If
Loop While RStr.Length < ReadLen AndAlso Now.Ticks - StartTick < 10000 * 500
Return RStr
End Function
Function PortSendASCII(Port As SerialPort, data As String) As String
Dim WStr As String = "3A" & ToHex(data.Replace("-", ""))
WStr &= LRC(WStr) & "0D0A" '校验
SendHex = WStr
If Port.IsOpen = False Then Return ""
Dim bytes() As Byte = HexToByte(WStr), Buffer As Byte() = New Byte(8192) {}, Len As Integer, RStr As String = "", StartTick As Long = Now.Ticks
Port.Write(bytes, 0, bytes.Length)
Do
Threading.Thread.Sleep(1)
Len = Port.BytesToRead
If Len > 0 Then
Port.Read(Buffer, 0, Len)
For i As Integer = 0 To Len - 1
RStr &= Buffer(i).ToString("X2")
Next
End If
Loop While RStr.Contains("0D0A") = False AndAlso Now.Ticks - StartTick < 10000 * 500
Return ToAsc(RStr)
End Function
Function ToHex(str As String) As String
Dim RStr As String = ""
For i As Integer = 0 To str.Length - 1
RStr &= Asc(str.Substring(i, 1)).ToString("X2")
Next
Return RStr
End Function
Function ToAsc(Hex As String) As String
Dim RStr As String = "", len As Integer = Hex.Length / 2
For i As Integer = 0 To len - 1
RStr &= Chr(CByte("&H" & Hex.Substring(i * 2, 2)))
Next
Return RStr
End Function
Function HexToByte(Hex As String) As Byte()
Dim len As Integer = Hex.Length / 2, bytes(len - 1) As Byte
For i As Integer = 0 To len - 1
bytes(i) = CByte("&H" & Hex.Substring(i * 2, 2))
Next
Return bytes
End Function
Function ByteToHex(bytes() As Byte) As String
Dim RStr As String = ""
For i As Integer = 0 To bytes.Length - 1
RStr &= bytes(i).ToString("X2")
Next
Return RStr
End Function
Function LRC(Str As String) As String
Dim len As Integer = Str.Length / 2, sum As Integer = 0 '校验
For i As Integer = 0 To len - 1
sum += CByte("&H" & Str.Substring(i * 2, 2))
Next
Return (sum Mod 256).ToString("X2")
End Function
Function CRC16(Str As String) As String
Dim len As Integer = Str.Length / 2, crc As UInt16 = &HFFFF '校验
For i As Integer = 0 To len - 1
crc = crc Xor CByte("&H" & Str.Substring(i * 2, 2))
For j As Integer = 1 To 8
If crc Mod 2 = 1 Then
crc = (crc \ 2) Xor &HA001
Else
crc = crc \ 2
End If
Next
Next
Str = crc.ToString("X4")
Return Str.Substring(2) & Str.Substring(0, 2) '高低反位
End Function
Function HexToInt(Str As String) As Integer
If Str = "00000000" OrElse Str = "FFFFFFFF" Then Return 0
If CByte("&H" & Str.Substring(0, 2)) <= &H7F Then Return CInt("&H" & Str)
Return -(4294967295 - CUInt("&H" & Str))
End Function
Function IntToHex(v As Integer) As String
If v = 0 Then Return "00000000"
If v > 0 Then
Dim R As String = v.ToString("X8")
Return R.Substring(4) & R.Substring(0, 4) '高低反位
End If
Dim Str As String = (4294967295 + v).ToString("X8")
Return Str.Substring(4) & Str.Substring(0, 4) '高低反位
End Function
End Module
|