-
-
手机阅读
'RTU校验
Private Sub RTUcheck()
Dim CRC() As Byte
Dim d(5) As Byte
Dim string1 As String
Dim j As Integer, chrlength As Integer, temp As String
string1 = Text1text
chrlength = Len(string1)
For j = 0 To chrlength / 2 - 1
temp = Mid(string1, j * 2 + 1, 2)
d(j) = Val("&H" & temp)
Next
RTUCRC = CRC16(d) '调用CRC16计算函数, CRC(0)为高位, CRC(1)为低位
Text1text = Text1text & RTUCRC
End Sub
Private Sub incorporate() '将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串
Dim wholechar As String, wc%, wcyc%, wchar As String
Dim SID As String, Cmd As String, InfoAdd As String, data As String
Dim SIDnum%, Cmdnum%, InfoAddNum%, Datanum%
On Error Resume Next
wholechar = CStr(Combo6.Text) & CStr(Text6.Text) & CStr(Text7.Text) & CStr(Text8.Text)
wc = Len(wholechar)
For wcyc = 1 To wc
wchar = Mid(wholechar, wcyc, 1)
If InStr("0123456789", wchar) = 0 Then
MsgBox "输入错误，请重新输入", , "错误提示"
Exit Sub
End If
Next
SIDnum = Len(CStr(Hex(Combo6.Text)))
Select Case SIDnum
Case 0
Exit Sub
Case 1
SID = "0" & CStr(Hex(Combo6.Text))
Case 2
SID = CStr(Hex(Combo6.Text))
End Select
Cmdnum = Len(CStr(Hex(Text6.Text)))
Select Case Cmdnum
Case 0
Exit Sub
Case 1
Cmd = "0" & CStr(Hex(Text6.Text))
Case 1
Cmd = CStr(Hex(Text6.Text))
End Select
InfoAddNum = Len(CStr(Hex(Text7.Text)))
Select Case InfoAddNum
Case 0
Exit Sub
Case 1
InfoAdd = "000" & CStr(Hex(Text7.Text))
Case 2
InfoAdd = "00" & CStr(Hex(Text7.Text))
Case 3
InfoAdd = "0" & CStr(Hex(Text7.Text))
Case 4
InfoAdd = CStr(Hex(Text7.Text))
End Select
Datanum = Len(CStr(Hex(Text8.Text)))
Select Case Datanum
Case 0
Exit Sub
Case 1
data = "000" & CStr(Hex(Text8.Text))
Case 2
data = "00" & CStr(Hex(Text8.Text))
Case 3
data = "0" & CStr(Hex(Text8.Text))
Case 4
data = CStr(Hex(Text8.Text))
End Select
If Err Then '显示出错信息
MsgBox Error$, 48, "错误信息"
Exit Sub
End If
Text1text = CStr(SID) & CStr(Cmd) & CStr(InfoAdd) & CStr(data)
End Sub
Private Sub incorporate1() '将输入的十进制从机地址、命令、资料地址和资料内容合并成字符串
Dim wholechar As String, wc%, wcyc%, wchar As String
Dim SID As String, Cmd As String, InfoAdd As String, data As String
Dim SIDnum%, Cmdnum%, InfoAddNum%, Datanum%
On Error Resume Next
wholechar = CStr(Combo6.Text) & CStr(Text7.Text) & CStr(Text8.Text)
wc = Len(wholechar)
For wcyc = 1 To wc
wchar = Mid(wholechar, wcyc, 1)
If InStr("0123456789", wchar) = 0 Then
MsgBox "输入错误，请重新输入", , "错误提示"
Exit Sub
End If
Next
SIDnum = Len(CStr(Hex(Combo6.Text)))
Select Case SIDnum
Case 0
Exit Sub
Case 1
SID = "0" & CStr(Hex(Combo6.Text))
Case 2
SID = CStr(Hex(Combo6.Text))
End Select
'Cmdnum = Len(CStr(Hex(Text6.Text)))
'Select Case Cmdnum
'Case 0
' Exit Sub
'Case 1
' Cmd = "0" & CStr(Hex(Text6.Text))
'Case 1
' Cmd = CStr(Hex(Text6.Text))
'End Select
InfoAddNum = Len(CStr(Hex(Text7.Text)))
Select Case InfoAddNum
Case 0
Exit Sub
Case 1
InfoAdd = "0" & CStr(Hex(Text7.Text))
Case 2
InfoAdd = CStr(Hex(Text7.Text))
End Select
Datanum = Len(CStr(Hex(Text8.Text)))
Select Case Datanum
Case 0
Exit Sub
Case 1
data = "000" & CStr(Hex(Text8.Text))
Case 2
data = "00" & CStr(Hex(Text8.Text))
Case 3
data = "0" & CStr(Hex(Text8.Text))
Case 4
data = CStr(Hex(Text8.Text))
End Select
If Err Then '显示出错信息
MsgBox Error$, 48, "错误信息"
Exit Sub
End If
If Option11.value Then
Cmd = "08"
Text1text = CStr(SID) & CStr(Cmd) & CStr(InfoAdd)
Else
Cmd = "07"
Text1text = CStr(SID) & CStr(Cmd) & CStr(InfoAdd) & CStr(data)
End If
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 = 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
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
完
-
引用 ahljj 2008/11/14 14:15:38 发表于2楼的内容
-
引用 CEEN 2008/12/10 3:30:01 发表于3楼的内容
-
-
-
-
LYC19730508 | 当前状态：在线
总积分：21348 2025年可用积分：3
注册时间： 2008-03-20
最后登录时间： 2021-05-27
-
-
LYC19730508 发表于 2009/10/10 11:02:48
4楼 回复本楼
引用 LYC19730508 2009/10/10 11:02:48 发表于4楼的内容
-