Option Explicit

Private Const ALG_CLASS_HASH As Long = (4 * 2 ^ 13)
Private Const ALG_CLASS_DATA_ENCRYPT = (3 < 13)
Private Const ALG_TYPE_STREAM = (4 < 9)

Private Const ALG_SID_RC4 = 1
Private Const ALG_SID_MD5 = 3
Private Const ALG_SID_SHA1 = 4


Private Const ALG_TYPE_ANY As Long = 0
Private Const CALG_MD5 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5)
'Private Const CALG_SHA1 = "0x00008004"
Private Const CALG_SHA1 = ((ALG_CLASS_HASH Or ALG_TYPE_ANY) Or ALG_SID_SHA1)
Private Const CALG_RC4 = ((ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_STREAM) Or ALG_SID_RC4)

Private Const CRYPT_VERIFYCONTEXT As Long = &HF0000000
Private Const PROV_RSA_FULL As Long = 1

Private Const HP_HASHSIZE As Long = &H4
Private Const HP_HASHVAL As Long = &H2

Private Declare Function CryptGetHashParam Lib "advapi32.dll" (ByVal hHash As Long, ByVal dwParam As Long, pByte As Any, ByRef pdwDataLen As Long, ByVal dwFlags As Long) As Long
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 CryptCreateHash Lib "advapi32.dll" (ByVal hProv As Long, ByRef Algid As Long, ByRef hKey As Long, ByVal dwFlags As Long, ByRef phHash As Long) As Long
Private Declare Function CryptDestroyHash Lib "advapi32.dll" (ByRef hHash As Long) As Long
Private Declare Function CryptHashData Lib "advapi32.dll" (ByRef hHash As Long, ByVal pbData As String, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByRef hProv As Long, ByRef dwFlags As Long) As Long

Public Function RC4DigestToHex(ByVal s As String) As String
    Dim hContext As Long
    Dim hHash As Long
    Dim dwDataLen As Long
    Dim b() As Byte
 
    CryptAcquireContext hContext, vbNullChar, vbNullChar, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT
    CryptCreateHash hContext, ByVal CALG_RC4, ByVal 0&, 0&, hHash
    
    CryptHashData ByVal hHash, s, Len(s), 0
    
    CryptGetHashParam hHash, HP_HASHSIZE, dwDataLen, 4, 0
    ReDim b(dwDataLen - 1)
    CryptGetHashParam hHash, HP_HASHVAL, b(0), dwDataLen, 0
    
    Dim str As String, i As Long
    For i = 0 To UBound(b)
        str = str & HexChar(b(i))
    Next i
    RC4DigestToHex = LCase$(str)
    
    CryptDestroyHash hHash
    CryptReleaseContext hContext, ByVal 0&
End Function

Public Function MD5DigestToHex(ByVal s As String) As String
    Dim hContext As Long
    Dim hHash As Long
    Dim dwDataLen As Long
    Dim b() As Byte
 
    CryptAcquireContext hContext, vbNullChar, vbNullChar, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT
    CryptCreateHash hContext, ByVal CALG_MD5, ByVal 0&, 0&, hHash
    
    CryptHashData ByVal hHash, s, Len(s), 0
    
    CryptGetHashParam hHash, HP_HASHSIZE, dwDataLen, 4, 0
    ReDim b(dwDataLen - 1)
    CryptGetHashParam hHash, HP_HASHVAL, b(0), dwDataLen, 0
    
    Dim str As String, i As Long
    For i = 0 To UBound(b)
        str = str & HexChar(b(i))
    Next i
    MD5DigestToHex = LCase$(str)
    
    CryptDestroyHash hHash
    CryptReleaseContext hContext, ByVal 0&
End Function

Public Function SHA1DigestToHex(ByVal s As String) As String
    Dim hContext As Long
    Dim hHash As Long
    Dim dwDataLen As Long
    Dim b() As Byte
 
    CryptAcquireContext hContext, vbNullChar, vbNullChar, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT
    CryptCreateHash hContext, ByVal CALG_SHA1, ByVal 0&, 0&, hHash
    
    CryptHashData ByVal hHash, s, Len(s), 0
    
    CryptGetHashParam hHash, HP_HASHSIZE, dwDataLen, 4, 0
    ReDim b(dwDataLen - 1)
    CryptGetHashParam hHash, HP_HASHVAL, b(0), dwDataLen, 0
    
    Dim str As String, i As Long
    For i = 0 To UBound(b)
        str = str & HexChar(b(i))
    Next i
    SHA1DigestToHex = LCase$(str)
    
    CryptDestroyHash hHash
    CryptReleaseContext hContext, ByVal 0&
End Function

Private Function HexChar(ByVal b As Byte) As String
    Dim s As String
    s = Hex(b)
    If Len(s) = 1 Then s = "0" & s
    HexChar = s
End Function