check_crc32.bas

包含几十个加密解密类和压缩解压缩类,DES,LZW,Huffman

Attribute VB_Name = "Check_CRC32"

' **********************************************************************
'  描  述：21种加密54种压缩 算法模块 海阔天空收集整理
'  Play78.com : 网站导航，源码之家，绝对开源
'  海阔天空整理,有问题请上www.paly78.com 提
'  网址：http://www.play78.com/
'  QQ：13355575
'  e-mail:[e-mail]
' **********************************************************************


Option Explicit
'This module calculates the CRC32-checksum of a certain bytestream

Dim CrcTableInit As Boolean
Dim CRCTable(0 To 255) As Long

Public Function calcCRC32(ByteArray() As Byte) As Long
    Dim i As Long
    Dim crc As Long
    If CrcTableInit = False Then Call Init_CRCTable
    crc = -1
    For i = 0 To UBound(ByteArray) - 1
        crc = (((crc And &HFFFFFF00) \ &H100) And &HFFFFFF) Xor (CRCTable((crc And &HFF) Xor ByteArray(i)))
    Next i
    crc = crc Xor &HFFFFFFFF
    calcCRC32 = crc
End Function

Private Sub Init_CRCTable()
    Dim i As Long
    Dim j As Long
    Dim Limit As Long
    Dim crc As Long
    Limit = &HEDB88320
    For i = 0 To 255
        crc = i
        For j = 0 To 7
            If crc And 1 Then
              crc = (((crc And &HFFFFFFFE) \ 2) And &H7FFFFFFF) Xor Limit
            Else
              crc = ((crc And &HFFFFFFFE) \ 2) And &H7FFFFFFF
            End If
        Next j
        CRCTable(i) = crc
    Next i
    CrcTableInit = True
End Sub