VB6下利用API计算MD2 MD4 MD5 SHA1

Public Const ALG_CLASS_HASH = 32768Public Const ALG_SID_MD2 = 1Public Const ALG_SID_MD4 = 2Public Const ALG_SID_MD5 = 3Public Const ALG_SID_SHA1 = 4Public Const ALG_TYPE_ANY = 0Public Const CRYPT_NEWKEYSET = 8Public Const HP_HASHVAL = 2Public Const HP_HASHSIZE = 4Public Const PROV_RSA_FULL = 1Public 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 LongPublic 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 LongPublic Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As LongPublic 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 LongPublic Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long, pbData As Any, ByVal dwDataLen As Long, ByVal dwFlags As Long) As LongPublic Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As LongPublic Function CryptStr(ByVal Str As String, Optional ByVal CryptMode As String = "md5") As String    CryptStr = CryptByte(StrConv(Str, vbFromUnicode), CryptMode)End FunctionPublic Function CryptByte(ByRef Buffer() As Byte, Optional ByVal CryptMode As String = "md5") As String    Dim Algorithm As Long, hCtx As Long, lRes As Long, hHash As Long, lLen As Long, abHash() As Byte    Select Case LCase(CryptMode)        Case "md2"            Algorithm = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2        Case "md4"            Algorithm = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4        Case "md5"            Algorithm = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5        Case "sha1"            Algorithm = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA1        Case Else            Exit Function    End Select    If CryptAcquireContext(hCtx, vbNullString, vbNullString, PROV_RSA_FULL, 0) = 0 Then        CryptAcquireContext hCtx, vbNullString, vbNullString, PROV_RSA_FULL, CRYPT_NEWKEYSET    End If    CryptCreateHash hCtx, Algorithm, 0, 0, hHash    If UBound(Buffer) >= 0 Then CryptHashData hHash, Buffer(0), UBound(Buffer) + 1, 0    CryptGetHashParam hHash, HP_HASHSIZE, lLen, 4, 0    ReDim abHash(lLen - 1)    CryptGetHashParam hHash, HP_HASHVAL, abHash(0), lLen, 0    CryptDestroyHash hHash    CryptReleaseContext hCtx, 0    For lRes = 0 To UBound(abHash)        CryptByte = CryptByte & Right("0" & Hex(abHash(lRes)), 2)    Next    Erase abHashEnd FunctionPublic Function CryptFile(ByVal FileName As String, Optional ByVal CryptMode As String = "md5", Optional ByVal BlockSize As Long = 327680) As String    Dim Algorithm As Long, hCtx As Long, lRes As Long, hHash As Long, lLen As Long, abHash() As Byte, Data() As Byte, FN As Integer, FileSize As Long    Select Case LCase(CryptMode)        Case "md2"            Algorithm = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2        Case "md4"            Algorithm = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4        Case "md5"            Algorithm = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5        Case "sha1"            Algorithm = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA1        Case Else            Exit Function    End Select    If CryptAcquireContext(hCtx, vbNullString, vbNullString, PROV_RSA_FULL, 0) = 0 Then        CryptAcquireContext hCtx, vbNullString, vbNullString, PROV_RSA_FULL, CRYPT_NEWKEYSET    End If    CryptCreateHash hCtx, Algorithm, 0, 0, hHash    FN = FreeFile    ReDim Data(BlockSize - 1)    Open FileName For Binary As FN    FileSize = LOF(FN)    Do While FileSize > 0        Get FN, , Data        CryptHashData hHash, Data(0), IIf(FileSize > BlockSize, BlockSize, FileSize), 0        FileSize = FileSize - BlockSize    Loop    Erase Data    Close FN    CryptGetHashParam hHash, HP_HASHSIZE, lLen, 4, 0    ReDim abHash(lLen - 1)    CryptGetHashParam hHash, HP_HASHVAL, abHash(0), lLen, 0    CryptDestroyHash hHash    CryptReleaseContext hCtx, 0    For lRes = 0 To UBound(abHash)        CryptFile = CryptFile & Right("0" & Hex(abHash(lRes)), 2)    Next    Erase abHashEnd Function