如何用VB语言来实现CRC校验函数？谢谢！！！

http://www.jinesc.com/myweb/disp.asp?idd=153&room=1060
这个看上去象是你要的

一个简单的 CRC 例子
=================================================================
VERSION 5.00
Begin VB.Form FrmCRC
   BorderStyle     =   1  'Fixed Single
   Caption         =   "CRC"
   ClientHeight    =   2100
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3990
   Icon            =   "FrmCRC.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2100
   ScaleWidth      =   3990
   StartUpPosition =   1  'CenterOwner
   Begin VB.Frame FrameCRC_Type
      Caption         =   "CRC Type"
      Height          =   975
      Left            =   1475
      TabIndex        =   1
      Top             =   240
      Width           =   1100
      Begin VB.OptionButton OptType
         Caption         =   "16 bit"
         Height          =   255
         Index           =   1
         Left            =   120
         TabIndex        =   3
         Top             =   600
         Width           =   855
      End
      Begin VB.OptionButton OptType
         Caption         =   "32 bit"
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   2
         Top             =   240
         Value           =   -1  'True
         Width           =   855
      End
   End
   Begin VB.CommandButton CmdDoCRC
      Caption         =   "Do CRC"
      Height          =   350
      Left            =   1475
      TabIndex        =   0
      Top             =   1560
      Width           =   1100
   End
End
Attribute VB_Name = "FrmCRC"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option ExplicitPrivate Function FormatMessageLine(TestString As String, IsCRC32 As Boolean, _
                                                           ShouldBe As String)
   ' Pretty self-explanatory; formats a line for the message box.
   FormatMessageLine = TestString & vbTab & CRC(TestString, IsCRC32) & vbTab

   ' Insert extra tab if 16 bit:
   If Not IsCRC32 Then FormatMessageLine = FormatMessageLine & vbTab
   FormatMessageLine = FormatMessageLine & ShouldBe & vbNewLine
End FunctionPrivate Sub CmdDoCRC_Click()
   Const TestString As String = "Hello World"
   Dim Message As String

   ' Format message title.
   Message = "  Test String: " & vbTab & "Calculated:" & vbTab & _
                              "Should Be:" & vbNewLine & vbNewLine

   ' Process some (similar) test strings, & compare with known results.
   Select Case OptType(0).Value
      Case 0
         ' 16 bit CRC
         Message = Message & FormatMessageLine(TestString, False, "DAED")
         Message = Message & FormatMessageLine(LCase$(TestString), False, "DDC7")
         Message = Message & FormatMessageLine(" " & TestString, False, "830E")
         Message = Message & FormatMessageLine(TestString & ".", False, "519A")
      Case Else
         ' 32 bit CRC
         Message = Message & FormatMessageLine(TestString, True, "4A17B156")
         Message = Message & FormatMessageLine(LCase$(TestString), True, "0D4A1185")
         Message = Message & FormatMessageLine(" " & TestString, True, "42741D2D")
         Message = Message & FormatMessageLine(TestString & ".", True, "8C960132")
   End Select

   MsgBox Message, vbOKOnly, "    CRC"
End SubPrivate Function CRC(ByVal S As String, ByVal IsCRC32 As Boolean) As String
   ' Initializes CRC, updates CRC for each char in S, and finishes
   ' off at the end.
   ' Examining this function, and "CRCUpdate", should make it obvious
   ' how to do a CRC of a large binary file.
   ' 32 bit Returns zero for zero length string (probably why the CRC is
   ' complimented at the end.)
   Dim L As Long
   Dim LCRC As Long
   Dim ICRC As Integer

   Select Case IsCRC32
      Case True
         ' Initialise: this is part of the CRC32 protocol.
         LCRC = &HFFFFFFFF

         ' Update for each byte in S
         For L = 1 To Len(S): CRCUpdate LCRC, Asc(Mid$(S, L)): Next

         ' Finally flip all bits, again, just part of the prorocol.
         LCRC = Not LCRC

         ' Format the long CRC value as a hex string.
         ' Insert leading zeros if required.
         CRC = Hex$(LCRC): Do While Len(CRC) < 8: CRC = "0" & CRC: Loop

      Case Else
         ' Initialise. Integer maths used.
         ICRC = &HFFFF

         ' Update for each byte in S
         For L = 1 To Len(S): CRCUpdate ICRC, Asc(Mid$(S, L)): Next

         ' Format the long CRC value as a hex string.
         ' Insert leading zeros if required.
         CRC = Hex$(ICRC): Do While Len(CRC) < 4: CRC = "0" & CRC: Loop

   End Select
