甜橘子，专注成都网站制作网站设计与营销型网站建设与优化
QQ :532337155
电话：028-86922220
大概看了下。有变量定义类型错误，修改如下：
成都创新互联主要从事成都网站设计、网站建设、网页设计、企业做网站、公司建网站等业务。立足成都服务新城,十年网站建设经验,价格优惠、服务专业,欢迎来电咨询建站服务:18980820575
Public
Function
crc16(ByRef
cmdstring()
As
Byte,
DataLen
As
Integer)
As
String
Dim
data
As
Integer
Dim
i
As
Integer
Dim
CRCHi
As
long,
CRCLo
As
long'这里应该定义为long.因为下面赋值是long型。朋友。
Dim
iIndex
As
Long
Dim
CRCStr
As
String
Dim
DataStr
As
String
CRCLo
=
HFF'看这里的赋值。long型
CRCHi
=
HFF
For
i
=
To
DataLen
iIndex
=
CRCLo
Xor
cmdstring(i)
CRCLo
=
CRCHi
Xor
GetCRCLo(iIndex)
'低位处理
CRCHi
=
GetCRCHi(iIndex)
'高位处理
DataStr
=
DataStr
Chr(cmdstring(i))
Next
i
Dim
ReturnData(1)
As
Byte
ReturnData(1)
=
CRCHi
ReturnData(0)
=
CRCLo
CRCStr
=
StrConv(ReturnData,
vbUnicode)
crc16
=
DataStr
+
CRCStr
End
Function
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
public function Calculate_CRC8(byval crc as uint16,byval n as uint16) as uint16
dim i as uint16
crc=crc xor n
for i=0 to 7
if crc and 1 then
crc=(crc1) xor H8c
else
crc=crc1
end if
next
return crc
end function
Private Sub Form_Load()
'text1为校验对象
Text1.Text = "31303432"
'text2为校验多项式
Text2.Text = "180D"
End Sub
Private Sub Command1_Click()
Text3.Text = CRC(Text1.Text, Text2.Text, 12)
End Sub
Private Function CRC(ByVal Hex_Number As String, ByVal Hex_CRC As String, Optional ByVal C As Integer = 16) As String
'Hex_Number为校验项16进制数字，Hex_CRC为校验多项式，16进制，C为默认位数CRC-16
Dim i As Integer
Dim BinNumber As String
Dim BinCRC As String
Dim Temp As String
CRC = "0"
If Hex_Number = "0" Then Exit Function
BinNumber = HEXtoBin(Hex_Number)
BinCRC = HEXtoBin(Hex_CRC)
i = Len(BinCRC)
BinNumber = BinNumber String(C, "0")
CRC = Left(BinNumber, i)
Temp = Right(BinNumber, Len(BinNumber) - i)
Temp = HEXtoBin(Hex(CLng("H" BINtoHEX(CRC)) Xor CLng("H" Hex_CRC))) Temp
CRC = BINtoHEX(Temp)
If Len(Temp) = i Then
CRC = CRC(CRC, Hex_CRC, 0)
End If
End Function
Private Function HEXtoBin(Hex_Number) As String
'十六进制转换为二进制
Dim i As Long
Dim B As String
Hex_Number = UCase(Hex_Number)
For i = 1 To Len(Hex_Number)
Select Case Mid(Hex_Number, i, 1)
Case "0": B = B "0000"
Case "1": B = B "0001"
Case "2": B = B "0010"
Case "3": B = B "0011"
Case "4": B = B "0100"
Case "5": B = B "0101"
Case "6": B = B "0110"
Case "7": B = B "0111"
Case "8": B = B "1000"
Case "9": B = B "1001"
Case "A": B = B "1010"
Case "B": B = B "1011"
Case "C": B = B "1100"
Case "D": B = B "1101"
Case "E": B = B "1110"
Case "F": B = B "1111"
End Select
Next i
While Left(B, 1) = "0"
B = Right(B, Len(B) - 1)
Wend
HEXtoBin = B
End Function
Private Function BINtoHEX(ByVal Bin_Number As String) As String
'二进制转换为十六进制
Dim i As Long
Dim H As String
If Len(Bin_Number) Mod 4 0 Then
Bin_Number = String(4 - Len(Bin_Number) Mod 4, "0") Bin_Number
End If
For i = 1 To Len(Bin_Number) Step 4
Select Case Mid(Bin_Number, i, 4)
Case "0000": H = H "0"
Case "0001": H = H "1"
Case "0010": H = H "2"
Case "0011": H = H "3"
Case "0100": H = H "4"
Case "0101": H = H "5"
Case "0110": H = H "6"
Case "0111": H = H "7"
Case "1000": H = H "8"
Case "1001": H = H "9"
Case "1010": H = H "A"
Case "1011": H = H "B"
Case "1100": H = H "C"
Case "1101": H = H "D"
Case "1110": H = H "E"
Case "1111": H = H "F"
End Select
Next i
While Left(H, 1) = "0"
H = Right(H, Len(H) - 1)
Wend
BINtoHEX = H
End Function