Visual Basic for Applications/File Hashing in VBA

Summary

This section contains code for making file hashes, that is, hashes of entire files. String hash routines are given in another section. The code here does not include any seed or salt values to further modify the results.
The permissions for files need to be considered when attempting hashing. File hashing has to access files to obtain the bytes that they contain, though this does not involve actually running the files. In fact, this type of access is the main difference between string hashing and file hashing. Whenever files are accessed, error handling is needed. It is assumed here that the user will add his own error-handling, or that he will go around files that are troublesome before the hashing attempt. Users should know that the code cannot handle an empty text file; for example, a Notepad file that has been saved without text. The GetFileBytes routine will error. Although not a problem for most, in bulk automated use, users would be advised to exclude such empty text files by first testing them for zero size; a function has been included for this in case it is of use.
The empty file problem apart, those who want to access user files in folders that they have made themselves will not usually have any problems, and interested parties should know that there is a recursive file listing module in another section of this series that might be of related interest.

Code Listings

Using Built-in Windows Functions in VBA

The code to make hashes of STRINGS and for bulk file hashing is given elsewhere in this set. The panel below bears code that is virtually identical to that for strings, but with only slight modification, is used to make hashes of single whole FILES. The user provides a full path to the file as the starting parameter. A parameter option allows for a choice of hex or base-64 outputs. Functions are included for MD5, SHA1, SHA2-256, SHA2-384, and SHA2-512 hashes.

Option Explicit

Private Sub TestFileHashes()
    'run this to test the file hasher. Select or comment lines as necessary
    'enter your own paths for the files to test
    'Set a reference to mscorlib 4.0 64-bit
    
    Dim sFPath As String, b64 As Boolean, sH As String
    
    'set output type and path to target file
    'bB64 = False   'output hex
    bB64 = True     'output base-64
    sFPath = "C:\Users\Your Folder\Documents\test.txt"
    
    'enable any one line to test hash
    'sh=FileToMD5(sFPath, b64)
    'sh=FileToSHA1(sFPath, b64)
    'sh=FileToSHA256(sFPath, b64)
    'sH = FileToSHA384(sFPath, b64)
    sH = FileToSHA512(sFPath, b64)
    
    Debug.Print sH & vbNewLine & Len(sH) & " characters in length"
    MsgBox sH & vbNewLine & Len(sH) & " characters in length"

End Sub

Public Function FileToMD5(sFullPath As String, Optional bB64 As Boolean = False) As String
    'parameter full path with name of file returned in the function as an MD5 hash
    'Set a reference to mscorlib 4.0 64-bit
    
    Dim enc, bytes, outstr As String, pos As Integer
    
    Set enc = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
    'Convert the string to a byte array and hash it
    bytes = GetFileBytes(sFullPath)
    bytes = enc.ComputeHash_2((bytes))
    
    If bB64 = True Then
       FileToMD5 = ConvToBase64String(bytes)
    Else
       FileToMD5 = ConvToHexString(bytes)
    End If
        
    Set enc = Nothing

End Function

Public Function FileToSHA1(sFullPath As String, Optional bB64 As Boolean = False) As String
    'parameter full path with name of file returned in the function as an SHA1 hash
    'Set a reference to mscorlib 4.0 64-bit
    
    Dim enc, bytes, outstr As String, pos As Integer
    
    Set enc = CreateObject("System.Security.Cryptography.SHA1CryptoServiceProvider")
    'Convert the string to a byte array and hash it
    bytes = GetFileBytes(sFullPath) 'returned as a byte array
    bytes = enc.ComputeHash_2((bytes))
    
    If bB64 = True Then
       FileToSHA1 = ConvToBase64String(bytes)
    Else
       FileToSHA1 = ConvToHexString(bytes)
    End If
        
    Set enc = Nothing

End Function

Public Function FileToSHA256(sFullPath As String, Optional bB64 As Boolean = False) As String
    'parameter full path with name of file returned in the function as an SHA2-256 hash
    'Set a reference to mscorlib 4.0 64-bit
    
    Dim enc, bytes, outstr As String, pos As Integer
    
    Set enc = CreateObject("System.Security.Cryptography.SHA256Managed")
    'Convert the string to a byte array and hash it
    bytes = GetFileBytes(sFullPath) 'returned as a byte array
    bytes = enc.ComputeHash_2((bytes))
    
    If bB64 = True Then
       FileToSHA256 = ConvToBase64String(bytes)
    Else
       FileToSHA256 = ConvToHexString(bytes)
    End If
        
    Set enc = Nothing

