CRC32 Checksumme Prüfsummenberechnung über eine Datei oder einer angegebene Datenmenge
Autor:   Dieter Otter	Bewertung:     [ Jetzt bewerten ]	Views:  36.734
www.tools4vb.de	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 31 Bewertung insgesamt: sehr gut Durchschnittliche Bewertung: 4.6 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Mit nachfolgendem Code ist es möglich, über eine angegebene Datenmenge (bspw. String) oder einer Datei eine CRC32-Checksumme (Prüfsumme) zu berechnen. Anhand der Prüfsumme kann dann bspw. nach einer Datenübertragung leicht festgestellt werden, ob die Daten vollständig und korrekt übertragen wurden. Auch für den Dateivergleich eignet sich die CRC32-Prüfsummenberechnung, indem man die beiden Prüfsummen ermitteln und miteinander vergleicht. Sind die Prüfsummen identisch ist auch der Dateiinhalt identisch.

Fügen Sie nachfolgende Code in ein Modul ein:

Option Explicit
 
' Polynom-Tabelle
Dim bCRC32Init As Boolean
Dim nCRC32LookUp() As Long

Public Sub CRC32_Init()
  ' Polynom-Tabelle erstellen
  ' Hier wird das offizielle Polynom verwendet, das
  ' auch von WinZip/PKZip verwendet wird
 
  ' Falls die LookUp-Tabelle bereits erstellt...
  If bCRC32Init Then Exit Sub
 
  Const nPolynom = &HEDB88320
 
  Dim i As Long
  Dim u As Long
 
  ReDim nCRC32LookUp(255)
  Dim nCRC32 As Long
 
  For i = 0 To 255
    nCRC32 = i
    For u = 0 To 7
      If (nCRC32 And 1) Then
        nCRC32 = (((nCRC32 And &HFFFFFFFE) \ 2&) And &H7FFFFFFF) _
          Xor nPolynom
      Else
        nCRC32 = ((nCRC32 And &HFFFFFFFE) \ 2&) And &H7FFFFFFF
      End If
    Next u
    nCRC32LookUp(i) = nCRC32
  Next i
  bCRC32Init = True
End Sub

' Der optionale Parameter "nResult" sollte nur von
' CRC32_File verwendet werden!
Public Function CRC32(ByRef Bytes() As Byte, _
  Optional ByVal nResult As Long = &HFFFFFFFF) As Long
 
  Dim i As Long
  Dim Index As Long
  Dim nSize As Long
 
  ' ggf. LookUp-Tabelle erstellen...
  If Not bCRC32Init Then CRC32_Init
 
  nSize = UBound(Bytes)
  For i = 0 To nSize
    Index = (nResult And &HFF) Xor Bytes(i)
    nResult = (((nResult And &HFFFFFF00) \ &H100) And 16777215) _
      Xor nCRC32LookUp(Index)
  Next i
 
  CRC32 = Not (nResult)
End Function

' CRC32-Checksumme einer Datei berechnen
Public Function CRC32FromFile(ByVal sFile As String) As Long
  ' Um die Verarbeitung von großen Dateien zu beschleunigen,
  ' wird der Inhalt blockweise ausgelesen. Hierbei hat sich
  ' eine Blockgröße von 4096 Bytes (4 KB) als sehr gut erwiesen
  Const BlockSize As Long = 4096
 
  Dim FileSize As Long
  Dim FilePos As Long
  Dim BytesToRead As Long
  Dim nResult As Long
  Dim Bytes() As Byte
  Dim F As Integer
 
  On Error GoTo ErrHandler
 
  ' Datei binär öffnen
  F = FreeFile
  Open sFile For Binary Access Read Shared As #F
 
  ' Dateigröße
  FileSize = LOF(F)
 
  ' Datei blockweise einlesen und verarbeiten
  nResult = &HFFFFFFFF
  ReDim Bytes(BlockSize - 1)
  While FilePos < FileSize
    If FilePos + BlockSize > FileSize Then
      BytesToRead = FileSize - FilePos
      ReDim Bytes(BytesToRead - 1)
    Else
      BytesToRead = BlockSize
    End If
 
    Get #F, , Bytes()
    nResult = Not (CRC32(Bytes, nResult))
 
    FilePos = FilePos + BytesToRead
  Wend
  Close #F
 
  CRC32FromFile = Not (nResult)
  On Error GoTo 0
  Exit Function
 
ErrHandler:
  If F > 0 Then Close #F
  CRC32FromFile = -1
End Function

Anwendungsbeispiele
Im ersten Beispiel soll die CRC32-Prüfsumme eines Strings berechnet werden:

Dim sText As String
sText = "Für diesen String soll die CRC32-Checksumme berechnet werden."
 
Dim nCRCSum As Long
nCRCSum = CRC32(StrConv(sText, vbFromUnicode))
 
MsgBox "CRC32-Checksumme: " & CStr(nCRCSum) & " bzw. &H" & Hex$(nCRCSum)

Das zweite Beispiel ermittelt die CRC32-Checksumme einer Datei:

Dim sFile As String
sFile = "d:\myfile.exe"
 
Dim nCRCSum As Long
nCRCSum = CRC32FromFile(sFile)
 
...

Das 3. Beispiel prüft anhand der CRC32-Checksummen, ob zwei Dateien identisch sind:

Dim sFile1 As String
Dim sFile2 As String
 
sFile1 = "d:\myfile1.exe"
sFile2 = "d:\myfile2.exe"
 
If FileLen(sFile1) = FileLen(sFile2) Then
  If CRC32FromFile(sFile1) = CRC32FromFile(sFile2) Then
    MsgBox "Die Dateien sind identisch!"
  End If
End If