| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
共有 897 人关注过本帖
标题:VB 如何计算文件的MD5校验
只看楼主 加入收藏
aaron96031
Rank: 1
等 级:新手上路
帖 子:2
专家分:0
注 册:2013-12-5
收藏
 问题点数:0 回复次数:3 
VB 如何计算文件的MD5校验
如标题,VB 如何计算文件的MD5校验, 目前正在找用控件的方法,但还未有实现,有大侠可以指点一二的么,谢谢!
搜索更多相关主题的帖子: MD5 VB 文件 计算 校验 
2023-08-18 10:15
约定的童话
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:56
帖 子:246
专家分:1442
注 册:2021-8-1
收藏
得分:0 
添加窗体按钮,加入下面代码试下(转载https://zhidao.baidu.com/question/1819476321040272948.html):
Option Explicit
Option Base 0
Public Type MD5_CTX
    i(1) As Long
    buf(3) As Long
    inc(63) As Byte
    digest(15) As Byte
End Type
 
Public Declare Sub MD5Init Lib "Cryptdll.dll" (ByVal pContex As Long)
Public Declare Sub MD5Final Lib "Cryptdll.dll" (ByVal pContex As Long)
Public Declare Sub MD5Update Lib "Cryptdll.dll" (ByVal pContex As Long, ByVal lPtr As Long, ByVal nSize As Long)
 
Public Function ConvBytesToBinaryString(bytesIn() As Byte) As String
    Dim i As Long
    Dim nSize As Long
    Dim strRet As String
     
    nSize = UBound(bytesIn)
    For i = 0 To nSize
         strRet = strRet & Right$("0" & Hex(bytesIn(i)), 2)
    Next
    ConvBytesToBinaryString = strRet
End Function
 
Public Function GetMD5Hash(bytesIn() As Byte) As Byte()
    Dim ctx As MD5_CTX
    Dim nSize As Long
     
    nSize = UBound(bytesIn) + 1
     
    MD5Init VarPtr(ctx)
    MD5Update ByVal VarPtr(ctx), ByVal VarPtr(bytesIn(0)), nSize
    MD5Final VarPtr(ctx)
     
    GetMD5Hash = ctx.digest
End Function
 
Public Function GetMD5Hash_Bytes(bytesIn() As Byte) As String
    GetMD5Hash_Bytes = ConvBytesToBinaryString(GetMD5Hash(bytesIn))
End Function
 
Public Function GetMD5Hash_String(ByVal strIn As String) As String
    GetMD5Hash_String = GetMD5Hash_Bytes(StrConv(strIn, vbFromUnicode))
End Function
 
Public Function GetMD5Hash_File(ByVal strFile As String) As String
    Dim lFile As Long
    Dim bytes() As Byte
    Dim lSize As Long
     
    lSize = FileLen(strFile)
    If (lSize) Then
        lFile = FreeFile
        ReDim bytes(lSize - 1)
        Open strFile For Binary As lFile
        Get lFile, , bytes
        Close lFile
        GetMD5Hash_File = GetMD5Hash_Bytes(bytes)
    End If
End Function
2023-08-18 17:21
yuma
Rank: 12Rank: 12Rank: 12
来 自:银河系
等 级:贵宾
威 望:37
帖 子:1933
专家分:3012
注 册:2009-12-22
收藏
得分:0 
'*******************************************
'
'    注意:编译后才能得到正确的文件md5值
'
'*******************************************
Option Explicit
Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" (ByRef phProv As Long, ByVal pszContainer As String, ByVal pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal hKey As Long, ByVal dwFlags As Long, ByRef phHash As Long) As Long
Private Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As Long
Private Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long, pbData As Any, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptGetHashParam Lib "advapi32.dll" (ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, pdwDataLen As Long, ByVal dwFlags As Long) As Long
Private Const PROV_RSA_FULL = 1
Private Const CRYPT_NEWKEYSET = &H8
Private Const ALG_CLASS_HASH = 32768
Private Const ALG_TYPE_ANY = 0
Private Const ALG_SID_MD2 = 1
Private Const ALG_SID_MD4 = 2
Private Const ALG_SID_MD5 = 3
Private Const ALG_SID_SHA1 = 4
Enum HashAlgorithm
    MD2 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2
    MD4 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4
    MD5 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5
    SHA1 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA1
End Enum
Private Const HP_HASHVAL = 2
Private Const HP_HASHSIZE = 4
Private Function File_md5(ByVal FileName As String, Optional ByVal Algorithm As HashAlgorithm = MD5) As String
     Dim hCtx As Long
     Dim hHash As Long
     Dim lFile As Long
     Dim lRes As Long
     Dim lLen As Long
     Dim lIdx As Long
     Dim abHash() As Byte
     If Len(Dir$(FileName)) = 0 Then Err.Raise 53
     lRes = CryptAcquireContext(hCtx, vbNullString, vbNullString, PROV_RSA_FULL, 0)
     If lRes = 0 And Err.LastDllError = &H80090016 Then
       lRes = CryptAcquireContext(hCtx, vbNullString, vbNullString, PROV_RSA_FULL, CRYPT_NEWKEYSET)
     End If
     If lRes <> 0 Then
        lRes = CryptCreateHash(hCtx, Algorithm, 0, 0, hHash)
        If lRes <> 0 Then
           lFile = FreeFile
           Open FileName For Binary As lFile
           If Err.Number = 0 Then
              Const BLOCK_SIZE As Long = 32 * 1024& ' 32K
ReDim abBlock(1 To BLOCK_SIZE) As Byte
              Dim lCount As Long
              Dim lBlocks As Long
              Dim lLastBlock As Long
              lBlocks = LOF(lFile) \ BLOCK_SIZE
              lLastBlock = LOF(lFile) - lBlocks * BLOCK_SIZE
              For lCount = 1 To lBlocks
                 Get lFile, , abBlock
                 lRes = CryptHashData(hHash, abBlock(1), BLOCK_SIZE, 0)
                 If lRes = 0 Then Exit For
              Next
              If lLastBlock > 0 And lRes <> 0 Then
                 ReDim abBlock(1 To lLastBlock) As Byte
                 Get lFile, , abBlock
                 lRes = CryptHashData(hHash, abBlock(1), lLastBlock, 0)
              End If
              Close lFile
           End If
           If lRes <> 0 Then
              lRes = CryptGetHashParam(hHash, HP_HASHSIZE, lLen, 4, 0)
              If lRes <> 0 Then
                  ReDim abHash(0 To lLen - 1)
                  lRes = CryptGetHashParam(hHash, HP_HASHVAL, abHash(0), lLen, 0)
                  If lRes <> 0 Then
                      For lIdx = 0 To UBound(abHash)
                          File_md5 = File_md5 & Right$("0" & Hex$(abHash(lIdx)), 2)
                          DoEvents
                      Next
                  End If
              End If
           End If
           CryptDestroyHash hHash
        End If
     End If
     CryptReleaseContext hCtx, 0
     If lRes = 0 Then Err.Raise Err.LastDllError
End Function

Private Sub Form_Load()
MsgBox File_md5("C:\Windows\notepad.exe")
End Sub

心生万象,万象皆程序!
本人计算机知识网:http://bbs.为防伸手党,本站已停止会员注册。
2023-08-27 15:47
yuma
Rank: 12Rank: 12Rank: 12
来 自:银河系
等 级:贵宾
威 望:37
帖 子:1933
专家分:3012
注 册:2009-12-22
收藏
得分:0 
我最不缺的就是代码。

心生万象,万象皆程序!
本人计算机知识网:http://bbs.为防伸手党,本站已停止会员注册。
2023-08-27 15:49
快速回复:VB 如何计算文件的MD5校验
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.016210 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved