VB控件Mscomm控件与PLC进行RS485(Modbus)通讯源码本人用的是Modbus RTU通讯模式，通过计算机串口转RS485与外围设备通行通讯，读写外围设备指定地址里的数据，从而达到自动化控制远端设备。

Dim HiByte As ByteDim LoByte As ByteDim CRC16Lo As ByteDim CRC16Hi As ByteDim ReturnData(1) As ByteDim K As IntegerDim CmdLenth As IntegerPrivate Sub Command1_Click()K = Text9.Text '写6 个字节Text13.Text = ""'=========== 数组赋值输入代码=============================================================================== ========'<< 算法一>>Dim WriteStr() As ByteDim u As IntegerReDim WriteStr(K + 2)For u = 0 To KWriteStr(u) = Val("&H" & Text1(u).Text)Next'<< 算法二>>Dim CRC_2() As ByteDim v As IntegerReDim CRC_2(K)For v = 0 To KCRC_2(v) = Val("&H" & Text1(v).Text)Next'============================================================================== ====================Call CRC161(CRC_2())Call CRC16(WriteStr(), K)MSComm1.InBufferCount = 0'========== 显示发送代码=============================================================================== =========Dim m As IntegerFor m = 0 To 23If m <= K ThenText8(m).Text = Hex(WriteStr(m))ElseText8(m).Text = ""End IfNext'============================================================================== ====================WriteStr(K + 1) = LoByteWriteStr(K + 2) = HiByte' 发送代码Text4.Text = ""Dim g As IntegerFor g = 0 To K + 2Text4.Text = Text4.Text + " " + Hex(WriteStr(g))Next'写命令发送后,当接收到8 个字节时中断CmdLenth = 8MSComm1.RThreshold = CmdLenthMSComm1.Output = WriteStrEnd SubPrivate Sub Command2_Click()EndEnd SubPrivate Sub Command3_Click()Label34.Caption = "="Text13.Text = ""K = Text9.Text '写6 个字节'=========== 数组赋值输入代码=============================================================================== ========'<< 算法>>Dim CRC_2() As ByteDim v As IntegerReDim CRC_2(K)For v = 0 To KCRC_2(v) = Val("&H" & Text1(v).Text)Next'============================================================================== ====================Call CRC161(CRC_2())Call CRC16(WriteStr(), K)MSComm1.InBufferCount = 0'========== 显示发送代码=============================================================================== =========Dim m As IntegerFor m = 0 To 23If m <= K ThenText8(m).Text = Hex(WriteStr(m))ElseText8(m).Text = ""End IfNext'============================================================================== ====================WriteStr(K + 1) = LoByteWriteStr(K + 2) = HiByte' 发送代码Text4.Text = ""Dim g As IntegerFor g = 0 To K + 2Text4.Text = Text4.Text + " " + Hex(WriteStr(g))Next'读命令发送后,当接收5 + SendStr(5) * 2 个字节时产生中断CmdLenth = 5 + WriteStr(5) * 2MSComm1.RThreshold = CmdLenthMSComm1.Output = WriteStr '发送命令'****************************************************************************** **********************************************************'*******************************************************************************************************************'****************************************************************************** **********************************************************' Dim sAddr As String'' Dim CheckString As String' Dim CheckCode As String' Dim CmdCode As String' Dim Sum As Integer' Dim a As Integer' Dim tmp As String'a = 0'tmp = 0'''' Do While Len(tmp) < 8'' tmp = tmp + MSComm1.Input' testNO.Caption = testNO.Caption + " " + Str(Hex(Asc(tmp)))' a = a + 1' If a >= 3000 Then' MSComm1.PortOpen = False'Exit Function' Exit Do' End If' Loop'Label33.Caption = tmp'Text16.Text = Len(tmp)'Dim ns As Integer'For ns = 1 To Len(tmp)'Label34.Caption = Label34.Caption + "+" + Str(Asc(Mid(tmp, ns, 1))) ''Next'Label35.Caption = Str(Val(Asc(Mid(tmp, 6, 1))) / 10)''' tmp = Mid$(tmp, 6, 4)''' Dim strHex As String' Dim Hex2Dec As Long' Dim strTmp As String' Dim longTmp As Long' Dim longDec As Long' Dim intLen As Integer' Dim n1 As Integer'' strHex = Right$(tmp, 2) + Left$(tmp, 2)'' intLen = Len(strHex)' For n1 = 1 To intLen' strTmp = Mid(strHex, n1, 1)' Select Case Asc(strTmp)' Case 48 To 57' longTmp = Val(strTmp)' Case 65 To 70' longTmp = Asc(strTmp) - 55' Case Else' Hex2Dec = 0' ' Exit Function' End Select' Text13.Text = Text13.Text + "+" + Str(Asc(strTmp))' longDec = longDec + longTmp * 16 ^ (intLen - n1)' Next n1'' Hex2Dec = longDec' Text13.Text = Hex2Dec'****************************************************************************** **********************************************************'*******************************************************************************************************************'****************************************************************************** **********************************************************End SubPrivate Sub MSComm1_OnComm()Dim Ne As IntegerSelect Case mEventCase comEvReceiveDim Buffer As VariantMSComm1.InputMode = comInputModeBinaryMSComm1.InputLen = 0Buffer = MSComm1.InputFor Ne = LBound(Buffer) To UBound(Buffer)Text13.Text = Text13.Text & " + " & Buffer(Ne)Label34.Caption = Buffer(3) & " " & Buffer(4)Next NeCase ElseEnd SelectBeepEnd SubPrivate Sub Command4_Click()End SubPrivate Sub Command5_Click()Label34.Caption = "="Private Sub Form_Load()MSComm1.Settings = "9600,N,8,1"mPort = 1MSComm1.SThreshold = 0If Not MSComm1.PortOpen Then MSComm1.PortOpen = TrueEnd SubPrivate Sub Timer1_Timer()'显示<< 算法一>>结果Text2.Text = Hex(HiByte)Text3.Text = Hex(LoByte)'显示<< 算法二>>结果Text6.Text = Hex(CRC16Hi)Text7.Text = Hex(CRC16Lo)If Text5.Text <> "" Then '十进制转十六进制Text10.Text = Hex(Text5.Text)End IfIf Text11.Text <> "" Then '十六进制转十进制Text12.Text = Val("&H" & Text11.Text)End IfText14.Text = MSComm1.OutBufferCountEnd Sub'========== CRC校验<< 算法二>> =============================================================================== =========Function CRC161(data() As Byte) As String 'CRC计算函数' Dim CRC16Lo As Byte, CRC16Hi As Byte 'CRC寄存器Dim CL As Byte, CH As Byte '多项式码&HA001Dim SaveHi As Byte, SaveLo As ByteDim I As IntegerDim Flag As IntegerCRC16Lo = &HFFCRC16Hi = &HFFCL = &H1CH = &HA0For I = 0 To UBound(data)CRC16Lo = CRC16Lo Xor data(I) '每一个数据与CRC寄存器进行异或For Flag = 0 To 7CRC16Hi = CRC16Hi \ 2 '高位右移一位CRC16Lo = CRC16Lo \ 2 '低位右移一位If ((SaveHi And &H1) = &H1) Then '如果高位字节最后一位为1CRC16Lo = CRC16Lo Or &H80 '则低位字节右移后前面补1End If '否则自动补0If ((SaveLo And &H1) = &H1) Then '如果LSB为1，则与多项式码进行异或CRC16Hi = CRC16Hi Xor CHCRC16Lo = CRC16Lo Xor CLEnd IfNext FlagNext IDim ReturnData(1) As ByteReturnData(0) = CRC16Hi 'CRC高位ReturnData(1) = CRC16Lo 'CRC低位asd = Right("00" + Hex(CRC16Lo), 2) + Right("00" + Hex(CRC16Hi), 2) End FunctionPrivate Sub mscomm_OnComm()End Sub。