找回密码
 立即注册→加入我们

QQ登录

只需一步,快速开始

搜索
热搜: 下载 VB C 实现 编写
查看: 3739|回复: 4

【VB】VB6实现CRC32

[复制链接]

1109

主题

1648

回帖

7万

积分

用户组: 管理员

一只技术宅

UID
1
精华
244
威望
743 点
宅币
24141 个
贡献
46222 次
宅之契约
0 份
在线时间
2291 小时
注册时间
2014-1-26
发表于 2020-7-1 07:16:03 | 显示全部楼层 |阅读模式

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

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

×
  1. Option Explicit
  2. Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  3. Public g_CRC32_Table() As Long
  4. Private Function ShR1(ByVal Value As Long) As Long
  5. If Value >= 0 Then
  6.     ShR1 = Value \ &H2&
  7. Else
  8.     ShR1 = ((Value And &H7FFFFFFF) \ &H2&) Or &H40000000
  9. End If
  10. End Function
  11. Private Function ShR8(ByVal Value As Long) As Long
  12. If Value >= 0 Then
  13.     ShR8 = Value \ &H100&
  14. Else
  15.     ShR8 = ((Value And &H7FFFFFFF) \ &H100&) Or &H800000
  16. End If
  17. End Function
  18. Private Sub CRC32_GenTable()
  19. Erase g_CRC32_Table
  20. ReDim g_CRC32_Table(255)
  21. Dim I As Long, J As Long, Remainder As Long
  22. Const Polynomial As Long = &HEDB88320
  23. For I = 0 To 255
  24.     Remainder = I
  25.     For J = 0 To 7
  26.         If Remainder And 1 Then
  27.             Remainder = ShR1(Remainder) Xor Polynomial
  28.         Else
  29.             Remainder = ShR1(Remainder)
  30.         End If
  31.     Next
  32.     g_CRC32_Table(I) = Remainder
  33.     'Debug.Print Hex8(Remainder); ", ";
  34.     'If I Mod 4 = 3 Then Debug.Print
  35. Next
  36. End Sub
  37. Sub CRC32_Init()
  38. On Local Error GoTo ErrHandler
  39. Dim ByteArray() As Byte
  40. ByteArray = LoadResData("CRC_TABLE", "BIN")
  41. ReDim g_CRC32_Table((UBound(ByteArray) + 1) / 4 - 1)
  42. CopyMemory g_CRC32_Table(0), ByteArray(0), UBound(ByteArray) + 1
  43. Exit Sub
  44. ErrHandler:
  45. CRC32_GenTable
  46. End Sub
  47. Function CRC32(ByVal CRC As Long, Data() As Byte) As Long
  48. On Local Error GoTo ErrHandler
  49. Dim I As Long
  50. Start:
  51. CRC32 = Not CRC
  52. For I = LBound(Data) To UBound(Data)
  53.     CRC32 = g_CRC32_Table((CRC32 Xor Data(I)) And &HFF&) Xor ShR8(CRC32)
  54. Next
  55. CRC32 = Not CRC32
  56. Exit Function
  57. ErrHandler:
  58. If Err.Number = 9 Then
  59.     Err.Clear
  60.     CRC32_Init
  61.     GoTo Start
  62. Else
  63.     Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
  64. End If
  65. End Function
复制代码
其实CRC32需要的这个移位操作可以用整数除法实现。关键是:VB6的Long是有符号的,负数做除法的效果不同于移位,所以需要对负数做特殊处理。但总之,可以轻松实现。

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

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

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

本帖被以下淘专辑推荐:

回复

使用道具 举报

55

主题

266

回帖

9310

积分

用户组: 管理员

