技术宅的结界

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

QQ登录

只需一步,快速开始

搜索
热搜: 下载 VB C 实现 编写
查看: 61|回复: 3
收起左侧

【VB】VB6实现CRC32

[复制链接]

1060

主题

2443

帖子

6万

积分

用户组: 管理员

一只技术宅

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

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

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

x
[Visual Basic] 纯文本查看 复制代码
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

Sub CRC32_Init()
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
End Sub

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

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数组即可。

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

本帖被以下淘专辑推荐:

回复

使用道具 举报

36

主题

161

帖子

7373

积分

用户组: 管理员

UID
77
精华
11
威望
125 点
宅币
6765 个
贡献
142 次
宅之契约
0 份
在线时间
121 小时
注册时间
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
复制代码

38

主题

108

帖子

4805

积分

用户组: 管理员

UID
1043
精华
19
威望
223 点
宅币
3695 个
贡献
461 次
宅之契约
0 份
在线时间
758 小时
注册时间
2015-8-15
发表于 2020-7-4 22:45:38 | 显示全部楼层
我比较想说crc32需要区分算法,比方说我之前发过Castagnoli算法,并且SSE4.2就是算这玩意的。
flowers for Broken spirits - a woman turned into stake will hold the world in the basin of fire.

1060

主题

2443

帖子

6万

积分

用户组: 管理员

一只技术宅

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

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

本版积分规则

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

GMT+8, 2020-7-13 14:00 , Processed in 0.105392 second(s), 38 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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