file - 在 VBA 中获取 FCIV(或相同)校验和

Question

如何使用 VBA 执行 FCIV 并获取文件的哈希值？

Answer 1

我见过的每个纯 VBA 实现都非常慢(有时每个文件超过一分钟)。可能有一种方法可以通过点击 Windows COM 库来做到这一点，但我目前不知道有任何这样的方法。 (我希望有人知道其中一个，你很快就会明白为什么:))我能想到的最好的办法是一个有点丑陋的解决方法，所以以下建议可能并不适合所有情况，但有一个MS 提供的非常快速的命令行实用程序:http://support.microsoft.com/kb/841290 。该实用程序执行 MD5 和 SHA1。尽管该网站说它适用于 Windows XP，但我可以验证它是否适用于 Windows 7 及以上版本。不过，我还没有在 64 位上尝试过它。

一些注意事项:
1. 不支持该实用程序。我从来没有遇到过任何问题。但这仍然是一个考虑因素。
2. 该实用程序必须存在于您打算运行代码的任何计算机上，但这可能并非在所有情况下都可行。
3. 显然，这有点像 hack/kludge，因此您可能需要对其进行一些测试以了解错误情况等。
4.我刚刚把它拼凑在一起。我还没有测试过/使用过它。所以认真对待 3:)

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