¿Cómo obtener el hash hexadecimal MD5 para un archivo usando VBA?

Question

¿Cómo puedo obtener el hash hexadecimal MD5 para un archivo usando VBA?

Necesito una versión que funcione para un archivo.

Algo tan simple como el código Python:

import hashlib 

def md5_for_file(fileLocation, block_size=2**20): 
    f = open(fileLocation) 
    md5 = hashlib.md5() 
    while True: 
     data = f.read(block_size) 
     if not data: 
      break 
     md5.update(data) 
    f.close() 
    return md5.hexdigest() 

Pero en VBA.

Answer 1

http://www.di-mgt.com.au/crypto.html#MD5

Answer 2

Esto debe hacerlo:

 Dim fileBytes() As Byte = File.ReadAllBytes(path:=fullPath) 
     Dim Md5 As New MD5CryptoServiceProvider() 
     Dim byteHash() As Byte = Md5.ComputeHash(fileBytes) 
     Return Convert.ToBase64String(byteHash) 

Answer 3

Una cuestión edad que puedan utilizar una mejor respuesta. Estas funciones son específicamente para hash de archivos, no para contraseñas hash. Como beneficio adicional, incluyo una función para SHA1. Si se deshace de las declaraciones de tipo, estas funciones también funcionan en VBScript, excepto que la función GetFileBytes debe cambiarse para usar FileSystemObject (o posiblemente ADO Stream) ya que Free File no existe en VBScript.

Private Sub TestMD5() 
    Debug.Print FileToMD5Hex("C:\test.txt") 
    Debug.Print FileToSHA1Hex("C:\test.txt") 
End Sub 

Public Function FileToMD5Hex(sFileName As String) As String 
    Dim enc 
    Dim bytes 
    Dim outstr As String 
    Dim pos As Integer 
    Set enc = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider") 
    'Convert the string to a byte array and hash it 
    bytes = GetFileBytes(sFileName) 
    bytes = enc.ComputeHash_2((bytes)) 
    'Convert the byte array to a hex string 
    For pos = 1 To LenB(bytes) 
     outstr = outstr & LCase(Right("0" & Hex(AscB(MidB(bytes, pos, 1))), 2)) 
    Next 
    FileToMD5Hex = outstr 
    Set enc = Nothing 
End Function 

Public Function FileToSHA1Hex(sFileName As String) As String 
    Dim enc 
    Dim bytes 
    Dim outstr As String 
    Dim pos As Integer 
    Set enc = CreateObject("System.Security.Cryptography.SHA1CryptoServiceProvider") 
    'Convert the string to a byte array and hash it 
    bytes = GetFileBytes(sFileName) 
    bytes = enc.ComputeHash_2((bytes)) 
    'Convert the byte array to a hex string 
    For pos = 1 To LenB(bytes) 
     outstr = outstr & LCase(Right("0" & Hex(AscB(MidB(bytes, pos, 1))), 2)) 
    Next 
    FileToSHA1Hex = outstr 'Returns a 40 byte/character hex string 
    Set enc = Nothing 
End Function 

Private Function GetFileBytes(ByVal path As String) As Byte() 
    Dim lngFileNum As Long 
    Dim bytRtnVal() As Byte 
    lngFileNum = FreeFile 
    If LenB(Dir(path)) Then ''// Does file exist? 
     Open path For Binary Access Read As lngFileNum 
     ReDim bytRtnVal(LOF(lngFileNum) - 1&) As Byte 
     Get lngFileNum, , bytRtnVal 
     Close lngFileNum 
    Else 
     Err.Raise 53 
    End If 
    GetFileBytes = bytRtnVal 
    Erase bytRtnVal 
End Function