模块代码如下:
===================================================
Option ExplicitPublic 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 LongPrivate 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
Function HashFile( _
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 53lRes = CryptAcquireContext(hCtx, vbNullString, _
vbNullString, PROV_RSA_FULL, 0)If lRes = 0 And Err.LastDllError = &H80090016 ThenlRes = CryptAcquireContext(hCtx, vbNullString, _
vbNullString, PROV_RSA_FULL, CRYPT_NEWKEYSET)
End IfIf lRes <> 0 Then
lRes = CryptCreateHash(hCtx, Algorithm, 0, 0, hHash)
If lRes <> 0 Then
lFile = FreeFileOpen FileName For Binary As lFileIf Err.Number = 0 ThenConst 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 LonglBlocks = LOF(lFile) \ BLOCK_SIZElLastBlock = LOF(lFile) - lBlocks * BLOCK_SIZEFor lCount = 1 To lBlocksGet lFile, , abBlocklRes = CryptHashData(hHash, abBlock(1), BLOCK_SIZE, 0)If lRes = 0 Then Exit ForNext
If lLastBlock > 0 And lRes <> 0 ThenReDim abBlock(1 To lLastBlock) As Byte
Get lFile, , abBlocklRes = CryptHashData(hHash, abBlock(1), lLastBlock, 0)End IfClose lFileEnd If
If lRes <> 0 ThenlRes = 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)
HashFile = HashFile & _
Right$("0" & Hex$(abHash(lIdx)), 2)
Next
End If
End If
End If
CryptDestroyHash hHash
End IfEnd If
CryptReleaseContext hCtx, 0
If lRes = 0 Then Err.Raise Err.LastDllError
End Function
'用法 例如: MsgBox HashFile("c:\123.exe")
=================================================================
这个模块验证小文件是没多大问题
但是经过测试验证貌似超过2G的文件得到的MD5值都是D41D8CD98F00B204E9800998ECF8427E,2G的单个文件和3G的单个文件都一样高手能不能改改让这个模块能够验证大文件的啊,还有最好能弄个进度条并且显示百分比的
谢谢各位高手
要是有更好的MD5文件验证模块发出来同样给分哦
分要是不够,我可以再开一帖加分,目前最大分只能100,多多见谅啊。