Di bawah ini merupakan class untuk mengetahui CRC32 dari sebuah file. Untuk keperluan ini copy dan pastekan kode di bawah ini ke dalam class, kemudian ganti nama kelasnya menjadi clsCRC.
Option Explicit
Private crcTable(0 To 255) As Long 'crc32
Private Function CRC32(ByRef bArrayIn() As Byte, ByVal lLen As Long, Optional ByVal lcrc As Long = 0) As Long
Dim lCurPos As Long
Dim lTemp As Long
If lLen = 0 Then Exit Function 'In case of empty file
lTemp = lcrc Xor &HFFFFFFFF 'lcrc is for current value from partial check on the partial array
For lCurPos = 0 To lLen
lTemp = (((lTemp And &HFFFFFF00) \ &H100) And &HFFFFFF) Xor (crcTable((lTemp And 255) Xor bArrayIn(lCurPos)))
Next lCurPos
CRC32 = lTemp Xor &HFFFFFFFF
End Function
Private Function BuildTable() As Boolean
Dim I As Long, x As Long, crc As Long
Const Limit = &HEDB88320 'usally its shown backward, cant remember what it was.
For I = 0 To 255
crc = I
For x = 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 x
crcTable(I) = crc
Next I
End Function
Private Sub Class_Initialize()
BuildTable
End Sub
Public Function CekCRC32(FileName As String) As String
Dim lngCrc As Long
Dim sCrc As Long
On Error GoTo ErrHandler
Open FileName For Binary Access Read As #1
ReDim tmp(LOF(1)) As Byte
Get #1, , tmp()
Close #1
lngCrc = UBound(tmp)
lngCrc = CRC32(tmp, lngCrc)
CekCRC32 = Hex(lngCrc)
Exit Function
ErrHandler:
MsgBox Err.Description, vbCritical, "Error"
End Function
Contoh penggunaan Class CRC32
Option Explicit
Private Sub Form_Load()
Dim crc As New clsCRC
MsgBox crc.CekCRC32("C:\boot.ini")
End Sub