End Function

Public Function FileToSHA384(sFullPath As String, Optional bB64 As Boolean = False) As String
    'parameter full path with name of file returned in the function as an SHA2-384 hash
    'Set a reference to mscorlib 4.0 64-bit
    
    Dim enc, bytes, outstr As String, pos As Integer
    
    Set enc = CreateObject("System.Security.Cryptography.SHA384Managed")
    'Convert the string to a byte array and hash it
    bytes = GetFileBytes(sFullPath) 'returned as a byte array
    bytes = enc.ComputeHash_2((bytes))
    
    If bB64 = True Then
       FileToSHA384 = ConvToBase64String(bytes)
    Else
       FileToSHA384 = ConvToHexString(bytes)
    End If
    
    Set enc = Nothing

End Function

Public Function FileToSHA512(sFullPath As String, Optional bB64 As Boolean = False) As String
    'parameter full path with name of file returned in the function as an SHA2-512 hash
    'Set a reference to mscorlib 4.0 64-bit
    
    Dim enc, bytes, outstr As String, pos As Integer
    
    Set enc = CreateObject("System.Security.Cryptography.SHA512Managed")
    'Convert the string to a byte array and hash it
    bytes = GetFileBytes(sFullPath) 'returned as a byte array
    bytes = enc.ComputeHash_2((bytes))
    
    If bB64 = True Then
       FileToSHA512 = ConvToBase64String(bytes)
    Else
       FileToSHA512 = ConvToHexString(bytes)
    End If
    
    Set enc = Nothing

End Function

Private Function GetFileBytes(ByVal sPath As String) As Byte()
    'makes byte array from file
    'Set a reference to mscorlib 4.0 64-bit
    
    Dim lngFileNum As Long, bytRtnVal() As Byte, bTest
    
    lngFileNum = FreeFile
    
    If LenB(Dir(sPath)) Then ''// Does file exist?
        
        Open sPath For Binary Access Read As lngFileNum
        
        'a zero length file content will give error 9 here
        
        ReDim bytRtnVal(0 To LOF(lngFileNum) - 1&) As Byte
        Get lngFileNum, , bytRtnVal
        Close lngFileNum
    Else
        Err.Raise 53 'File not found
    End If
    
    GetFileBytes = bytRtnVal
    
    Erase bytRtnVal

End Function

Function ConvToBase64String(vIn As Variant) As Variant
    'used to produce a base-64 output
    'Set a reference to mscorlib 4.0 64-bit
    
    Dim oD As Object
      
    Set oD = CreateObject("MSXML2.DOMDocument")
      With oD
        .LoadXML "<root />"
        .DocumentElement.DataType = "bin.base64"
        .DocumentElement.nodeTypedValue = vIn
      End With
    ConvToBase64String = Replace(oD.DocumentElement.Text, vbLf, "")
    
    Set oD = Nothing

End Function

Function ConvToHexString(vIn As Variant) As Variant
     'used to produce a hex output
    'Set a reference to mscorlib 4.0 64-bit
    
    Dim oD As Object
      
    Set oD = CreateObject("MSXML2.DOMDocument")
      
      With oD
        .LoadXML "<root />"
        .DocumentElement.DataType = "bin.Hex"
        .DocumentElement.nodeTypedValue = vIn
      End With
    ConvToHexString = Replace(oD.DocumentElement.Text, vbLf, "")
    
    Set oD = Nothing

End Function

Function GetFileSize(sFilePath As String, nSize As Long) As Boolean
    'use this to test for a zero file size
    'takes full path as string in sFileSize
    'returns file size in bytes in nSize
    
    Dim fs As FileSystemObject, f As File
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    If fs.FileExists(sFilePath) Then
        Set f = fs.GetFile(sFilePath)
        nSize = f.Size
        GetFileSize = True
        Exit Function
    End If

End Function

This article is issued from Wikibooks. The text is licensed under Creative Commons - Attribution - Sharealike. Additional terms may apply for the media files.