Option Explicit
Public Enum CRCAlgorithms
CRC16
CRC32
End Enum
Private m_Algorithm As Boolean
Private m_CRC16 As Long
Private m_CRC16Asm() As Byte
Private m_CRC16Init As Boolean
Private m_CRC16Table(0 To 255) As Long
Private m_CRC32 As Long
Private m_CRC32Asm() As Byte
Private m_CRC32Init As Boolean
Private m_CRC32Table(0 To 255) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Function AddBytes(ByteArray() As Byte) As Variant
Dim ByteSize As Long
'We need to add a simple error trapping
'here because if the bytearray is not
'dimensioned we want it to just skip
'the assembler code call below
On Local Error GoTo NoData
'Precalculate the size of the byte array
ByteSize = UBound(ByteArray) - LBound(ByteArray) + 1
'No error trapping needed, if something
'goes bad below something is definitely
'fishy with your computer
On Local Error GoTo 0
'Run the pre-compiled assembler code
'for the current selected algorithm
Select Case m_Algorithm
Case CRC16
Call CallWindowProc(VarPtr(m_CRC16Asm(0)), VarPtr(m_CRC16), VarPtr(ByteArray(LBound(ByteArray))), VarPtr(m_CRC16Table(0)), ByteSize)
Case CRC32
Call CallWindowProc(VarPtr(m_CRC32Asm(0)), VarPtr(m_CRC32), VarPtr(ByteArray(LBound(ByteArray))), VarPtr(m_CRC32Table(0)), ByteSize)
End Select
NoData:
'返回当前 CRC 值
AddBytes = Value
End Function
Public Function AddString(Text As String) As Variant
'Convert the string into a byte array
'and send it to the function that can
'handle bytearrays
AddString = AddBytes(StrConv(Text, vbFromUnicode))
End Function
Public Property Let Algorithm(New_Value As CRCAlgorithms)
'Set the new algorithm
m_Algorithm = New_Value
'Make sure we have initialized the
'current selected algorithm
Select Case m_Algorithm
Case CRC16
If (Not m_CRC16Init) Then Call InitializeCRC16
Case CRC32
If (Not m_CRC32Init) Then Call InitializeCRC32
End Select
'Make sure we reset the data of the
'current selected algorithm
Call Clear
End Property
Public Property Get Algorithm() As CRCAlgorithms
Algorithm = m_Algorithm
End Property
Public Function CalculateBytes(ByteArray() As Byte) As Variant
'Reset the current CRC calculation
Call Clear
'Calculate the CRC from the bytearray
'and return the current CRC value
CalculateBytes = AddBytes(ByteArray)
End Function
Public Function CalculateFile(FileName As String) As Variant
Dim Filenr As Integer
Dim ByteArray() As Byte
'Make sure the file contains data
'to avoid errors later below
If (FileLen(FileName) = 0) Then Exit Function
DoEvents
'Open the file in binary mode, read
'the data into a bytearray and then
'close the file
' On ErrorGoTo CalcErrHandler
Filenr = FreeFile
Open FileName For Binary As #Filenr
ReDim ByteArray(0 To LOF(Filenr) - 1)
Get #Filenr, , ByteArray()
Close #Filenr
'Now send the bytearray to the function
'that can calculate a CRC from it
CalculateFile = CalculateBytes(ByteArray)
Exit Function
CalcErrHandler:
CalculateFile = "00000000"
End Function
Public Function CalculateString(Text As String)
'Convert the string into a bytearray
'and send it to the function that
'calculates the CRC from a bytearray
CalculateString = CalculateBytes(StrConv(Text, vbFromUnicode))
End Function
Public Property Get Value() As Variant
Select Case m_Algorithm
Case CRC16
Value = (m_CRC16 And 65535)
Case CRC32
Value = (Not m_CRC32)
End Select
End Property
Public Property Let Value(New_Value As Variant)
Select Case m_Algorithm
Case CRC16
m_CRC16 = New_Value
Case CRC32
m_CRC32 = New_Value
End Select
End Property
Private Sub InitializeCRC16()
Dim i As Long
Dim J As Long
Dim k As Long
Dim CRC As Long
Dim sASM As String
'Create the fixed lookup-table, this
'is calculated because it won't take
'long and is only done once
For i = 0 To 255
k = i * 256
CRC = 0
For J = 0 To 7
If (((CRC Xor k) And 32768) = 32768) Then
CRC = (CRC * 2) Xor &H1021
Else
CRC = (CRC * 2)
End If
k = k * 2
Next
m_CRC16Table(i) = CRC '(CRC And 65535)
Next
'Create a bytearray to hold the
'precompiled assembler code
sASM = "5589E55756505351528B45088B008B750C8B7D108B4D1431DB8A1E30E3668B149F30C66689D0464975EF25FFFF00008B4D0889015A595B585E5F89EC5DC21000"
ReDim m_CRC16Asm(0 To Len(sASM) \ 2 - 1)
For i = 1 To Len(sASM) Step 2
m_CRC16Asm(i \ 2) = Val("&H" & Mid$(sASM, i, 2))
Next
'Mark the CRC16 algorithm as initialized
m_CRC16Init = True
End Sub
Public Sub Clear()
'Here can be sloppy and reset both
'crc variables (this procedure will
'be more advanced when adding more
'checksums algorithms..)
m_CRC16 = 0
m_CRC32 = &HFFFFFFFF
End Sub
Private Sub InitializeCRC32()
Dim i As Long
Dim sASM As String
m_CRC32Table(0) = &H0
m_CRC32Table(1) = &H77073096
m_CRC32Table(2) = &HEE0E612C
m_CRC32Table(3) = &H990951BA
m_CRC32Table(4) = &H76DC419
m_CRC32Table(5) = &H706AF48F
m_CRC32Table(6) = &HE963A535
m_CRC32Table(7) = &H9E6495A3
m_CRC32Table(8) = &HEDB8832
m_CRC32Table(9) = &H79DCB8A4
m_CRC32Table(10) = &HE0D5E91E
m_CRC32Table(11) = &H97D2D988
m_CRC32Table(12) = &H9B64C2B
m_CRC32Table(13) = &H7EB17CBD
m_CRC32Table(14) = &HE7B82D07
m_CRC32Table(15) = &H90BF1D91
m_CRC32Table(16) = &H1DB71064
m_CRC32Table(17) = &H6AB020F2
m_CRC32Table(18) = &HF3B97148
m_CRC32Table(19) = &H84BE41DE
m_CRC32Table(20) = &H1ADAD47D
m_CRC32Table(21) = &H6DDDE4EB
m_CRC32Table(22) = &HF4D4B551
m_CRC32Table(23) = &H83D385C7
m_CRC32Table(24) = &H136C9856
m_CRC32Table(25) = &H646BA8C0
m_CRC32Table(26) = &HFD62F97A
m_CRC32Table(27) = &H8A65C9EC
m_CRC32Table(28) = &H14015C4F
m_CRC32Table(29) = &H63066CD9
m_CRC32Table(30) = &HFA0F3D63
m_CRC32Table(31) = &H8D080DF5
m_CRC32Table(32) = &H3B6E20C8
m_CRC32Table(33) = &H4C69105E
m_CRC32Table(34) = &HD56041E4
m_CRC32Table(35) = &HA2677172
m_CRC32Table(36) = &H3C03E4D1
m_CRC32Table(37) = &H4B04D447
m_CRC32Table(38) = &HD20D85FD
m_CRC32Table(39) = &HA50AB56B
m_CRC32Table(40) = &H35B5A8FA
m_CRC32Table(41) = &H42B2986C
m_CRC32Table(42) = &HDBBBC9D6
m_CRC32Table(43) = &HACBCF940
m_CRC32Table(44) = &H32D86CE3
m_CRC32Table(45) = &H45DF5C75
m_CRC32Table(46) = &HDCD60DCF
m_CRC32Table(47) = &HABD13D59
m_CRC32Table(48) = &H26D930AC
m_CRC32Table(49) = &H51DE003A
m_CRC32Table(50) = &HC8D75180
m_CRC32Table(51) = &HBFD06116
m_CRC32Table(52) = &H21B4F4B5
m_CRC32Table(53) = &H56B3C423
m_CRC32Table(54) = &HCFBA9599
m_CRC32Table(55) = &HB8BDA50F
m_CRC32Table(56) = &H2802B89E
m_CRC32Table(57) = &H5F058808
m_CRC32Table(58) = &HC60CD9B2
m_CRC32Table(59) = &HB10BE924
m_CRC32Table(60) = &H2F6F7C87
m_CRC32Table(61) = &H58684C11
m_CRC32Table(62) = &HC1611DAB
m_CRC32Table(63) = &HB6662D3D
m_CRC32Table(64) = &H76DC4190
m_CRC32Table(65) = &H1DB7106
m_CRC32Table(66) = &H98D220BC
m_CRC32Table(67) = &HEFD5102A
m_CRC32Table(68) = &H71B18589
m_CRC32Table(69) = &H6B6B51F
m_CRC32Table(70) = &H9FBFE4A5
m_CRC32Table(71) = &HE8B8D433
m_CRC32Table(72) = &H7807C9A2
m_CRC32Table(73) = &HF00F934
m_CRC32Table(74) = &H9609A88E
m_CRC32Table(75) = &HE10E9818
m_CRC32Table(76) = &H7F6A0DBB
m_CRC32Table(77) = &H86D3D2D
m_CRC32Table(78) = &H91646C97
m_CRC32Table(79) = &HE6635C01
m_CRC32Table(80) = &H6B6B51F4
m_CRC32Table(81) = &H1C6C6162
m_CRC32Table(82) = &H856530D8
m_CRC32Tab
vb.rar_CRC VB_vb crc
版权申诉
19 浏览量
2022-09-22
18:07:17
上传
评论
收藏 4KB RAR 举报
小波思基
- 粉丝: 74
- 资源: 1万+