none
Calcul de hash d'un fichier en VBA RRS feed

  • Question

  • Bonjour,

    J'essaie de calculer le hash d'un fichier Excel à l'aide de la classe "System.Security.Cryptography.SHA1Managed" mais je constate que la valeur change alors que le fichier n'a pas subi de modification.

    J'utilise Office 365 ProPlus 32 bits sur Windows 7 Entreprise 64 bits.

    Le code que j'utilise ci-dessous :

    Public Function SHA1(fileFullName As String) As String
        Dim text As Object
        Dim hashFunction As Object
       
        Dim fso As New FileSystemObject
        Dim fl As Scripting.file
        Dim myStream As TextStream
       
        Set text = CreateObject("System.Text.UTF8Encoding")
        Set hashFunction = CreateObject("System.Security.Cryptography.SHA1Managed")
        Set fl = fso.GetFile(fileFullName)
        Set myStream = fl.OpenAsTextStream(ForReading)
        SHA1 = ToBase64String(hashFunction.ComputeHash_2(text.GetBytes_4(myStream.ReadAll))) 
        myStream.Close
    End Function

    Function ToBase64String(rabyt)
      'Ref: http://stackoverflow.com/questions/1118947/converting-binary-file-to-base64-string
      With CreateObject("MSXML2.DOMDocument")
        .LoadXML "<root />"
        .DocumentElement.DataType = "bin.base64"
        .DocumentElement.nodeTypedValue = rabyt
        ToBase64String = Replace(.DocumentElement.text, vbLf, "")
      End With
    End Function

    lundi 19 février 2018 12:29

Toutes les réponses

  • Je ne sais pas ou ce situe le problème, mais moi je me sert de

    Private Sub TestMD5()
        Debug.Print FileToMD5Hex("C:\Users\...\test.xlsx")
        Debug.Print FileToSHA1Hex("C:\Users\...\test.xlsx")
    End Sub
    
    Public Function FileToMD5Hex(sFileName As String) As String
        Dim enc
        Dim bytes
        Dim outstr As String
        Dim pos As Integer
        Set enc = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
        'Convert the string to a byte array and hash it
        bytes = GetFileBytes(sFileName)
        bytes = enc.ComputeHash_2((bytes))
        'Convert the byte array to a hex string
        For pos = 1 To LenB(bytes)
            outstr = outstr & LCase(Right("0" & Hex(AscB(MidB(bytes, pos, 1))), 2))
        Next
        FileToMD5Hex = outstr
        Set enc = Nothing
    End Function
    
    Public Function FileToSHA1Hex(sFileName As String) As String
        Dim enc
        Dim bytes
        Dim outstr As String
        Dim pos As Integer
        Set enc = CreateObject("System.Security.Cryptography.SHA1CryptoServiceProvider")
        'Convert the string to a byte array and hash it
        bytes = GetFileBytes(sFileName)
        bytes = enc.ComputeHash_2((bytes))
        'Convert the byte array to a hex string
        For pos = 1 To LenB(bytes)
            outstr = outstr & LCase(Right("0" & Hex(AscB(MidB(bytes, pos, 1))), 2))
        Next
        FileToSHA1Hex = outstr 'Returns a 40 byte/character hex string
        Set enc = Nothing
    End Function
    
    Private Function GetFileBytes(ByVal path As String) As Byte()
        Dim lngFileNum As Long
        Dim bytRtnVal() As Byte
        lngFileNum = FreeFile
        If LenB(Dir(path)) Then ''// Does file exist?
            Open path For Binary Access Read As lngFileNum
            ReDim bytRtnVal(LOF(lngFileNum) - 1&) As Byte
            Get lngFileNum, , bytRtnVal
            Close lngFileNum
        Else
            Err.Raise 53
        End If
        GetFileBytes = bytRtnVal
        Erase bytRtnVal
    End Function
    J'ai  trouvé ça il y a des années de cela dans un autre forum.


    Daniel Pineault, 2010-2017 Microsoft MVP
    Professional Support: http://www.cardaconsultants.com
    MS Access Tips and Code Samples: http://www.devhut.net

    lundi 19 février 2018 12:58
  • Bonjour Daniel ,

    Merci pour l'informations. Ca me semble maintenant plus logique de l'ouvrir en binaire . C'est un peu comme la différence entre la taille sur le disque et la taille réelle du fichier.

    lundi 26 février 2018 09:52