Obtenir la somme de contrôle FCIV (ou même) dans VBA

Question

Comment puis-je exécuter FCIV et obtenir un hachage pour un fichier en utilisant VBA?

Answer 1

Chaque implémentation VBA pure que j'ai vu a été douloureusement lente (parfois plus d'une minute par fichier). Il peut y avoir un moyen de faire cela en appuyant sur une bibliothèque COM Windows, mais je ne suis pas actuellement au courant d'une telle méthode. (J'espère que quelqu'un en connait un et vous verrez pourquoi dans une seconde :)) Le meilleur que j'ai pu trouver est un peu plus laid, donc la suggestion suivante peut ne pas convenir dans tous les scénarios, mais il y a un très utilitaire de ligne de commande rapide disponible auprès de MS ici: http://support.microsoft.com/kb/841290. L'utilitaire fait MD5 et SHA1. Bien que le site indique que c'est pour Windows XP, je peux vérifier qu'il fonctionne avec les versions jusqu'à et y compris Windows 7. Je ne l'ai pas essayé sur 64 bits cependant. Quelques précautions:
1. Cet utilitaire n'est pas pris en charge. Je n'ai jamais eu de problèmes avec ça. Mais c'est toujours une considération.
2. L'utilitaire doit être présent sur toute machine sur laquelle vous avez l'intention d'exécuter le code, ce qui peut ne pas être réalisable en toutes circonstances.
3. Évidemment, c'est un peu un hack/kludge donc vous voudrez peut-être tester un peu pour les conditions d'erreur, etc.
4. Je viens de claquer cela ensemble. Je n'ai pas testé/travaillé avec. Alors, prenez 3 au sérieux :)

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