2

FCIV を実行し、VBA を使用してファイルのハッシュを取得するにはどうすればよいですか?

4

1 に答える 1

3

私が見たすべての純粋な VBA 実装は、痛々しいほど遅かったです (ファイルごとに 1 分以上かかることもあります)。Windows COM ライブラリをタップすることでこれを行う方法があるかもしれませんが、私は現在そのような方法を認識していません。(ただし、誰かが知っていることを願っています。理由はすぐにわかります:)) MS から入手できる非常に高速なコマンド ライン ユーティリティ: http://support.microsoft.com/kb/841290。ユーティリティは MD5 と SHA1 を実行します。サイトには Windows XP 用と書かれていますが、Windows 7 までのバージョンで動作することを確認できます。ただし、64 ビットでは試していません。

いくつかの注意事項:
1. このユーティリティはサポートされていません。私はそれで何の問題もありませんでした。しかし、それはまだ考慮事項です。
2. ユーティリティは、コードを実行するマシンに存在する必要があり、これはすべての状況で実行できるとは限りません。
3. 明らかに、これはちょっとしたハック/クラッジなので、エラー状態などについて少しテストすることをお勧めします
。私はそれをテストしていません/それで働いていません。だから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 に答える