VB Modbos Server

  Dim CRC16Hi As Byte
 Dim CRC16Lo As Byte
   
Function CRC161(Data() 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
CRC16Lo = &HFF
CRC16Hi = &HFF
CL = &H1
CH = &HA0
For i = 0 To 4 '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低位
CRC161 = ReturnData
End Function
   
Private Sub Form_Load()
With mscom2
     If .PortOpen = False Then
     .CommPort = 2 '打开串口1
     .Settings = "9600,N,8,1"
     .InputMode = 1
     .InputLen = 50                '一次性从接收缓冲区中读取所有数据(8个字节为一组！！)
     .InBufferCount = 0                                 '清空接收缓冲区
     .OutBufferCount = 0                               '清空发送缓冲区
     .RThreshold = 8
     .InBufferSize = 1024
     .OutBufferSize = 1024
     .PortOpen = True
    Else
     MsgBox "串口已经打开"
    End If
End With

End Sub

Private Sub Form_Unload(Cancel As Integer)
mscom2.PortOpen = False
End Sub

Private Sub mscom2_OnComm()

Dim INByte() As Byte
Dim Buf As String
Dim btLoCRC As Byte, btHiCRC As Byte
Dim Data As Integer
If mscom2.CommEvent = comEvReceive Then
INByte = mscom2.Input
        List1.AddItem "ID:  " + Str("&h" + Hex(INByte(0))) '转换为十进制
        List1.AddItem "TYPE:" + Str("&h" + Hex(INByte(1)))
        List1.AddItem "address" + Str("&h" + Hex(INByte(2)) + Hex(INByte(3)))
        List1.AddItem "Length" + Str("&h" + Hex(INByte(4)) + Hex(INByte(5)))
        mscom2.InBufferCount = 0  '清缓存
End If
Dim sen(7) As Byte
sen(0) = 1
sen(1) = 3
sen(2) = 2
sen(3) = Val(Text1) / 2 / 2 / 2 / 2 / 2 / 2 / 2 / 2  '>>8 get hi 8 bit
sen(4) = Val(Text1) And 255 'lo 8 bit

CRC161 sen() 'CRC CHECK 得到 CRC16Hi CRC16Lo

sen(6) = CRC16Hi

sen(5) = CRC16Lo

mscom2.Output = sen
End Sub