明晨网络

    很多场合需要计算CRC32，这里给出一个好用的VB类模块。该模块可以计算字符串、字节数组、文件的crc32编码。明晨网络Mingchennet.com现在发布的模块，默认计算整个文件的CRC32，也可以通过设置FileStart和FileEnd，来计算文件中指定长度内的CRC32，比如计算1-10200范围内的二进制内容的crc32为123456，而后40个字节空间就用来存储这个结果123456，当x.exe启动时，计算出自身1-10200的crc32，再与后40字节存储的结果比较，看是否一致。这就是传说中的crc32自校检。当然，必须在exe编译后，用其他程序计算其前10200的crc32，再写入该exe的后40位中。
    该类模块对文件进行计算时，需要将文件转成二进制流，使用了FileStream类模块来实现
   罗嗦了一大堆，上代码。
    FileStream类模块

 

  '========================================  
   '模块名称：FileStream  
   '模块说明：本模块用来将文件转为二进制流，对文件进行CRC32编码计算时依赖本模块  
   '最后更新： 明晨网络 www.MingchenNet.com 2009-05-31 21:57  
   '========================================  
Option Explicit  
     
Private m_sFile As String 
Private m_iFile As Integer 
Private m_iLen As Long 
Private m_iOffset As Long 
Private m_Start As Long 
Private m_End 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)  
        'Seek #m_iFile, m_Start  
   Else 
        Err.Raise lErr, App.EXEName & ".File" 
    End If 
End Property 
'设置读取文件的开始位置  
Public Property Let FileStart(ByVal lStart As Long)  
    m_Start = lStart  
End Property 
   
'设置读取文件的结束位置  
Public Property Let FileEnd(ByVal lEnd As Long)  
    m_End = lEnd  
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, 7)  
    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_End) Then 
        readSize = m_End - 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 

核心CRC32类模块

 

'========================================  
   '模块名称：CRC32  
   '模块说明：本模块用来计算文件及字符串的CRC32编码  
   '最后更新： 明晨网络 www.MingchenNet.com 2009-05-31 21:57  
   '========================================  
Option Explicit  
     
    ' This code is taken from the VB.NET CRC32 algorithm  
   ' provided by Paul (wpsjr1@succeed.net) - Excellent work!  
     
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 GetStreamCrc32(ByRef stream As FileStream) 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 
     
    GetStreamCrc32 = Not (crc32Result)  
     
End Function 
   
   
Public Function GetFileCrc32(ByVal FilePath As String) As Long 
    Dim cStream As FileStream  
    Set cStream = New FileStream  
    cStream.File = FilePath  
    cStream.FileStart = 1  
    cStream.FileEnd = FileLen(FilePath) - 20  
    GetFileCrc32 = GetStreamCrc32(cStream)  
    Set cStream = Nothing 
End Function 
   
Public Function GetStringCrc32(ByVal Str As String) As Long 
    GetStringCrc32 = GetByteArrayCrc32(StrConv(Str, vbFromUnicode))  
End Function 
   
Private Sub Class_initialize()  
    ' This is the official polynomial used by CRC32 in PKZip.  
   ' Often the polynomial is shown reversed (04C11DB7).  
   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 

文章源自:明晨网络，admin，《VB下的CRC32编码类模块》，http://www.mingchennet.com/tec/code/vb/28.htm