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 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 Dieser Tipp wurde bereits 36.753 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 sevOutBar 4.0 Vertikale Menüleisten á la Outlook Erstellen von Outlook ähnlichen Benutzer- interfaces - mit beliebig vielen Gruppen und Symboleinträgen. Moderner OfficeXP-Style mit Farbverläufen, Balloon-Tips, u.v.m. |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |