用VB写的modbusrtu模式通讯源码

‘用VB 写的modbus rtu模式通讯源码，已在台达PLC上调试通过Private Sub CmdOpen_Click()

On Error Resume Next

If (MSComm1.PortOpen) Then ‘打开/关闭串口 MSComm1.PortOpen = False Else

MSComm1.PortOpen = True End If

If (MSComm1.PortOpen) Then CmdOpen.Caption = \"关闭串口\" Shape5.FillStyle = vbFSSolid Else

CmdOpen.Caption = \"打开串口\" Shape5.FillStyle = vbFSTransparent End If If Err Then

MsgBox Error$, 48, \"错误码信息\" Exit Sub End If End Sub

Private Sub Combo1_Click()

http://www..com/doc/df18763589.html,mPort Combo1.ListIndex + 1

End Sub

Private Sub Combo2_Click() Call Setting End Sub

Private Sub Combo3_Click()

=

Call Setting End Sub

Private Sub Combo4_Click() Call Setting End Sub

Private Sub Combo5_Click() Call Setting End Sub

Private Sub Command1_Click() ‘S hape1.FillStyle = vbFSSolid Dim Y0_status As Byte Dim Sendstr As String Dim i As Integer, j As Integer Sendstr = \"01 01 05 00 00 10 \" HexSend (Sendstr) Sleep (30)

HexSend (Sendstr) End Sub

Private Function HexSend(Sendstr As String) As Integer Dim outbuf() As Byte Dim Temp(0) As Byte

Dim crc As String, Sendstrls As String Dim sendlen As Integer Dim i As Integer, j As Integer If Sendstr = \"\" Then

MsgBox \"发送数据不能为空！\" HexSend = 0 Exit Function End If

Sendstrls = Trim(Sendstr) ‘去掉空格

sendlen = Len(Sendstrls) + 1 ‘取长度 j = 0

ReDim outbuf(1 To sendlen \\ 3) As Byte For i = 1 To sendlen Step 3 j = j + 1

outbuf(j) = Val(\"&H\" & CStr(Mid(Sendstrls, i, 2))) Next i

crc = Crc16(outbuf)

ReDim Preserve outbuf(1 To (sendlen \\ 3 + 2)) As Byte ‘加上CRC校验码

outbuf(sendlen \\ 3 + 1) = Val(\"&H\" & CStr(Mid(crc, 1, 2))) outbuf(sendlen \\ 3 + 2) = Val(\"&H\" & CStr(Mid(crc, 3, 2))) For i = 1 To (sendlen \\ 3 + 2) Temp(0) = outbuf(i) MSComm1.Output = Temp Next i

For i = 1 To 2000 Next i HexSend = 1 End Function

Private Function Setting() MSComm1.Settings

=

CStr(Combo2.Text)

&

\

&

CStr(Combo3.Text) & \& CStr(Combo4.Text) & \& CStr(Combo5.Text) End Function

Private Sub Command2_Click() ‘If (MSComm1.RThreshold = 0) Then ‘MSComm1.RThreshold = 1 ‘Else

‘MSComm1.RThreshold = 0 ‘End If

Label11.Caption = \"接收个数:\" & CStr(ReceCount) & \" \" & \"接收帧数：\" & CStr(Framecount) End Sub

Private Sub Form_Load() Combo1.AddItem (\"COM1\") Combo1.AddItem (\"COM2\") Combo1.AddItem (\"COM3\") Combo1.AddItem (\"COM4\") Combo1.AddItem (\"COM5\") Combo1.ListIndex = 0 Combo2.AddItem (\"2400\") Combo2.AddItem (\"4800\") Combo2.AddItem (\"9600\") Combo2.AddItem (\"11520\") Combo2.ListIndex = 0 Combo3.AddItem (\"E\") Combo3.AddItem (\"O\") Combo3.AddItem (\"N\") Combo3.ListIndex = 2 Combo4.AddItem (\"6\") Combo4.AddItem (\"7\") Combo4.AddItem (\"8\") Combo4.ListIndex = 2 Combo5.AddItem (\"1\") Combo5.AddItem (\"2\") Combo5.ListIndex = 0 ReceCount = 0 End Sub

Private Function Crc16(data() As Byte) As String Dim CRC16Lo As Byte, CRC16Hi As Byte ‘CRC寄存器 Dim CL As Byte, CH As Byte ‘多项式码&HA001

Dim CrcLo As String, CrcHi As String 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 = 1 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

If Len(Hex(CRC16Hi)) = 1 Then CrcHi = \"0\" + Hex(CRC16Hi) Else

CrcHi = Hex(CRC16Hi) End If

If Len(Hex(CRC16Lo)) = 1 Then CrcLo = \"0\" + Hex(CRC16Lo) Else

CrcLo = Hex(CRC16Lo) End If

Crc16 = CrcLo & CrcHi End Function

Private Sub MSComm1_OnComm() Dim inpu() As Byte Dim i As Integer

Dim tempstr As String, Strdata As String

Select Case http://www..com/doc/df18763589.html,mEvent Case comEvReceive ‘接收事件 tempstr = MSComm1.Input inpu() = tempstr

Framecount = Framecount + 1 ‘帧个数加1 If (Framecount = 1) Then

framepoint(Framecount) = UBound(inpu) + 1 ‘第一帧帧尾 Else

framepoint(Framecount) = framepoint(Framecount - 1) + UBound(inpu) + 1 ‘第二帧开始指针End If

For i = 0 To UBound(inpu) ‘将字符转换为数组 If (Len(Hex(inpu(i))) = 1) Then

Strdata = Strdata & \"0\" & Hex(inpu(i)) & \" \" Else

Strdata = Strdata & Hex(inpu(i)) & \" \" End If Next i

For i = ReceCount + 1 To UBound(inpu) + 1 ‘数据进入缓冲区

Recebuf(i) = inpu(i - 1) Next

ReceCount = ReceCount + UBound(inpu) + 1 TextReceive.Text = TextReceive.Text & Strdata Strdata = \"\" Case comEvSend End Select End Sub

Private Function RtuCheck(data() As Byte) As Integer Dim CrcHi As Byte, CrcLo As Byte Dim Checkdata() As Byte Dim i As Integer Dim crc As String

CrcHi = data(UBound(data)) CrcLo = data(UBound(data) - 1)

ReDim Checkdata(1 To (UBound(data) - 1)) As Byte For i = 1 To (UBound(data) - 1) ‘附值 Checkdata(i) = data(i - 1) Next

crc = Crc16(Checkdata)

If (CrcLo = Val(\"&H\" & CStr(Mid(crc, 1, 2))) And CrcHi = Val(\"&H\" & CStr(Mid(crc, 3, 2)))) Then RtuCheck = 1

Else

RtuCheck = 0 End If End Function