Получить контрольную сумму FCIV (или такую ​​же) в VBA

Question

Как я могу выполнить FCIV и получить хеш для файла, используя VBA?

Answer 1

Каждая чистая реализация VBA, которую я видел, была мучительно медленной (иногда более минуты на файл). Может быть способ сделать это, коснувшись библиотеки Windows COM, но я в настоящее время не знаю ни одного такого метода. (Я надеюсь, что кто-то знает об этом, и вы поймете, почему через секунду :)) Лучшее, что я смог придумать, - это несколько уродливый обходной путь, поэтому следующее предложение может не подойти во всех сценариях, но есть очень быстрая утилита командной строки доступна от MS здесь: http://support.microsoft.com/kb/841290. Утилита выполняет MD5 и SHA1. Хотя на сайте написано, что он для Windows XP, я могу убедиться, что он работает с версиями вплоть до Windows 7. Хотя я не пробовал на 64-битной версии.

Несколько предостережений:
1. Эта утилита не поддерживается. У меня никогда не было проблем с этим. Но это все еще вопрос.
2. Утилита должна присутствовать на любом компьютере, на котором вы собираетесь запустить код, и это может быть неосуществимо при всех обстоятельствах.
3. Очевидно, это что-то вроде хака / клуджа, поэтому вы можете немного протестировать его на наличие ошибок и т. Д.
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