CRC32算法(VB)

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "cCRC32"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private crc32Table() As Long
Private Const BUFFER_SIZE As Long = 8192

Public Function GetByteArrayCrc32(ByRef buffer() As Byte) As Long
  
   Dim crc32Result As Long
   crc32Result = &HFFFFFFFF
     
   Dim i As Integer
   Dim iLookup As Integer
  
   For i = LBound(buffer) To UBound(buffer)
      iLookup = (crc32Result And &HFF) Xor buffer(i)
      crc32Result = ((crc32Result And &HFFFFFF00) / &H100) And 16777215 ' nasty shr 8 with vb :/
      crc32Result = crc32Result Xor crc32Table(iLookup)
   Next i
  
   GetByteArrayCrc32 = Not (crc32Result)

End Function

Public Function GetFileCrc32(ByRef stream As cBinaryFileStream) As Long

   Dim crc32Result As Long
   crc32Result = &HFFFFFFFF

   Dim buffer(0 To BUFFER_SIZE - 1) As Byte
   Dim readSize As Long
   readSize = BUFFER_SIZE

   Dim count As Integer
   count = stream.Read(buffer, readSize)
  
   Dim i As Integer
   Dim iLookup As Integer
   Dim tot As Integer
  
   Do While (count > 0)
      For i = 0 To count - 1
         iLookup = (crc32Result And &HFF) Xor buffer(i)
         crc32Result = ((crc32Result And &HFFFFFF00) / &H100) And 16777215 ' nasty shr 8 with vb :/
         crc32Result = crc32Result Xor crc32Table(iLookup)
      Next i
      count = stream.Read(buffer, readSize)
   Loop

   GetFileCrc32 = Not (crc32Result)

End Function

Private Sub Class_initialize()

    Dim dwPolynomial As Long
    dwPolynomial = &HEDB88320
    Dim i As Integer, j As Integer

    ReDim crc32Table(256)
    Dim dwCrc As Long

    For i = 0 To 255
        dwCrc = i
        For j = 8 To 1 Step -1
            If (dwCrc And 1) Then
                dwCrc = ((dwCrc And &HFFFFFFFE) / 2&) And &H7FFFFFFF
                dwCrc = dwCrc Xor dwPolynomial
            Else
                dwCrc = ((dwCrc And &HFFFFFFFE) / 2&) And &H7FFFFFFF
            End If
        Next j
        crc32Table(i) = dwCrc
    Next i

End Sub

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "cBinaryFileStream"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private m_sFile As String
Private m_iFile As Integer
Private m_iLen As Long
Private m_iOffset As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Public Property Get File() As String
   File = m_sFile
End Property
Public Property Let File(ByVal sFile As String)
   Dispose
   m_sFile = sFile
   Dim lErr As Long
   If (FileExists(m_sFile, lErr)) Then
      m_iFile = FreeFile
      Open m_sFile For Binary Access Read Lock Write As #m_iFile
      m_iLen = LOF(m_iFile)
   Else
      Err.Raise lErr, App.EXEName & ".File"
   End If
End Property

Private Function FileExists(ByVal sFile As String, ByRef lErr As Long) As Boolean
  
   lErr = 0
   On Error Resume Next
   Dim sDir As String
   sDir = Dir(sFile)
   lErr = Err.Number
   On Error GoTo 0
  
   If (lErr = 0) Then
      If (Len(sDir) > 0) Then
         FileExists = True
      Else
         lErr = 53
      End If
   End If
  
End Function

Public Property Get Length() As Long
   Length = m_iLen
End Property

Public Function Read( _
      buffer() As Byte, _
      ByVal readSize As Long _
   ) As Long
  
   Dim lReadSize As Long
   lReadSize = readSize
   If (m_iOffset + lReadSize >= m_iLen) Then
      readSize = m_iLen - m_iOffset
      If (readSize > 0) Then
         ReDim newBuffer(0 To readSize - 1) As Byte
         Get #m_iFile, , newBuffer
         CopyMemory buffer(0), newBuffer(0), readSize
      Else
         Dispose
      End If
      m_iOffset = m_iOffset + readSize
   Else
      ' Can read
      Get #m_iFile, , buffer
      m_iOffset = m_iOffset + readSize
   End If
   Read = readSize
  
End Function

Public Sub Dispose()
   If (m_iFile) Then
      Close #m_iFile
      m_iFile = 0
   End If
End Sub

Private Sub Class_Terminate()
   Dispose
End Sub