vb计算文件的hash_语言综合

概述vb计算文件的hash值的一个类 ‘----------------来源于网络作者不详--------------------- Private Declare Function CryptAcquireContext Lib "advapi32.dll" _ Alias "CryptAcquireContextA" ( _ ByRef phProv As Long, _ ByVal p

vb计算文件的hash值的一个类

‘----------------来源于网络作者不详---------------------

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 Byte,_
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

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

' Check if the file exists (not the best method BTW!)
If Len(Dir$(filename)) = 0 Then Err.Raise 53

' Get default provIDer context handle
lRes = CryptAcquireContext(hCtx,vbNullString,_
vbNullString,PROV_RSA_FulL,0)

If lRes = 0 And Err.LastDllError = &H80090016 Then

' There's no default keyset container!!!
' Get the provIDer context and create
' a default keyset container
lRes = CryptAcquireContext(hCtx,CRYPT_NEWKEYSET)
End If

If lRes <> 0 Then

' Create the hash
lRes = CryptCreateHash(hCtx,Algorithm,hHash)

If lRes <> 0 Then

' Get a file handle
lfile = Freefile

' Open the file
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

' Calculate how many full blocks
' the file contains
lBlocks = LOF(lfile) / BLOCK_SIZE

' Calculate the remaining data length
lLastBlock = LOF(lfile) - lBlocks * BLOCK_SIZE

' Hash the blocks
For lCount = 1 To lBlocks

Get lfile,abBlock

' Add the chunk to the hash
lRes = CryptHashData(hHash,abBlock(1),BLOCK_SIZE,0)

' Stop the loop if CryptHashData fails
If lRes = 0 Then Exit For

Next

' Is there more data?
If lLastBlock > 0 And lRes <> 0 Then

' Get the last block
ReDim abBlock(1 To lLastBlock) As Byte
Get lfile,abBlock

' Hash the last block
lRes = CryptHashData(hHash,lLastBlock,0)

End If

' Close the file
Close lfile

End If

If lRes <> 0 Then

' Get the hash lenght
lRes = CryptGetHashParam(hHash,HP_HASHSIZE,lLen,4,0)

If lRes <> 0 Then

' Initialize the buffer
ReDim abHash(0 To lLen - 1)

' Get the hash value
lRes = CryptGetHashParam(hHash,HP_HASHVAL,abHash(0),0)

If lRes <> 0 Then

' Convert value to hex string
For lIDx = 0 To UBound(abHash)
Hashfile = Hashfile & _
Right$("0" & Hex$(abHash(lIDx)),2)
Next

End If

End If

End If

' Release the hash handle
CryptDestroyHash hHash

End If

End If

' Release the provIDer context
CryptReleaseContext hCtx,0

' Raise an error if lRes = 0
If lRes = 0 Then Err.Raise Err.LastDllError

End Function