All pastes #261999 Raw Edit

Mine

public text v1 · immutable
#261999 ·published 2006-11-30 01:22 UTC
rendered paste body
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