VB编写的Modbus RTU协议通讯源程序
深圳铭阳电子 https://www.doczj.com/doc/d24826372.html, qq:1575850298
1） 模块文件：modCRC，其中包含了CRC校验的函数。
'data 待校验的数组名称
'no 数组中元素个数
'btLoCRC 算出的CRC高字节
'btHiCRC 算出的CRC低字节
Public Function CalCRC16Fast(data() As Byte, no As Integer, btLoCRC As Byte, btHiCRC As Byte) As String
Dim CL As Byte, CH As Byte '多项式码&HA001
Dim SaveHi As Byte, SaveLo As Byte
Dim i As Integer
Dim Flag As Integer
btHiCRC = &HFF
btLoCRC = &HFF
CL = &H1
CH = &HA0
For i = 0 To (no - 1)
btHiCRC = btHiCRC Xor data(i) '每一个数据与CRC寄存器进行异或
For Flag = 0 To 7
SaveHi = btLoCRC
SaveLo = btHiCRC
btLoCRC = btLoCRC \ 2 '高位右移一位
btHiCRC = btHiCRC \ 2 '低位右移一位
If ((SaveHi And &H1) = &H1) Then '如果高位字节最后一位为1
btHiCRC = btHiCRC Or &H80 '则低位字节右移后前面补1
End If '否则自动补0
If ((SaveLo And &H1) = &H1) Then '如果LSB为1，则与多项式码进行异或
btLoCRC = btLoCRC Xor CH
btHiCRC = btHiCRC Xor CL
End If
Next Flag
Next i
Dim ReturnData(1) As Byte
ReturnData(0) = btHiCRC 'CRC高位
ReturnData(1) = btLoCRC 'CRC低位
CalCRC16Fast = ReturnData
End Function
Public Function CalCRC16Tbl(data() As Byte, no As Integer, btLoCRC As Byte, btHiCRC As Byte) As String
Dim btLoCRC As Byte
Dim btHiCRC As Byte
btLoCRC = &HFF
btHiCRC = &HFF
Dim i As Integer
Dim iIndex As Long
For i = 0 To (no - 1)
iIndex = btHiCRC Xor data(i)
btHiCRC = btLoCRC Xor GetCRCLo(iIndex) '低位处理
btLoCRC = GetCRCHi(iIndex) '高位处理
Next i
Dim ReturnData(1) As Byte
ReturnData(0) = btHiCRC 'CRC高位
ReturnData(1) = btLoCRC 'CRC低位
CalCRC16Tbl = ReturnData
End Function
'CRC低位字节值表
Function GetCRCLo(Ind As Long) As Byte
GetCRCLo = Choose(Ind + 1, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, _
&H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, _
&H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, _
&H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H
80, &H41, &H0, &HC1, _
&H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, _
&H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, _
&H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, _
&H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, _
&H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, _
&H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, _
&H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, _
&H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, _
&H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, _
&H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, _
&H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40)
End Function
'CRC高位字节值表
Function GetCRCHi(Ind As Long) As Byte
GetCRCHi = Choose(Ind + 1, _
&H0, &HC0, &HC1, &H1, &HC3, &H3, &H2, &HC2, &HC6, &H6, &H7, &HC7, &H5, &HC5, &HC4, &H4, &HCC, &HC, &HD, &HCD, &HF, &HCF, &HCE, &HE, &HA, &HCA, &HCB, &HB, &HC9, &H9, &H8, &HC8, &HD8, &H18, &H19, &HD9, &H1B, &HDB, &HDA, &H1A, &H1E, &HDE, &HDF, &H1F, &HDD, &H1D, &H1C, &HDC, &H14, &HD4, &HD5, &H15, &HD7, &H17, &H16, &HD6, &HD2, &H12, &H13, &HD3, &H11, &HD1, &HD0, &H10, &HF0, &H30, &H31, &HF1, &H33, &HF3, &HF2, &H32, &H36, &HF6, &HF7, &H37, &HF5, &H35, &H34, &HF4, &H3C, &HFC, &HFD, &H3D, &HFF, &H3F, &H3E, &HFE, &HFA, &H3A, &H3B, &HFB, &H39, &HF9, &HF8, &H38, &H28, &HE8, &HE9, &H29, &HEB, &H2B, &H2A, &HEA, &HEE, &H2E, &H2F, &HEF, &H2D, &HED, &HEC, &H2C, &HE4, &H24, &H25, &HE5, &H27, &HE7, &HE6, &H26, &H22, &HE2, &HE3, &H23, &HE1, &H21, &H20, &HE0, &HA0, &H60, _
&H61, &HA1, &H63, &HA3, &HA2, &H62, &H66, &HA6, &HA7, &H67, &HA5, &H65, &H64, &HA4, &H6C, &HAC, &HAD, &H6D, &HAF, &H6F, &H6E, &HAE, &HAA, &H6A, &H6B, &HAB, &H69, &HA9, &HA8, &H68, &H78, &HB8, &HB9, &H79, &HBB, &H7B, &H7A, &HBA, &HBE, &H7E, &H7F, &HBF, &H7D, &HBD, &HBC, &H7C, &HB4, &H74, &H75, &HB5, &H77, &HB7, &HB6, &H76, &H72, &HB2, &HB3, &H73, &HB1, &H71, &H70, &HB0, &H50, &H90, &H91, &H51, &H93, &H53, &H52, &H92, &H96, &H56, &H57, &H97, &H55, &H95, &H94, &H54, &H9C, &H5C, &H5D, &H9D, &H5F, &H9F, &H9E, &H5E, &H5A, &H9A, &H9B, &H5B, &H99, &H59, &H58, &H98, &H88, &H48, &H49, &H8
9, &H4B, &H8B, &H8A, &H4A, &H4E, &H8E, &H8F, &H4F, &H8D, &H4D, &H4C, &H8C, &H44, &H84, &H85, &H45, &H87, &H47, &H46, &H86, &H82, &H42, &H43, &H83, &H41, &H81, &H80, &H40)
End Function
2）窗体：FORM1，上面放置的控件如下：
Begin VB.Form frmCom
Caption = "Form1"
ClientHeight = 8235
ClientLeft = 3885
ClientTop = 2250
ClientWidth = 6810
LinkTopic = "Form1"
ScaleHeight = 8235
ScaleWidth = 6810
Begin VB.TextBox txtReceive ‘注：放置接收上来的IB0数据
Height = 495
Left = 1200
TabIndex = 2
Top = 2280
Width = 1335
End
Begin https://www.doczj.com/doc/d24826372.html,mandButton Command1
Caption = "读取IB0"
Height = 495
Left = 2760
TabIndex = 1
Top = 2280
Width = 1695
End
Begin https://www.doczj.com/doc/d24826372.html,mandButton cmdSDO
Caption = "置位Q1.1"
Height = 495
Left = 2160
TabIndex = 0
Top = 3720
Width = 1575
End
Begin MSCommLib.MSComm ComK3
Left = 480
Top = 1080
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
End
① Form_Load事件，在此主要是实现了打开并初始化串口
Private Sub Form_Load()
With ComK3
.CommPort = 1
.Settings = "19200,N,8,1"
.InputMode = comInputModeBinary '二进制收发
.InBufferSize = 512
.OutBufferSize = 512
If (Not .PortOpen) Then .PortOpen = True
End With
End Sub
② Form_UnLoad事件，在此主要是关闭串口
Private Sub Form_Unload(Cancel As Integer)
If (ComK3.PortOpen) Then
ComK3.PortOpen = False
End If
End Sub
③ “置位Q1.1”按钮单击事件
'设置Q1.1为1
Private Sub cmdSDO_Click()
Dim btSend(8) As Byte
btSend(0) = &H1 '目标站号
btSend(1) = &H5 '功能码
btSend(2) = &H0 'Q1.1地址（0009）高字节
btSend(3) = &H9 'Q1.1地址（0009）低字节
btSend(4) = &HFF '强制值高字节
btSend(5) = &H0 '强制值低字节
Dim crc
Dim btCRCHi As Byte, btCRCLo As Byte
crc = CalCRC16Fast(btSend, 6, btCRCLo, btCRCHi)
btSend(6) = btCRCHi
btSend(7) = btCRCLo
ComK3.Output = CVar(btSend)
End Sub
④ “读取IB0”按钮单击事件
'查表知I0.0的modbus地址为0000，从I0.0开始读取连续8位
Private Sub Command1_Click()
'发请求
Dim btSend(8) As Byte
btSend(0) = &H1 '目标站号
btSend(1) = &H2 '功能码
btSend(2) = &H0 'I0.0地址（0000）高字节
btSend(3) = &H0 'i0.0地址（0000）低字节
btSend(4) = &H0 '读取个数高字节
btSend(5) = &H8 '读取个数低字节
Dim crc
Dim btCRCHi As Byte, btCRCLo As Byte
crc = CalCRC16Fast(btSend, 6, btCRCLo, btCRCHi)
btSend(6) = btCRCHi
btSend(7) = btCRCLo
ComK3.Output = CVar(btSend)
'注意下面编写的接收过程很简单，要编写实际应用的监控程序来说需要更完善
Dim btReceive As Variant
With ComK3
Do
DoEvents
Loop Until .InBufferCount = 6
.InputLen = 6
btReceive = .Input
If btReceive(1) = &H2 Then '若正确，返回帧的第2个字节为功能码.实际上，此处应首先进行CRC校验
txtReceive.Text = Hex$(btReceive(3))
End If
End With
End Sub
深圳铭阳电子 https://www.doczj.com/doc/d24826372.html, qq:1575850298