vb.net写的串口通讯类模块 源码

以下是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