获取vba中的fciv(或相同)校验和

我看到的每个纯vba实现都非常缓慢(有时每个文件超过一分钟)。可能有一种方法可以通过点击一个Windows COM库来做到这一点,但是我目前还没有意识到任何这种方法。(我希望有人知道这一点,你马上就会明白为什么:)我所能想到的最好的办法是做一件有点难看的工作,所以下面的建议可能不适用于所有情况,但有一个 非常 快速命令行实用程序,可从MS获取: http://support.microsoft.com/kb/841290 . 该实用程序执行MD5和SHA1。虽然该网站说它是为WindowsXP设计的,但我可以验证它是否适用于Windows7及更高版本。不过,我还没有试过64位。

值得注意的几个问题:
1。不支持此实用程序。我从来没有遇到过任何问题。但这仍然是一个考虑因素。
2。该实用程序必须存在于您打算在其上运行代码的任何计算机上,这在所有情况下都可能不可行。
三。显然,这是一个有点黑客/克洛奇,所以您可能想测试一下它的错误条件等。
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