IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

VBA Discussion :

Valeur MD5 d'un document.


Sujet :

VBA

  1. #1
    Futur Membre du Club
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    Juillet 2014
    Messages
    18
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 47
    Localisation : France

    Informations professionnelles :
    Activité : Technicien maintenance
    Secteur : Aéronautique - Marine - Espace - Armement

    Informations forums :
    Inscription : Juillet 2014
    Messages : 18
    Points : 9
    Points
    9
    Par défaut Valeur MD5 d'un document.
    Bonjour,

    On me demande de m'assurer lors de l'ouverture d'un document que ce dernier n'a pas été modifié.

    Pour cela je souhaiterai calculer la valeur MD5 du document au moment de son ouverture. On pourrait aussi utiliser sa valeur CRC. J'ai déjà créé une macro qui permet de compter le nombre d'occurence (ligne, caractères, saut de pages...) puis qui transforme la valeur en Hexa. Malheureusement ce n'est pas assez robuste. Le MD5 checksum me parait être le plus adapté.

    Je n'arrive pas à appliquer ce que je trouve sur le net.

    Pouvez-vous m'aider?

    Merci

  2. #2
    Expert éminent sénior
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    Juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : Juin 2006
    Messages : 6 132
    Points : 11 274
    Points
    11 274
    Par défaut
    Salut, regarde ici pour les librairies et pour un exemple ( juste pour une chaîne ), donc à adapter

    PS : je me souviens d'avoir un fichier Excel qui fait du MD5 pour un fichier sélectionnable , mais je dois le retrouver sur mes CDs ....

  3. #3
    Expert éminent sénior
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    Juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : Juin 2006
    Messages : 6 132
    Points : 11 274
    Points
    11 274
    Par défaut CRC32
    Salut, je soliloque mais pour l'instant pas de trace du MD5 par contre pour CRC32 j'ai retrouvé ceci :
    A adapter à ton contexte, en affectant un bouton à la procédure "Test_Crc32"
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    Option Explicit
     
    Private Declare Function QueryPerformanceCounter Lib "kernel32" (X As Currency) As Boolean
    Private Declare Function QueryPerformanceFrequency Lib "kernel32" (X As Currency) As Boolean
     
    Sub Test_Crc32()
    Dim Debut As Currency, Fin As Currency, Freq As Currency
    Dim sFichier As Variant
    Dim sBuf As String
    Dim aiBuf() As Byte
    Dim iFichier As Integer
     
        sFichier = Application.GetOpenFilename(FileFilter:="Tous, *.*", Title:="Sélection Fichier")
        If sFichier = False Then Exit Sub
        QueryPerformanceCounter Debut
     
        iFichier = FreeFile
        Open sFichier For Binary Access Read As #iFichier
            sBuf = Input(LOF(iFichier), iFichier)
        Close iFichier
     
        aiBuf = StrConv(sBuf, vbFromUnicode)
        QueryPerformanceCounter Fin
        QueryPerformanceFrequency Freq
        With Feuil1
            .Cells(1, 1) = sFichier
            .Cells(1, 2) = Hex(Crc32(aiBuf))
            .Cells(1, 3) = Format((Fin - Debut) / Freq, "0.00 s")
            .Columns("A:C").AutoFit
            .Cells(1, 4).Select
        End With
     
    End Sub
     
    Private Function Crc32(aiBuf() As Byte) As Long
    Static aiCRC() As Long
    Static bInit As Boolean
    Dim i As Long, j As Long
    Dim iLookup As Integer
    Dim dwCrc As Long
    Const iPoly As Long = &HEDB88320
     
        If Not bInit Then
            ReDim aiCRC(0 To 255)
            For i = 0 To 255
                dwCrc = i
                For j = 8 To 1 Step -1
                    If (dwCrc And 1) Then
                        dwCrc = ((dwCrc And &HFFFFFFFE) \ 2&) And &H7FFFFFFF
                        dwCrc = dwCrc Xor iPoly
                    Else
                        dwCrc = ((dwCrc And &HFFFFFFFE) \ 2&) And &H7FFFFFFF
                    End If
                Next j
                aiCRC(i) = dwCrc
            Next i
            bInit = True
        End If
     
        Crc32 = &HFFFFFFFF
     
        For i = LBound(aiBuf) To UBound(aiBuf)
            iLookup = (Crc32 And &HFF) Xor aiBuf(i)
            Crc32 = ((Crc32 And &HFFFFFF00) \ &H100) And &HFFFFFF
            Crc32 = Crc32 Xor aiCRC(iLookup)
        Next i
     
        Crc32 = Not (Crc32)
    End Function
    les recherches archéologiques se poursuivent pour le MD5 .......

  4. #4
    Inactif  

    Homme Profil pro
    Développeur .NET
    Inscrit en
    Janvier 2012
    Messages
    4 904
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 67
    Localisation : Canada

    Informations professionnelles :
    Activité : Développeur .NET
    Secteur : Finance

    Informations forums :
    Inscription : Janvier 2012
    Messages : 4 904
    Points : 10 168
    Points
    10 168
    Billets dans le blog
    36
    Par défaut
    Bonjour,

    Si c'est pour vérifier un fichier Office, il y a probablement toutes les informations nécessaires dans les propriétés des fichiers.

    Sans être sur des vrais noms qui peuvent changer selon les versions, il y a :

    DateLastSaved
    DateLastModified
    LastModifiedBy

    À moins d'être un "Power User", comme ils disent en anglais, bien peu d'utilisateurs savent comment modifier ces données.

    En VBA on peu interroger les BuiltInDocumentProperties ou passer par DSOFile. La dernière version de DSoFile (2.1, il me semble) supporte aussi les formats Office 2007 et suivants.

    Un tutoriel:

    http://silkyroad.developpez.com/VBA/...etesClasseurs/
    À ma connaissance, le seul personnage qui a été diagnostiqué comme étant allergique au mot effort. c'est Gaston Lagaffe.

    Ô Saint Excel, Grand Dieu de l'Inutile.

    Excel n'a jamais été, n'est pas et ne sera jamais un SGBD, c'est pour cela que Excel s'appelle Excel et ne s'appelle pas Access junior.

  5. #5
    Expert éminent sénior
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    Juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : Juin 2006
    Messages : 6 132
    Points : 11 274
    Points
    11 274
    Par défaut MD5
    Salut, à adapter à ton contexte, en affectant un bouton à la procédure "Test_MD5"
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    Option Explicit
     
    Private Declare Function QueryPerformanceCounter Lib "kernel32" (X As Currency) As Boolean
    Private Declare Function QueryPerformanceFrequency Lib "kernel32" (X As Currency) As Boolean
     
    Sub Test_MD5()
    Dim Debut As Currency, Fin As Currency, Freq As Currency
    Dim sStr As String, sNom As String
     
        With Application.FileDialog(msoFileDialogFilePicker)
            .InitialFileName = ThisWorkbook.path & "\"
            .Title = "Sélection Fichier"
            .AllowMultiSelect = False
            .InitialView = msoFileDialogViewDetails
            .ButtonName = "Sélection Fichier"
            .Show
            If .SelectedItems.Count > 0 Then
                Application.StatusBar = ""
                QueryPerformanceCounter Debut
                DoEvents
                sNom = .SelectedItems(1)
                sStr = FileToMD5Hex(.SelectedItems(1))
                QueryPerformanceCounter Fin
                QueryPerformanceFrequency Freq
                With Feuil1
                    .Cells(1, 1) = sNom
                    .Cells(1, 2) = sStr
                    .Cells(1, 3) = Format((Fin - Debut) / Freq, "0.00 s")
                End With
            End If
        End With
        With Feuil1
            .Columns("A:C").AutoFit
            .Range("D1").Select
        End With
    End Sub
     
    Private Function FileToMD5Hex(sFileName As String) As String
    Dim enc As Object
    Dim bytes
    Dim outStr As String
    Dim pos As Long
        Set enc = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
        bytes = GetFileBytes(sFileName)
        bytes = enc.ComputeHash_2((bytes))
        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
     
    Private Function GetFileBytes(ByVal path As String) As Byte()
    Dim lngFileNum As Long
    Dim bytRtnVal() As Byte
        lngFileNum = FreeFile
        If LenB(Dir(path)) Then
            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

  6. #6
    Expert éminent sénior
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    Juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : Juin 2006
    Messages : 6 132
    Points : 11 274
    Points
    11 274
    Par défaut SHA1
    Salut, à adapter à ton contexte, en affectant un bouton à la procédure "Test_SHA1"
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    Option Explicit
     
    Private Declare Function QueryPerformanceCounter Lib "kernel32" (X As Currency) As Boolean
    Private Declare Function QueryPerformanceFrequency Lib "kernel32" (X As Currency) As Boolean
     
     
    Sub Test_SHA1()
    Dim Debut As Currency, Fin As Currency, Freq As Currency
    Dim sStr As String, sNom As String
     
        With Application.FileDialog(msoFileDialogFilePicker)
            .InitialFileName = ThisWorkbook.path & "\"
            .Title = "Sélection Fichier"
            .AllowMultiSelect = False
            .InitialView = msoFileDialogViewDetails
            .ButtonName = "Sélection Fichier"
            .Show
            If .SelectedItems.Count > 0 Then
                Application.StatusBar = ""
                QueryPerformanceCounter Debut
                DoEvents
                sNom = .SelectedItems(1)
                sStr = FileToSHA1Hex(.SelectedItems(1))
                QueryPerformanceCounter Fin
                QueryPerformanceFrequency Freq
                With Feuil1
                    .Cells(1, 1) = sNom
                    .Cells(1, 2) = sStr
                    .Cells(1, 3) = Format((Fin - Debut) / Freq, "0.00 s")
                End With
            End If
        End With
        With Feuil1
            .Columns("A:C").AutoFit
            .Range("D1").Select
        End With
    End Sub
     
    Private Function FileToSHA1Hex(sFileName As String) As String
    Dim enc As Object
    Dim bytes
    Dim outStr As String
    Dim pos As Long
        Set enc = CreateObject("System.Security.Cryptography.SHA1CryptoServiceProvider")
        bytes = GetFileBytes(sFileName)
        bytes = enc.ComputeHash_2((bytes))
        For pos = 1 To LenB(bytes)
            outStr = outStr & LCase$(Right$("0" & Hex$(AscB(MidB$(bytes, pos, 1))), 2))
        Next
        FileToSHA1Hex = outStr
        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
            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

  7. #7
    Futur Membre du Club
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    Juillet 2014
    Messages
    18
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 47
    Localisation : France

    Informations professionnelles :
    Activité : Technicien maintenance
    Secteur : Aéronautique - Marine - Espace - Armement

    Informations forums :
    Inscription : Juillet 2014
    Messages : 18
    Points : 9
    Points
    9
    Par défaut
    Bonjour à tous,

    Merci pour vos réponses, le WE étant passé par là je n'ai pas encore tester vos propositions. Je vais donc m'en occuper aujourd'hui et vous tiens au courant.

    Encore merci.

  8. #8
    Futur Membre du Club
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    Juillet 2014
    Messages
    18
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 47
    Localisation : France

    Informations professionnelles :
    Activité : Technicien maintenance
    Secteur : Aéronautique - Marine - Espace - Armement

    Informations forums :
    Inscription : Juillet 2014
    Messages : 18
    Points : 9
    Points
    9
    Par défaut
    Re-bonjour

    J'ai réussi à adapter les code MD5 et SHA1 à mon document word. Néanmoins je me retrouve face à un problème de taille.

    Il semble que, dans les 2 cas, la date de modification du document soit prise en compte. Ce qui est très gênant car je ne peux pas intégrer dans mon document son Checksum de référence.

    D'où ma question: est-il possible que le MD5 ne prenne en compte que le contenu du document? Il me semble qu'il devrait fonctionner ainsi...

    Merci

  9. #9
    Expert éminent sénior
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    Juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : Juin 2006
    Messages : 6 132
    Points : 11 274
    Points
    11 274
    Par défaut
    Salut, erreur fondamentale de ta part : le MD5 doit être calculé de façon externe au fichier, car sinon quand tu ouvres un fichier puis que tu le sauves avec cette info, le contenu change et donc le calcul du MD5 avec.....
    Les fonctions de hachage (MD5 et autres ) se foutent des dates et autres infos d'un fichier.
    Donc la personne recevant le fichier avec un autre fichier texte contenant le MD5 par exemple doit lancer un logiciel faisant ce calcul de MD5 et vérifier la concordance des 2 infos : celle fournie par le logiciel pour son fichier et celle du fichier texte accompagnant ce fichier.

    J'ai ce genre d'utilitaire sous forme d'exé autonome Delphi, tu peux également en trouver sur le net.

  10. #10
    Futur Membre du Club
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    Juillet 2014
    Messages
    18
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 47
    Localisation : France

    Informations professionnelles :
    Activité : Technicien maintenance
    Secteur : Aéronautique - Marine - Espace - Armement

    Informations forums :
    Inscription : Juillet 2014
    Messages : 18
    Points : 9
    Points
    9
    Par défaut
    Merci kiki pour toutes ces infos.

    J'ai réussi à faire ce que je voulais. C'est à dire réaliser un checksum d'un docuent à son ouverture. Par contre je te confirme que le MD5 semble prendre en compte la date du fichier. J'ai vérifier ceci avec MD5 checker.

    Pour info, j'ai utlisé tes fonctions mais j'ai du modifier la fonction GetFileBytes. Je retrouvais de manière aléatoire l'erreur 53. Je me suis contenté de d'ajouter un ChDir et de déclarer le fichier en variable. J'ai aussi remplacé la fonction LenB par Len. Tout marche impec.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
     
    Private Function GetFileBytes(ByVal path As String) As Byte()
    Dim lngFileNum As Long
    Dim bytRtnVal() As Byte
        lngFileNum = FreeFile
        Dim doc As String
        Dim rep As String
        Dim chemdoc As String
     
     
         rep = ThisDocument.path
         DoEvents
         doc = ThisDocument.Name
     
         chemdoc = rep & "\" & doc
     
     
        If Len(doc) Then 'La fonction LenB est remplacée par la fonction Len (voir MSDN)
        DoEvents
            Open chemdoc For Binary Access Read As lngFileNum
            DoEvents
                ReDim bytRtnVal(LOF(lngFileNum) - 1&) As Byte
                Get lngFileNum, , bytRtnVal
            Close lngFileNum
        Else
            Err.Raise 53
        End If
        GetFileBytes = bytRtnVal
        Erase bytRtnVal
    End Function

  11. #11
    Expert éminent sénior
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    Juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : Juin 2006
    Messages : 6 132
    Points : 11 274
    Points
    11 274
    Par défaut
    Salut, si tu lis les liens donnés plus haut tu verras que les fonctions de hachage se foutent des dates et autres infos de fichiers.
    Elles font une lecture binaire des fichiers pour générer une empreinte ( moins encombrante que le fichier lui-même ) permettant une identification rapide de ce dernier sans forcément y accéder.

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [PHPExcel] Faire une recherche d'une valeur dans tout le document
    Par Mut dans le forum Bibliothèques et frameworks
    Réponses: 4
    Dernier message: 03/10/2013, 15h56
  2. [XL-2007] Copier une valeur sur un nouveau document
    Par doji_lemaitre dans le forum Excel
    Réponses: 2
    Dernier message: 19/07/2013, 17h47
  3. VBA E valeur de cellule= nom du document
    Par yoyo3d dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 03/12/2007, 17h14
  4. dynContext : this.popup.document a une valeur null
    Par Madge dans le forum Général JavaScript
    Réponses: 10
    Dernier message: 20/09/2006, 09h22
  5. exportation d'une valeur dans un document html
    Par acd dans le forum VB 6 et antérieur
    Réponses: 3
    Dernier message: 28/11/2005, 22h34

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo