[Code] Hash MD5, MD4, MD2, SHA1

Option Explicit

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 Any, 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 ALG_CLASS_HASH = 32768
Private Const ALG_TYPE_ANY = 0
Private Const HP_HASHVAL = 2
Private Const HP_HASHSIZE = 4

Private Const ALG_SID_MD2 = 1
Private Const ALG_SID_MD4 = 2
Private Const ALG_SID_MD5 = 3
Private Const ALG_SID_SHA1 = 4

Private Const CALG_MD2 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2
Private Const CALG_MD4 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4
Private Const CALG_MD5 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5
Private Const CALG_SHA1 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA1

Private Function CreateHash(ByVal Str As String, ByVal ConstVal As Long) As String
  
   Dim hCtx As Long
   Dim hHash As Long
   Dim lRes As Long
   Dim lLen As Long
   Dim lIdx As Long
   Dim abData() As Byte

   lRes = CryptAcquireContext(hCtx, vbNullString, "Microsoft Enhanced Cryptographic Provider v1.0", PROV_RSA_FULL, &HF0000000)
      
      If lRes <> 0 Then
         lRes = CryptCreateHash(hCtx, ConstVal, 0, 0, hHash)
            
            If lRes <> 0 Then
               lRes = CryptHashData(hHash, ByVal Str, Len(Str), 0)
                  
                  If lRes <> 0 Then
                     lRes = CryptGetHashParam(hHash, HP_HASHSIZE, lLen, 4, 0)
                        
                        If lRes <> 0 Then
                           ReDim abData(0 To lLen - 1)
                           lRes = CryptGetHashParam(hHash, HP_HASHVAL, abData(0), lLen, 0)
                              
                              If lRes <> 0 Then
                                    
                                    For lIdx = 0 To UBound(abData)
                                       CreateHash = CreateHash & Right$("0" & Hex$(abData(lIdx)), 2)
                                    Next
                              
                              End If
                        
                        End If
                  
                  End If
               
               CryptDestroyHash hHash
            End If
      
      End If
   
   CryptReleaseContext hCtx, 0
End Function

Contoh :
HashMD2 = LCase$(CreateHash(“Ivan Adinugraha”, CALG_MD2))
HashMD4 = LCase$(CreateHash(“Ivan Adinugraha”, CALG_MD4))
HashMD5 = LCase$(CreateHash(“Ivan Adinugraha”, CALG_MD5))
HashSHA1 = LCase$(CreateHash(“Ivan Adinugraha”, CALG_SHA1))

Advertisement