【VB】VB6实现CRC32

0xAA55 · 发表于 2020-7-1 07:16:03

欢迎访问技术宅的结界，请注册或者登录吧。

您需要登录才可以下载或查看，没有账号？立即注册→加入我们

×

Option Explicit
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public g_CRC32_Table() As Long
Private Function ShR1(ByVal Value As Long) As Long
If Value >= 0 Then
ShR1 = Value \ &H2&
Else
ShR1 = ((Value And &H7FFFFFFF) \ &H2&) Or &H40000000
End If
End Function
Private Function ShR8(ByVal Value As Long) As Long
If Value >= 0 Then
ShR8 = Value \ &H100&
Else
ShR8 = ((Value And &H7FFFFFFF) \ &H100&) Or &H800000
End If
End Function
Private Sub CRC32_GenTable()
Erase g_CRC32_Table
ReDim g_CRC32_Table(255)
Dim I As Long, J As Long, Remainder As Long
Const Polynomial As Long = &HEDB88320
For I = 0 To 255
Remainder = I
For J = 0 To 7
If Remainder And 1 Then
Remainder = ShR1(Remainder) Xor Polynomial
Else
Remainder = ShR1(Remainder)
End If
Next
g_CRC32_Table(I) = Remainder
'Debug.Print Hex8(Remainder); ", ";
'If I Mod 4 = 3 Then Debug.Print
Next
End Sub
Sub CRC32_Init()
On Local Error GoTo ErrHandler
Dim ByteArray() As Byte
ByteArray = LoadResData("CRC_TABLE", "BIN")
ReDim g_CRC32_Table((UBound(ByteArray) + 1) / 4 - 1)
CopyMemory g_CRC32_Table(0), ByteArray(0), UBound(ByteArray) + 1
Exit Sub
ErrHandler:
CRC32_GenTable
End Sub
Function CRC32(ByVal CRC As Long, Data() As Byte) As Long
On Local Error GoTo ErrHandler
Dim I As Long
Start:
CRC32 = Not CRC
For I = LBound(Data) To UBound(Data)
CRC32 = g_CRC32_Table((CRC32 Xor Data(I)) And &HFF&) Xor ShR8(CRC32)
Next
CRC32 = Not CRC32
Exit Function
ErrHandler:
If Err.Number = 9 Then
Err.Clear
CRC32_Init
GoTo Start
Else
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End If
End Function

复制代码

其实CRC32需要的这个移位操作可以用整数除法实现。关键是：VB6的Long是有符号的，负数做除法的效果不同于移位，所以需要对负数做特殊处理。但总之，可以轻松实现。

CRC32需要CRC表，这个表可以直接做成RES资源，然后用LoadResData读出为Byte数组，再Copy成Long数组即可。

虽说这份代码会自动没有RES资源的时候，现场计算CRC表。

crc_table.zip (1.16 KB, 下载次数: 9)

Golden Blonde · 发表于 2020-7-4 03:17:21

还可以直接使用系统API。

Attribute VB_Name = "ModGetCRC32"
'*************************************************************************
'**模块名：ModGetCRC32
'**说明：调用系统提供的API取CRC32值
'**创建人：嗷嗷叫的老马
'**日期：2008年9月29日
'**备注: 紫水晶工作室版权所有
'** 更多模块/类模块请访问我站: http://www.m5home.com
'**版本：V1.0
'*************************************************************************
Option Explicit
Private Declare Function RtlComputeCrc32 Lib "ntdll.dll" (ByVal dwInitial As Long, _
ByVal pData As Long, _
ByVal iLen As Long) As Long
Public Function GetFileCRC32(ByVal FileName As String) As Long
'取文件CRC32值
'ByVal FileName As String
' 文件名
'返回值:
' 成功,返回CRC32值,十六进制.
' 失败,返回空字符串
'备注:
' 需要与内存映射类模块cMapFile配合
' Dim lRet As Long, lpFileMemory As Long, lFileLen As Long, tmpMapFile As New cMapFile
' lpFileMemory = tmpMapFile.MapFile(FileName, lFileLen) '取得文件指针与文件长度
' If lpFileMemory = 0 Then Exit Function
' lRet = RtlComputeCrc32(0, lpFileMemory, lFileLen)
' GetFileCRC32 = lRet
'============
Dim buffer() As Byte: buffer = ReadBin(FileName)
If IsByteArrayEmpty(buffer) Then
GetFileCRC32 = 0
Else
GetFileCRC32 = RtlComputeCrc32(0, VarPtr(buffer(0)), UBound(buffer) + 1)
End If
End Function
Public Function GetStringCRC32(ByVal InString As String) As Long
'取字符串CRC32值
Dim lRet As Long, tBuff() As Byte
tBuff = StrConv(InString, vbFromUnicode)
lRet = RtlComputeCrc32(0, VarPtr(tBuff(0)), UBound(tBuff) + 1)
GetStringCRC32 = lRet
End Function

复制代码

唐凌 · 发表于 2020-7-4 22:45:38

我比较想说crc32需要区分算法，比方说我之前发过Castagnoli算法，并且SSE4.2就是算这玩意的。

0xAA55 · 发表于 2020-7-5 08:06:31

tangptr@126.com 发表于 2020-7-4 22:45
我比较想说crc32需要区分算法，比方说我之前发过Castagnoli算法，并且SSE4.2就是算这玩意的。 ...

因为我的CRC32算法就叫CRC32（比较标准），所以我就这样了。我就提供这个CRC32。

gujin163 · 发表于 2024-2-7 11:05:17

啥也不说了，帖子就是带劲！

账号		自动登录	找回密码
密码			立即注册→加入我们

【VB】VB6实现CRC32

欢迎访问技术宅的结界，请注册或者登录吧。

本帖被以下淘专辑推荐:

相关帖子