丹佛斯(Danfoss FC51)与VB6.0 串口RS485通讯实例

丹佛斯（Danfoss FC51）与VB6.0 串口RS485通讯实例

通过实验室功能测试和现在使用稳定性测试，VB源码如下：

‘****************************************************************************** ******************************************************************************* *******************************************************************************

Dim HiByte As Byte

Dim LoByte As Byte

Dim CRC16Lo As Byte

Dim CRC16Hi As Byte

Dim ReturnData(1) As Byte

Dim k As Integer

Private Sub Command1_Click()

k = Text9.Text '写6 个字节

'=========== 数组赋值输入代码=============================================================================== ========

'<< 算法一>>

Dim WriteStr() As Byte

Dim u As Integer

ReDim WriteStr(k + 2)

For u = 0 To k

WriteStr(u) = Val("&H" & Text1(u).Text)

Next

'<< 算法二>>

Dim CRC_2() As Byte

Dim v As Integer

ReDim CRC_2(k)

For v = 0 To k

CRC_2(v) = Val("&H" & Text1(v).Text)

Next

'============================================================================== ====================

Call CRC161(CRC_2())

Call CRC16(WriteStr(), k)

MSComm1.InBufferCount = 0

'========== 显示发送代码=============================================================================== =========

Dim m As Integer

For m = 0 To 23

If m <= k Then

Text8(m).Text = Hex(WriteStr(m))

Else

Text8(m).Text = ""

End If

Next

'============================================================================== ====================

WriteStr(k + 1) = LoByte

WriteStr(k + 2) = HiByte

' 发送代码

Text4.Text = ""

Dim g As Integer

For g = 0 To k + 2

Text4.Text = Text4.Text + " " + Hex(WriteStr(g))

Next

MSComm1.Output = WriteStr

'写命令发送后,当接收到8 个字节时中断

CmdLenth = 8

MSComm1.RThreshold = CmdLenth

End Sub

Private Sub Command2_Click()

End

End Sub

Private Sub Command3_Click()

Dim inx() As Byte

Select Case https://www.360docs.net/doc/03501052.html,mEvent

Case comEvReceive '判断为接收事件

MSComm1.InputLen = CmdLenth '接收数据的长度

inx = MSComm1.Input '接收数据

MSComm1.InBufferCount = 0

For k = 3 To CmdLenth - 3

tmpstr = tmpstr & "/" & Hex(inx(k))

Next

Text14.Text = tmpstr '以十六进制显示所接收长度的数据Beep

End 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 = False

End Sub

Private Sub Form_Load()

MSComm1.Settings = "9600,N,8,1"

https://www.360docs.net/doc/03501052.html,mPort = 1

MSComm1.SThreshold = 0

If Not MSComm1.PortOpen Then MSComm1.PortOpen = True End Sub

Private 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 If

If Text11.Text <> "" Then '十六进制转十进制

Text12.Text = Val("&H" & Text11.Text)

End If

Text14.Text = MSComm1.OutBufferCount

End Sub

'========== CRC校验<< 算法一>> =============================================================================== =========

Function CRC16(ByRef cmdstring() As Byte, ByVal j As Integer)

Dim data As Integer

Dim I As Integer

Addressreg_crc = &HFFFF

For I = 0 To j

Addressreg_crc = Addressreg_crc Xor cmdstring(I)

For j = 0 To 7

data = Addressreg_crc And &H1

If data Then

Addressreg_crc = Int(Addressreg_crc / 2) '右移1位,除2取整就可以做到右移。Addressreg_crc = Addressreg_crc And &H7FFF '最高位用“0”补齐

Addressreg_crc = Addressreg_crc Xor &HA001 '与A001异或

Else

Addressreg_crc = Addressreg_crc / 2 '右移1位

Addressreg_crc = Addressreg_crc And &H7FFF '最高位用“0”补齐

End If

Next j

Next I

If Addressreg_crc < 0 Then

Addressreg_crc = Addressreg_crc - &HFFFF0000

End If

LoByte = Addressreg_crc And &HFF

HiByte = (Addressreg_crc And &HFF00) / &H100

End 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 '多项式码&HA001

Dim SaveHi As Byte, SaveLo As Byte

Dim I As Integer

Dim Flag As Integer

CRC16Lo = &HFF

CRC16Hi = &HFF

CL = &H1

CH = &HA0

For I = 0 To UBound(data)

CRC16Lo = CRC16Lo Xor data(I) '每一个数据与CRC寄存器进行异或

For Flag = 0 To 7

SaveHi = CRC16Hi

SaveLo = CRC16Lo

CRC16Hi = CRC16Hi \ 2 '高位右移一位

CRC16Lo = CRC16Lo \ 2 '低位右移一位

If ((SaveHi And &H1) = &H1) Then '如果高位字节最后一位为1

CRC16Lo = CRC16Lo Or &H80 '则低位字节右移后前面补1

End If '否则自动补0

If ((SaveLo And &H1) = &H1) Then '如果LSB为1，则与多项式码进行异或

CRC16Hi = CRC16Hi Xor CH

CRC16Lo = CRC16Lo Xor CL

End If

Next Flag

Next I

Dim ReturnData(1) As Byte

ReturnData(0) = CRC16Hi 'CRC高位

ReturnData(1) = CRC16Lo 'CRC低位

asd = Right("00" + Hex(CRC16Lo), 2) + Right("00" + Hex(CRC16Hi), 2)

End Function