[VB6] Рассчет хеша CRC32

Dragokas

Angry & Scary Developer
Команда форума
Супер-Модератор
Разработчик
Клуб переводчиков
Сообщения
7,814
Реакции
6,593
Код файла класса:

VB.NET / VBA:
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

' 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 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()

    ' 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
 
Вариант от моего товарища.
Автор: Файфель Б.Л.

В виде файла Excel (макрос VBA).
 

Вложения

  • CRC32.xls
    54 KB · Просмотры: 22
Последнее редактирование:
Hi everyone! Great work!
I used this source to implement my excel woorbook to pickup filename, dimension and last change of selected file, but for some files CRC32 hashtab is only 7 symbols instead 8.

For example hastab.exe give 0C3F9BDF, macro give C3F9BDF. Can to improve this macro? Thank you
 
Hi, sure.
You just need to use "Right$" function in the place where you obtain CalcFileCRC() result:
VB.NET / VBA:
Dim CRC As New CRC32
[B2] = Right$("0000000" & Hex(CRC.CalcFileCRC(Filename)), 8)
 

Вложения

  • CRC32.zip
    20.3 KB · Просмотры: 5
Назад
Сверху Снизу