شروع ساخت پروژه ی آنتی ویروس متن باز ایرانی ...

[hadiroosta]

الگریتم CRC32 در VB

[

Private crcTable(0 To 255) As Long

 

Public Function GetCRC(ByVal PathFile As String) As String

    Dim B() As Byte, lcrc As Long

    On Error Resume Next

    If Len(PathFile) = 0 Then Exit Function

    Open PathFile For Binary Access Read As #1

    ReDim B(FileLen(PathFile) - 1)

    Get #1, , B

    Close #1

    lcrc = UBound(B())

    lcrc = CRC32(B(), lcrc)

    GetCRC = Hex(lcrc)

End Function

 

Public Sub BuildTable()

 

    Dim i As Long, X As Long, CRC As Long

    Const Limit = &HEDB88320

    For i = 0 To 255

        If GetInputState() <> 0 Then DoEvents

        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 Sub

 

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

    lTemp = lcrc Xor &HFFFFFFFF

    For lCurPos = 0 To lLen

        DoEvents

        lTemp = (((lTemp And &HFFFFFF00) \ &H100) And &HFFFFFF) _

            Xor (crcTable((lTemp And 255) Xor bArrayIn(lCurPos)))

    Next lCurPos

    CRC32 = lTemp Xor &HFFFFFFFF

 

End Function

 

Private Sub Class_Initialize()

    BuildTable

End Sub