新建 文本文档.txt

VB关于MOSBUS数据编程实现MODBUS通讯

   通过S7-200西门子PLC做串口通讯 实现Modbus RTU协议通讯
自己写的    。。

Function crcresult(ByVal data As Long, ByVal genpoly As Long, ByVal crcdata As Long) As Long
Dim tmpi As Integer
data = data * 2
For tmpi = 8 To 1 Step -1
data = Fix(data / 2)
     If ((data Xor crcdata) And 1) Then
     crcdata = Fix(crcdata / 2) Xor genpoly
     Else
       crcdata = Fix(crcdata / 2)
      End If
    Next tmpi
    crcresult = crcdata
End Function



Private Sub Command1_Click()
 aflag = True
 'On Error GoTo ErrProc
    Dim sendbyte(7) As Byte
    Dim receivebyte() As Byte
    Dim receivedata() As Byte
    sendbyte(0) = 2   '从机地址
    sendbyte(1) = &H3 'Modbus数据读取命令
    sendbyte(2) = &H0 '寄存器地址高字节 m
    sendbyte(3) = &H0 '寄存器地址低字节
    sendbyte(4) = &H0 '连续读寄存器个数高字节
    sendbyte(5) = &H2 '连续读寄存器个数低字节
    
    crc = &HFFFF&     'crc循环冗余计算
    For tmpi = 0 To 5
        crc = crcresult(CLng(sendbyte(tmpi)), &HA001&, crc)
        Next
    sendbyte(6) = CByte(crc And &HFF&)            'crc低8位
    sendbyte(7) = CByte(Fix(crc / 256) And &HFF&) 'crc高8位
    
    If MSComm1.PortOpen = False Then Exit Sub '如果串口未打开  退出
        
        
         receivebyte = MSComm1.Input            '清空缓冲区
        MSComm1.Output = sendbyte                '送出数据
        MSComm1.RThreshold = 9                      '设置接收数据区大小
     
    If MSComm1.CommEvent Then
     receivedata = MSComm1.Input                 '接收数据
      
    crc = &HFFFF&                                '验证接收数据是否正确
       For tmpi = 0 To 6
       crc = crcresult(CLng(receivedata(tmpi)), &HA001&, crc)
       Next
        If receivedata(7) = CByte(crc And &HFF&) And receivedata(8) = CByte(Fix(crc / 256) And &HFF&) Then
       
          Dim aStr As String
          Dim i As Integer
          For i = 3 To 6
          aStr = aStr & Chr(receivedata(i))
          Text1.Text = aStr
         Next i
        End If
    End If
   ' End If
'ErrProc:
    ' MsgBox "传输数据失败", vbCritical, "网络传输"
End Sub

Private Sub Command2_Click()
bflag = True
On Error GoTo ErrProc
    Dim sendbyte(7) As Byte
    Dim receivebyte() As Byte
    Dim receivedata() As Byte
    sendbyte(0) = 2    '从机地址
    sendbyte(1) = &H6 'Modbus数据写命令
    sendbyte(2) = &H0 '寄存器地址高字节
    sendbyte(3) = &H0 '寄存器地址低字节
    sendbyte(4) = &H0 '写入寄存器数据的高字节
    sendbyte(5) = &H2 '写入寄存器数据的低字节
    
    crc = &HFFFF&     'crc循环冗余计算
     For tmpi = 0 To 5
        crc = crcresult(CLng(sendbyte(tmpi)), &HA001&, crc)
        Next
    sendbyte(6) = CByte(crc And &HFF&)            'crc低8位
    sendbyte(7) = CByte(Fix(crc / 256) And &HFF&) 'crc高8位
      
    If MSComm1.PortOpen = False Then Exit Sub    '如果串口未打开  退出
        
        receivebyte = MSComm1.Input              '清空缓冲区
        MSComm1.Output = sendbyte                '送出数据
    
    MSComm1.RThreshold = 8                       '设置接收数据区大小
    
    If MSComm1.CommEvent Then
     receivedata = MSComm1.Input                 '接收数据
      
    crc = &HFFFF&                                '验证接收数据是否正确
       For tmpi = 0 To 5
       crc = crcresult(CLng(receivedata(tmpi)), &HA001&, crc)
       Next
       If receivedata(6) = CByte(crc And &HFF&) And receivedata(7) = CByte(Fix(crc / 256) And &HFF&) Then
       
        Dim aStr As String
        Dim i As Integer
         For i = 4 To 5
         aStr = aStr & Chr(receivedata(i))
         Text2.Text = aStr
         Next i
       End If
    End If
    End If
        
ErrProc:
     MsgBox "传输数据失败", vbCritical, "网络传输"
End Sub

Private Sub MSComm1_OnComm()


   Dim buffer As Variant     '由缓冲区读取的数据用Variant 变量接收
   Dim arr() As Byte        '定义二进制数据数组
   Dim i As Integer
   Dim receivestr As String '定义输出到文本框的字符变量
If aflag = True Then
Select Case Comm1.CommEvent
  Case comEvReceive
    buffer = Comm1.Input    '接收缓冲区内数据到Variant 变量内
    arr = buffer           '转换为二进制数并送入相应数组
    For i = 3 To 6
    receivestr = arr(i)        '用字符串形式表示
    Text1.Text = Text1.Text & receivestr & "," '在文本框中显示
    Next i
End Select
aflag = False
End If


If bflag = True Then
Select Case Comm1.CommEvent
  Case comEvReceive
    buffer = Comm1.Input    '接收缓冲区内数据到Variant 变量内
    arr = buffer           '转换为二进制数并送入相应数组
    For i = 4 To 5
    receivestr = arr(i)        '用字符串形式表示
    Text1.Text = Text1.Text & receivestr & "," '在文本框中显示
    Next i
End Select
bflag = False
End If



End Sub