End FunctionPrivate Sub CRCUpdate(ByRef CRC, ByVal b As Byte)
   ' Note no type declaration for CRC, as a long or integer can be passed.
   Const Polynomial16 As Integer = &HA001
   Const Polynomial32 As Long = &HEDB88320
   Dim Bits As Byte

   CRC = CRC Xor b
   For Bits = 0 To 7
      Select Case (CRC And &H1) ' test LSB
            Case 0
               ' LSB zero, just shift.
               CRC = rightShift(CRC)
            Case Else
               ' only xor with polynomial if lsb set.
               Select Case VarType(CRC)
                  Case vbLong
                     CRC = rightShift(CRC) Xor Polynomial32
                  Case Else
                     CRC = rightShift(CRC) Xor Polynomial16
               End Select
      End Select
   Next
End SubPrivate Function rightShift(ByVal V) As Long
   ' Note no type declaration for V, as a long or integer can be passed.
   ' Self-explanatory. The final line is essential (maybe
   ' not obvious) because the number is signed.
   Select Case VarType(V)
      Case vbLong
         rightShift = V And &HFFFFFFFE
         rightShift = rightShift \ &H2
         rightShift = rightShift And &H7FFFFFFF
      Case Else
         rightShift = V And &HFFFE
         rightShift = rightShift \ &H2
         rightShift = rightShift And &H7FFF
   End Select
End Function
-----------------------------------------------------------------
Polynomial.
===========
Take a look at one of the links to understand what the polynomial is. The almost universal "Ethernet standard" polynomial for CRC32 is:
x^32 + x^26 + x^23 + x^22 + x^16 + x^12 + x^11 + x^10 + x^8 + x^7 + x^5 + x^4 + x^2 + x + 1
Translated into binary this is
1 00000100 11000001 00011101 10110111
and hex:
1 04 C1 1D B7
For a 32 bit CRC remainder you need a 33 bit polynomial. To shoe- horn this into VB (signed) long variables, only 32 bits can be used; the most significant bit is not included in the polynomial mask, because it is not necessary: the mask is only applied (via XOR) if a 1 is being shifted out, and 1 XOR 1 is zero.
Normally bytes are added via an exclusive or operation to the MSB end of the CRC and left shifted out. This is inconvenient in VB since the byte must be left shifted to the end of a long in the first place. Also, a left shift is (very) slightly more complicated to effect than right shift in VB, because overflows must be avoided. To maintain the code as simple as possible therefore, I've bitwise-reversed the polynomial, added the byte to the LSB end of the CRC and right- shifted data out. This is standard practice, although the point is not often clearly made.
Bitwise, the reverse of the (used portion) of the polynomial is:
11101101 10111000 10000011 00100000
Which in hex is: EDB88320, hence the polynomial constant in the program.

请到下面的帖子参与讨论，谢谢！
http://www.csdn.net/expert/topic/667/667096.xml?temp=.3140528

我可不懂
向右移一位不就是除以2吗？crc寄存器的低字节付给循环除2，在循环中判断吗？

调试易

如何用VB语言来实现CRC校验函数？谢谢！！！

解决方案 »

如何用VB语言来实现CRC校验函数？ 谢谢！！！

解决方案 »

如何用VB语言来实现CRC校验函数？谢谢！！！