2

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

4

1 回答 1

3

我见过的每一个纯 VBA 实现都非常缓慢（有时每个文件超过一分钟）。可能有一种方法可以通过点击 Windows COM 库来做到这一点，但我目前不知道有任何此类方法。（我希望有人知道一个，你会在一秒钟内明白为什么:)）我能想到的最好的方法是一个有点丑陋的解决方法，所以下面的建议可能并不适合所有场景，但有一个非常快速的命令行实用程序可从 MS 获得：http: //support.microsoft.com/kb/841290。该实用程序执行 MD5 和 SHA1。虽然该网站说它适用于 Windows XP，但我可以验证它适用于 Windows 7 以上的版本，包括 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
于 2010-07-24T23:22:54.913 回答