Public Function CRC32File( _
ByVal strFilename As String, _
Optional ByVal lngBlockSize As Long) As String
Dim lngCRC As Long
Dim intFreeFile As Integer
Dim lngOffset As Long
Dim lngSize As Long
Dim lngRead As Long
Dim barInput() As Byte
Dim lngIndex As Long
Dim b As Byte
Dim lngBlock As Long
lngCRC = &HFFFFFFFF
intFreeFile = FreeFile
Open strFilename For Binary As intFreeFile
lngOffset = 0
lngSize = LOF(intFreeFile)
Do
lngRead = IIf((lngOffset + lngBlockSize) > lngSize, lngSize - lngOffset, lngBlockSize)
ReDim barInput(lngRead - 1)
Get intFreeFile, lngOffset + 1, barInput
For lngIndex = 0 To UBound(barInput)
lngCRC = lngCRC Xor barInput(lngIndex)
For b = 0 To 7
lngBlock = lngCRC And &HFFFFFFFE
lngBlock = lngBlock \ &H2
lngBlock = lngBlock And &H7FFFFFFF
If (lngCRC And &H1) = 0 Then
lngCRC = lngBlock
Else
lngCRC = lngBlock Xor &HEDB88320
End If
Next
Next
lngOffset = lngOffset + lngRead
If lngOffset = lngSize Then
Exit Do
End If
Loop
Close intFreeFile
lngCRC = Not lngCRC
CRC32File = Right$("00000000" & Hex$(lngCRC), 8)
End Function