符合中小企业对网站设计、功能常规化式的企业展示型网站建设
本套餐主要针对企业品牌型网站、中高端设计、前端互动体验...
商城网站建设因基本功能的需求不同费用上面也有很大的差别...
手机微信网站开发、微信官网、微信商城网站...
'Text1.Text 输入数据
成都创新互联是一家以网络技术公司,为中小企业提供网站维护、成都网站制作、成都网站设计、网站备案、服务器租用、国际域名空间、软件开发、成都小程序开发等企业互联网相关业务,是一家有着丰富的互联网运营推广经验的科技公司,有着多年的网站建站经验,致力于帮助中小企业在互联网让打出自已的品牌和口碑,让企业在互联网上打开一个面向全国乃至全球的业务窗口:建站咨询电话:18980820575
'Text2.Text 输出数据
Dim ReturnData(1) As Byte
Private Sub Command1_Click()
Dim CRC(2) As Byte
Dim d(6) As Byte '待传输数据
ReDim data(7) As Byte
For i = 0 To 5
data(i) = "h" + Mid(Text1.Text, 2 * i + 1, 2)
Debug.Print data(i)
Next i
Call CRC16(data, UBound(data) - 2, data(6), data(7)) '调用CRC16计算函数
' CRC(0)为高位
' CRC(1)为低位
End Sub
Function CRC16(data() As Byte, i As Integer, ByRef ReturnDatalo As Byte, ByRef ReturnDatahi As Byte) As String
Dim CRC16Lo As Byte, CRC16Hi As Byte 'CRC寄存器
Dim CL As Byte, CH As Byte '多项式码HA001
Dim SaveHi As Byte, SaveLo As Byte
Dim Flag As Integer
CRC16Lo = HFF
CRC16Hi = HFF
CL = H1
CH = HA0
For i = 0 To UBound(data) - 2
CRC16Lo = CRC16Lo Xor data(i) '每一个数据与CRC寄存器进行异或
For Flag = 0 To 9
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
ReturnDatahi = CRC16Hi 'CRC高位
ReturnDatalo = CRC16Lo 'CRC低位
Debug.Print Hex(CRC16Lo), Hex(CRC16Hi)
Text2.Text = Text1.Text Hex(CRC16Lo) Hex(CRC16Hi)
End Function
Option Explicit On
Option Strict On
Imports System
Module Program
Sub Main()
Dim y,m,t As Integer
begin:
' 输入数据时一行一个
y=CInt(Console.ReadLine())
m=CInt(Console.ReadLine())
t=CInt(Console.ReadLine())
If y
200 Then
Console.WriteLine("ERROR")
goto begin
End If
pr(y,m,t)
Console.Write("Press any key to continue . . . ")
Console.ReadKey(True)
End Sub
Function pr(y As Integer,m As Integer,t As Integer) As Integer
Dim ye,[Me],i As Integer
ye=CInt((m+t-2)/12+y)
[Me]=(m+t-2) Mod 12+1
End If
End Function
Function mday(y As Integer,m As Integer) As Integer
Dim day As Integer()={0,31,28,31,30,31,30,31,31,30,31,30,31}
Dim ad As I
VB 对位的操作是有点难度的!
VB 的CRC 校验程序 请看下的URL!
VB下如何编写CRC校验程序
摘自于网络
VB下如何编写CRC校验程序
随着计算机技术的不断发展,在现代工业中,利用微机进行数据通讯的工业控制应用得也越来越广泛。由于传输距离、现场状况等诸多可能出现的因素影响,计算机与受控设备之间的通讯数据常会发生无法预测的错误。为了防止错误所带来的影响,一般在通讯时采取数据校验的办法,而循环冗余码校验是最常用的校验方法之一。
一、循环冗余码校验原理
循环冗余码校验英文名称为Cyclical Redundancy Check,简称CRC。它是利用除法及余数的原理来作错误侦测(Error Detecting)的。实际应用时,发送装置计算出CRC值并随数据一同发送给接收装置,接收装置对收到的数据重新计算CRC并与收到的CRC相比较,若两个CRC值不同,则说明数据通讯出现错误。
根据应用环境与习惯的不同,CRC又可分为以下几种标准:
①CRC-12码;
②CRC-16码;
③CRC-CCITT码;
④CRC-32码。
CRC-12码通常用来传送6-bit字符串。CRC-16及CRC-CCITT码则用是来传送8-bit字符,其中CRC-16为美国采用,而CRC-CCITT为欧洲国家所采用。CRC-32码大都被采用在一种称为Point-to-Point的同步传输中。
下面以最常用的CRC-16为例来说明其生成过程。
CRC-16码由两个字节构成,在开始时CRC寄存器的每一位都预置为1,然后把CRC寄存器与8-bit的数据进行异或,之后对CRC寄存器从高到低进行移位,在最高位(MSB)的位置补零,而最低位(LSB,移位后已经被移出CRC寄存器)如果为1,则把寄存器与预定义的多项式码进行异或,否则如果 LSB为零,则无需进行异或。重复上述的由高至低的移位8次,第一个8-bit数据处理完毕,用此时CRC寄存器的值与下一个8-bit数据异或并进行如前一个数据似的8次移位。所有的字符处理完成后CRC寄存器内的值即为最终的CRC值。
下面为CRC的计算过程:
1.设置CRC寄存器,并给其赋值FFFF(hex)。
2.将数据的第一个8-bit字符与16位CRC寄存器的低8位进行异或,并把结果存入CRC寄存器。
3.CRC寄存器向右移一位,MSB补零,移出并检查LSB。
4.如果LSB为0,重复第三步;若LSB为1,CRC寄存器与多项式码相异或。
5.重复第3与第4步直到8次移位全部完成。此时一个8-bit数据处理完毕。
6.重复第2至第5步直到所有数据全部处理完成。
7.最终CRC寄存器的内容即为CRC值。
二、 循环冗余码校验程序的编写
明白了CRC校验码的产生过程,编写起程序来就非常容易了。由于Visual Basic的广泛普及以及其在数据通讯中的重要地位,下面就以VB语言来编写CRC的生成程序,其它语言只需稍做修改即可。
编写CRC校验程序有两种办法:一种为计算法,一种为查表法。下面对两种方法分别讨论。
1.计算法
计算法就是依据CRC校验码的产生原理来设计程序。其优点是模块代码少,修改灵活,可移植性好。其缺点为计算量大。为了便于理解,这里假定了三位数据,而多项式码为A001(hex)。
在窗体上放置一命令按钮Command1,并添加如下代码:
Private Sub Command1_Click()
Dim CRC() As Byte
Dim d() As Byte ’待传输数据
ReDim d(2) As Byte
d(0) = 123
d(1) = 112
d(2) = 135
CRC = CRC16(d) ’调用CRC16计算函数
’CRC(0)为高位
’CRC(1)为低位
End Sub
注意:在数据传输时CRC的低位可能在前,而高位在后。
Function CRC16(data() As Byte) As String
Dim CRC16Lo As Byte, CRC16Hi As Byte ’CRC寄存器
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 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低位
CRC16 = ReturnData
End Function
2.查表法
查表法的优缺点与计算法的正好相反。为了便于比较,这里所有的假定与计算法的完全相同,都而在窗体上放置一个Command1的按钮,其代码部分与上面的也完全一致。下面只介绍CRC函数的编写源代码。
Private Function CRC16(data() As Byte) As String
Dim CRC16Hi As Byte
Dim CRC16Lo As Byte
CRC16Hi = HFF
CRC16Lo = HFF
Dim I As Integer
Dim iIndex As Long
For I = 0 To Ubound(data)
iIndex = CRC16Lo Xor data(I)
CRC16Lo = CRC16Hi Xor GetCRCLo(iIndex) ’低位处理
CRC16Hi = GetCRCHi(iIndex) ’高位处理
Next I
Dim ReturnData(1) As Byte
ReturnData(0) = CRC16Hi ’CRC高位
ReturnData(1) = CRC16Lo ’CRC低位
CRC16 = ReturnData
End Function
’CRC低位字节值表
Function GetCRCLo(Ind As Long) As Byte
GetCRCLo = Choose(Ind + 1, H0, HC1, H81, H40, H1, HC0, H80, H41, H1, HC0, H80, H41, H0, HC1, H81, H40, H1, HC0, H80, H41, H0, HC1, H81, H40, H0, HC1, H81, H40, H1, HC0, H80, H41, H1, HC0, H80, H41, H0, HC1, H81, H40, H0, HC1, H81, H40, H1, HC0, H80, H41, H0, HC1, H81, H40, H1, HC0, H80, H41, H1, HC0, H80, H41, H0, HC1, H81, H40, H1, HC0, H80, H41, H0, HC1, H81, H40, H0, HC1, H81, H40, H1, HC0, H80, H41, H0, HC1, H81, H40, H1, HC0, H80, H41, H1, HC0, H80, H41, H0, HC1, H81, H40, H0, HC1, H81, H40, H1, HC0, H80, H41, H1, HC0, H80, H41, H0, HC1, H81, H40, H1, HC0, H80, H41, H0, HC1, H81, H40, H0, HC1, H81, H40, H1, HC0, H80, H41, H1, HC0, _
H80, H41, H0, HC1, H81, H40, H0, HC1, H81, H40, H1, HC0, H80, H41, H0, HC1, H81, H40, H1, HC0, H80, H41, H1, HC0, H80, H41, H0, HC1, H81, H40, H0, HC1, H81, H40, H1, HC0, H80, H41, H1, HC0, H80, H41, H0, HC1, H81, H40, H1, HC0, H80, H41, H0, HC1, H81, H40, H0, HC1, H81, H40, H1, HC0, H80, H41, H0, HC1, H81, H40, H1, HC0, H80, H41, H1, HC0, H80, H41, H0, HC1, H81, H40, H1, HC0, H80, H41, H0, HC1, H81, H40, H0, HC1, H81, H40, H1, HC0, H80, H41, H1, HC0, H80, H41, H0, HC1, H81, H40, H0, HC1, H81, H40, H1, HC0, H80, H41, H0, HC1, H81, H40, H1, HC0, H80, H41, H1, HC0, H80, H41, H0, HC1, H81, H40)
End Function
’CRC高位字节值表
Function GetCRCHi(Ind As Long) As Byte
GetCRCHi = Choose(Ind + 1, H0, HC0, HC1, H1, HC3, H3, H2, HC2, HC6, H6, H7, HC7, H5, HC5, HC4, H4, HCC, HC, HD, HCD, HF, HCF, HCE, HE, HA, HCA, HCB, HB, HC9, H9, H8, HC8, HD8, H18, H19, HD9, H1B, HDB, HAD, H1A, H1E, HDE, HDF, H1F, HDD, H1D, H1C, HDC, H14, HD4, HD5, H15, HD7, H17, H16, HD6, HD2, H12, H13, HD3, H11, HD1, HD0, H10, HF0, H30, H31, HF1, H33, HF3, HF2, H32, H36, HF6, HF7, H37, HF5, H35, H34, HF4, H3C, HFC, HFD, H3D, HFF, H3F, H3E, HFE, HFA, H3A, H3B, HFB, H39, HF9, HF8, H38, H28, HE8, HE9, H29, HEB, H2B, H2A, HEA, HEE, H2E, H2F, HEF, H2D, HED, HEC, H2C, HE4, H24, H25, HE5, H27, HE7, HE6, H26, H22, HE2, HE3, H23, HE1, H21, H20, HE0, HA0, H60, _
H61, HA1, H63, HA3, HA2, H62, H66, HA6, HA7, H67, HA5, H65, H64, HA4, H6C, HAC, HAD, H6D, HAF, H6F, H6E, HAE, HAA, H6A, H6B, HAB, H69, HA9, HA8, H68, H78, HB8, HB9, H79, HBB, H7B, H7A, HBA, HBE, H7E, H7F, HBF, H7D, HBD, HBC, H7C, HB4, H74, H75, HB5, H77, HB7, HB6, H76, H72, HB2, HB3, H73, HB1, H71, H70, HB0, H50, H90, H91, H51, H93, H53, H52, H92, H96, H56, H57, H97, H55, H95, H94, H54, H9C, H5C, H5D, H9D, H5F, H9F, H9E, H5E, H5A, H9A, H9B, H5B, H99, H59, H58, H98, H88, H48, H49, H89, H4B, H8B, H8A, H4A, H4E, H8E, H8F, H4F, H8D, H4D, H4C, H8C, H44, H84, H85, H45, H87, H47, H46, H86, H82, H42, H43, H83, H41, H81, H80, H40)
End Function
以上程序在Win98,VB6下调试通过。
大概看了下。有变量定义类型错误,修改如下:
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
异或在计算机二进制运算中是一种常用运算,最常见于数据的简单加密。 它的运算规则是这样的,两组数据对位后进行比较——相同,即同为0或同为1,输出0;不同,输出1。 看下面的例子,你会掌握异或运算:(第一组数据) :0011 0011 0011 0011(第二组数据) :0000 1111 0011 1100(异或运算结果):0011 1100 0000 1111 ————————————————————————————————————我们先把校验对象(31 30 34 32 H)划成二进制:0011 0001 0011 0000 0011 0100 0011 0010 把校验多项式(18 0D H)划成二进制:0001 1000 0000 1101 据CRC12校验规则,被除数为校验对象后加12个“0”,除数为校验多项式,运算时以高位对齐。以下使用计算法对校验对象进行CRC12校验。在每次计算前,高位去零,一直计算到被除数位数少于除数位数时停止。 计算过程:校验对象: 0011 0001 0011 0000 0011 0100 0011 0010被除数 → 0011 0001 0011 0000 0011 0100 0011 0010 0000 0000 0000校验多项式:0001 1000 0000 1101除数 → 1 1000 0000 1101 高位去零,对齐后进行异或运算: 110001001100000011010000110010000000000000
/1100000001101
=000001001010100011010000110010000000000000(高位去零,再次运算) 1001010100011010000110010000000000000
/1100000001101
=0101010101110010000110010000000000000(高位去零,再次运算) 101010101110010000110010000000000000
/1100000001101
=011010101000110000110010000000000000(高位去零,再次运算) 11010101000110000110010000000000000
/1100000001101
=00010101011100000110010000000000000(高位去零,再次运算) 10101011100000110010000000000000
/1100000001101
=01101011111010110010000000000000(高位去零,再次运算) 1101011111010110010000000000000
/1100000001101
=0001011110111110010000000000000(高位去零,再次运算) 1011110111110010000000000000
/1100000001101
=0111110110011010000000000000(高位去零,再次运算) 111110110011010000000000000
/1100000001101
=001110110101110000000000000(高位去零,再次运算) 1110110101110000000000000
/1100000001101
=0010110100011000000000000(高位去零,再次运算) 10110100011000000000000
/1100000001101
=01110100000010000000000(高位去零,再次运算) 1110100000010000000000
/1100000001101
=0010100001111000000000(高位去零,再次运算) 10100001111000000000
/1100000001101
=01100001100010000000(高位去零,再次运算) 1100001100010000000
/1100000001101
=0000001101111000000(高位去零,再次运算) 1101111000000
/1100000001101
=0001111001101(高位去零,符合终止条件)=1111001101 所以,CRC12校验结果:11 1100 1101 →(十六进制)→ 3CDH————————————————————————————————————看你自己能不能理解,CRC12校验类模块写好了再给你发过去。
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