丹佛斯（Danfoss FC51）与VB6.0 串口RS485通讯实例通过实验室功能测试和现在使用稳定性测试，VB源码如下：‘****************************************************************************** ******************************************************************************* *******************************************************************************Dim HiByte As ByteDim LoByte As ByteDim CRC16Lo As ByteDim CRC16Hi As ByteDim ReturnData(1) As ByteDim k As IntegerPrivate Sub Command1_Click()k = Text9.Text '写6 个字节'=========== 数组赋值输入代码=============================================================================== ========'<< 算法一>>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))NextMSComm1.Output = WriteStr'写命令发送后,当接收到8 个字节时中断CmdLenth = 8MSComm1.RThreshold = CmdLenthEnd SubPrivate Sub Command2_Click()EndEnd SubPrivate Sub Command3_Click()Dim inx() As ByteSelect Case mEventCase comEvReceive '判断为接收事件MSComm1.InputLen = CmdLenth '接收数据的长度inx = MSComm1.Input '接收数据MSComm1.InBufferCount = 0For k = 3 To CmdLenth - 3tmpstr = tmpstr & "/" & Hex(inx(k))NextText14.Text = tmpstr '以十六进制显示所接收长度的数据BeepEnd Select' Dim n As Integer' Dim tmp As String' Do While Len(tmp) < 8' tmp = tmp + MSComm1.Input' n = n + 1' If n >= 3000 Then' MSComm1.PortOpen = False'' End If' Loop' tmp = Mid$(tmp, 2, 4)' Text13.Text = tmp'Word_Read = Hex2Dec(Right$(tmp, 2) + Left$(tmp, 2))' MSComm1.PortOpen = FalseEnd SubPrivate Sub Form_Load()MSComm1.Settings = "9600,N,8,1"mPort = 1MSComm1.SThreshold = 0If Not MSComm1.PortOpen Then MSComm1.PortOpen = True End 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 CRC16(ByRef cmdstring() As Byte, ByVal j As Integer)Dim data As IntegerDim I As IntegerAddressreg_crc = &HFFFFFor I = 0 To jAddressreg_crc = Addressreg_crc Xor cmdstring(I)For j = 0 To 7data = Addressreg_crc And &H1If data ThenAddressreg_crc = Int(Addressreg_crc / 2) '右移1位,除2取整就可以做到右移。

Addressreg_crc = Addressreg_crc And &H7FFF '最高位用“0”补齐Addressreg_crc = Addressreg_crc Xor &HA001 '与A001异或ElseAddressreg_crc = Addressreg_crc / 2 '右移1位Addressreg_crc = Addressreg_crc And &H7FFF '最高位用“0”补齐End IfNext jNext IIf Addressreg_crc < 0 ThenAddressreg_crc = Addressreg_crc - &HFFFF0000End IfLoByte = Addressreg_crc And &HFFHiByte = (Addressreg_crc And &HFF00) / &H100End Function'========== 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 7SaveHi = CRC16HiSaveLo = CRC16LoCRC16Hi = 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 Function。