Get FCIV (or same) checksum in VBA

Question

How can I execute FCIV and obtain a hash for a file using VBA?

Answer 1

Hi Travis,
Every pure VBA implementation I have seen has been painfully slow (sometimes over a minute per file). There may be a way to do this by tapping a Windows COM library but I am not currently aware of any such method. (I hope someome knows of one though and you'll see why in a second:)) The best I have been able to come up with is a somewhat ugly workaound so the following suggestion may not be suitable in all scenarios but there is a very fast command line utility available from MS here: http://support.microsoft.com/kb/841290. The utility does MD5 and SHA1. Although the site says it's for Windows XP I can verify it works with versions up through and including Windows 7. I haven't tried it on 64 bit though.

A few caveats:
1. This utility is unsupported. I have never had any issues with it. But it's still a consideration.
2. The utility would have to be present on any machine you intended to run the code on and this may not be feasible in all circumstances.
3. Obviously this is a bit of a hack/kludge so you may want to test it a little for error conditions etc.
4. I just banged this together. I haven't tested it/worked with it. So take 3 seriously:)

Option Explicit

Public Enum EHashType
    MD5
    SHA1
End Enum

''//Update this value to wherever you install FCIV:
Private Const mcstrFCIVPath As String = "C:\Windows\FCIV.exe"

Public Sub TestGetFileHash()
    Dim strMyFilePath As String
    Dim strMsg As String
    strMyFilePath = Excel.Application.GetOpenFilename
    If strMyFilePath <> "False" Then
        strMsg = "MD5: " & GetFileHash(strMyFilePath, MD5)
        strMsg = strMsg & vbNewLine & "SHA1: " & GetFileHash(strMyFilePath, SHA1)
        MsgBox strMsg, vbInformation, "Hash of: " & strMyFilePath
    End If
End Sub

Public Function GetFileHash(ByVal path As String, ByVal hashType As EHashType) As String
    Dim strRtnVal As String
    Dim strExec As String
    Dim strTempPath As String
    strTempPath = Environ$("TEMP") & "\" & CStr(CDbl(Now))
    If LenB(Dir(strTempPath)) Then
        Kill strTempPath
    End If
    strExec = Join(Array(Environ$("COMSPEC"), "/C", """" & mcstrFCIVPath, HashTypeToString(hashType), """" & path & """", "> " & strTempPath & """"))
    Shell strExec, vbHide
    Do
        If LenB(Dir(strTempPath)) Then
            strRtnVal = GetFileText(strTempPath)
        End If
    Loop Until LenB(strRtnVal)
    strRtnVal = Split(Split(strRtnVal, vbNewLine)(3))(0)
    GetFileHash = strRtnVal
End Function

Private Function HashTypeToString(ByVal hashType As String) As String
    Dim strRtnVal As String
    Select Case hashType
        Case EHashType.MD5
            strRtnVal = "-md5"
        Case EHashType.SHA1
            strRtnVal = "-sha1"
        Case Else
            Err.Raise vbObjectError, "HashTypeToString", "Unexpected Hash Type"
    End Select
    HashTypeToString = strRtnVal
End Function

Private Function GetFileText(ByVal filePath As String) As String
    Dim strRtnVal As String
    Dim lngFileNum As Long
    lngFileNum = FreeFile
    Open filePath For Binary Access Read As lngFileNum
    strRtnVal = String$(LOF(lngFileNum), vbNullChar)
    Get lngFileNum, , strRtnVal
    Close lngFileNum
    GetFileText = strRtnVal
End Function