Valeur MD5 d'un document.

Version imprimable

23/01/2015, 15h22
fanlabise31

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. :calim2:

Pouvez-vous m'aider?

Merci
23/01/2015, 15h31
kiki29

Salut, regarde ici pour les librairies et là 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 ....

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:

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 .......

24/01/2015, 21h58
clementmarcotte

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/

MD5

Salut, à adapter à ton contexte, en affectant un bouton à la procédure "Test_MD5"

Code:

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

SHA1

Salut, à adapter à ton contexte, en affectant un bouton à la procédure "Test_SHA1"

Code:

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

26/01/2015, 12h29
fanlabise31

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.
26/01/2015, 20h07
fanlabise31

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
27/01/2015, 00h55
kiki29

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.

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:

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
:P :roll:

29/01/2015, 17h04
kiki29

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.