Public Const ALG_CLASS_HASH = 32768 Public Const ALG_SID_MD2 = 1 Public Const ALG_SID_MD4 = 2 Public Const ALG_SID_MD5 = 3 Public Const ALG_SID_SHA1 = 4 Public Const ALG_TYPE_ANY = 0 Public Const CRYPT_NEWKEYSET = 8 Public Const HP_HASHVAL = 2 Public Const HP_HASHSIZE = 4 Public Const PROV_RSA_FULL = 1 Public 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 Public 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 Public Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As Long Public 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 Public Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long,ByVal dwDataLen As Long,ByVal dwFlags As Long) As Long Public Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long,ByVal dwFlags As Long) As Long Public Function CryptStr(ByVal Str As String,Optional ByVal CryptMode As String = "md5") As String CryptStr = CryptByte(StrConv(Str,vbFromUnicode),CryptMode) End Function Public 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,PROV_RSA_FULL,0) = 0 Then CryptAcquireContext hCtx,CRYPT_NEWKEYSET End If CryptCreateHash hCtx,Algorithm,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),0 CryptDestroyHash hHash CryptReleaseContext hCtx,0 For lRes = 0 To UBound(abHash) CryptByte = CryptByte & Right("0" & Hex(abHash(lRes)),2) Next Erase abHash End Function Public Function CryptFile(ByVal FileName As String,Optional ByVal CryptMode As String = "md5",Optional ByVal BlockSize As Long = 327680) As String Dim Algorithm 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,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,0 For lRes = 0 To UBound(abHash) CryptFile = CryptFile & Right("0" & Hex(abHash(lRes)),2) Next Erase abHash End Function