UID
77
精华
16
威望
237 点
宅币
8184 个
贡献
251 次
宅之契约
0 份
在线时间
250 小时
注册时间
2014-2-22
发表于 2020-7-4 03:17:21 | 显示全部楼层
还可以直接使用系统API。
  1. Attribute VB_Name = "ModGetCRC32"
  2. '*************************************************************************
  3. '**模 块 名:ModGetCRC32
  4. '**说    明:调用系统提供的API取CRC32值
  5. '**创 建 人:嗷嗷叫的老马
  6. '**日    期:2008年9月29日
  7. '**备    注: 紫水晶工作室 版权所有
  8. '**          更多模块/类模块请访问我站:  http://www.m5home.com
  9. '**版    本:V1.0
  10. '*************************************************************************
  11. Option Explicit
  12. Private Declare Function RtlComputeCrc32 Lib "ntdll.dll" (ByVal dwInitial As Long, _
  13.                                                             ByVal pData As Long, _
  14.                                                             ByVal iLen As Long) As Long
  15. Public Function GetFileCRC32(ByVal FileName As String) As Long
  16.     '取文件CRC32值
  17.     'ByVal FileName As String
  18.     '       文件名
  19.     '返回值:
  20.     '       成功,返回CRC32值,十六进制.
  21.     '       失败,返回空字符串
  22.     '备注:
  23.     '       需要与内存映射类模块cMapFile配合
  24. '    Dim lRet As Long, lpFileMemory As Long, lFileLen As Long, tmpMapFile As New cMapFile
  25. '    lpFileMemory = tmpMapFile.MapFile(FileName, lFileLen)   '取得文件指针与文件长度
  26. '    If lpFileMemory = 0 Then Exit Function
  27. '    lRet = RtlComputeCrc32(0, lpFileMemory, lFileLen)
  28. '    GetFileCRC32 = lRet
  29. '============
  30.     Dim buffer() As Byte: buffer = ReadBin(FileName)
  31.     If IsByteArrayEmpty(buffer) Then
  32.         GetFileCRC32 = 0
  33.     Else
  34.         GetFileCRC32 = RtlComputeCrc32(0, VarPtr(buffer(0)), UBound(buffer) + 1)
  35.     End If
  36. End Function
  37. Public Function GetStringCRC32(ByVal InString As String) As Long
  38.     '取字符串CRC32值
  39.     Dim lRet As Long, tBuff() As Byte
  40.     tBuff = StrConv(InString, vbFromUnicode)
  41.     lRet = RtlComputeCrc32(0, VarPtr(tBuff(0)), UBound(tBuff) + 1)
  42.     GetStringCRC32 = lRet
  43. End Function
复制代码
回复 赞! 1 靠! 0

使用道具 举报

65

主题

113

回帖

1万

积分

用户组: 超级版主

OS与VM研究学者

UID
1043
精华
35
威望
789 点
宅币
8192 个
贡献
1094 次
宅之契约
0 份
在线时间
2034 小时
注册时间
2015-8-15
发表于 2020-7-4 22:45:38 | 显示全部楼层
我比较想说crc32需要区分算法,比方说我之前发过Castagnoli算法,并且SSE4.2就是算这玩意的。
回复 赞! 靠!

使用道具 举报

1109

主题

1648

回帖

7万

积分

用户组: 管理员

一只技术宅

UID
1
精华
244
威望
743 点
宅币
24141 个
贡献
46222 次
宅之契约
0 份
在线时间
2291 小时
注册时间
2014-1-26
 楼主| 发表于 2020-7-5 08:06:31 | 显示全部楼层
tangptr@126.com 发表于 2020-7-4 22:45
我比较想说crc32需要区分算法,比方说我之前发过Castagnoli算法,并且SSE4.2就是算这玩意的。 ...

因为我的CRC32算法就叫CRC32(比较标准),所以我就这样了。我就提供这个CRC32。
回复 赞! 靠!

使用道具 举报

1

主题

157

回帖

579

积分

用户组: 大·技术宅

UID
7535
精华
0
威望
0 点
宅币
421 个
贡献
0 次
宅之契约
0 份
在线时间
65 小时
注册时间
2021-10-16
发表于 2024-2-7 11:05:17 | 显示全部楼层
啥也不说了,帖子就是带劲!
回复 赞! 靠!

使用道具 举报

本版积分规则

QQ|申请友链||Archiver|小黑屋|技术宅的结界 ( 滇ICP备16008837号 )|网站地图

GMT+8, 2024-3-1 06:43 , Processed in 0.068549 second(s), 41 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表