password feuille, cryptage md5 ?

[mikael2235]

Bonjour à tous,

Dans un fichier, je crypte mes feuilles via une macro dans Workbook Open.

Le problème est que mon mot de passe apparait en clair dans VB Editor.


Est-il possible de crypter le mot de passe en md5, par exemple (comme en php) ?

Merci

 

[phlaurent55]

Re : password feuille, cryptage md5 ?

Bonjour Mikael,

Le problème est que mon mot de passe apparait en clair dans VB Editor.

il te suffit de protéger ton code VB par mot de passe
et il sera alors inaccessible pour la plupart des utilisateurs
voir exemple en pièce jointe ( le mot de passe est mikael )

à+
Philippe

 

[mromain]

Re : password feuille, cryptage md5 ?

Bonjour Mikael, Philippe[

Une autre solution est apportée ici.

a+

 

[Staple1600]

Re : password feuille, cryptage md5 ?

Bonsoir

Pour ce qui est du md5 (et plus)
En cherchant ici et là sur le net

Tu trouves des exemples, comme celui-ci par exemple
Pour tester:

Sub test_md5()
MsgBox HashString("ForumXLD")
End Sub

Option Explicit
[COLOR=Green]'auteur: xiaoj[/COLOR]
Private Const HP_HASHVAL = 2
Private Const HP_HASHSIZE = 4
Private Const PROV_RSA_FULL = 1
Private Const ALG_CLASS_HASH = 32768
Private Const ALG_TYPE_ANY = 0
Private Const ALG_SID_MD2 = 1
Private Const ALG_SID_MD4 = 2
Private Const ALG_SID_MD5 = 3
Private Const ALG_SID_SHA1 = 4
Private Const CRYPT_NEWKEYSET = &H8

Enum HashAlgorithm
    MD2 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2
    MD4 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4
    MD5 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5
    SHA1 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA1
End Enum

Private Declare Function CryptAcquireContext Lib "Advapi32" Alias "CryptAcquireContextA" (ByRef phProv As Long, ByVal pszContainer As String, ByVal pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptReleaseContext Lib "Advapi32" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "Advapi32" (ByVal hProv As Long, ByVal Algid As Long, ByVal hKey As Long, ByVal dwFlags As Long, ByRef phHash As Long) As Long
Private Declare Function CryptDestroyHash Lib "Advapi32" (ByVal hHash As Long) As Long
Private Declare Function CryptHashData Lib "Advapi32" (ByVal hHash As Long, pbData As Any, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptGetHashParam Lib "Advapi32" (ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, pdwDataLen As Long, ByVal dwFlags As Long) As Long

Public Function HashString(ByVal Str As String, Optional ByVal Algorithm As HashAlgorithm = MD5) As String
    On Error Resume Next
    Dim hCtx As Long
    Dim hHash As Long
    Dim lRes As Long
    Dim lLen As Long
    Dim lIdx As Long
    Dim abData() As Byte
    lRes = CryptAcquireContext(hCtx, vbNullString, vbNullString, PROV_RSA_FULL, 0)
    If lRes <> 0 Then
        lRes = CryptCreateHash(hCtx, Algorithm, 0, 0, hHash)
        If lRes <> 0 Then
            lRes = CryptHashData(hHash, ByVal Str, Len(Str), 0)
            If lRes <> 0 Then
                lRes = CryptGetHashParam(hHash, HP_HASHSIZE, lLen, 4, 0)
                If lRes <> 0 Then
                    ReDim abData(0 To lLen - 1)
                    lRes = CryptGetHashParam(hHash, HP_HASHVAL, abData(0), lLen, 0)
                    If lRes <> 0 Then
                        For lIdx = 0 To UBound(abData)
                            HashString = HashString & Right$("0" & Hex$(abData(lIdx)), 2)
                        Next
                    End If
                End If
            End If
            CryptDestroyHash hHash
        End If
       
    End If
    CryptReleaseContext hCtx, 0
    If lRes = 0 Then
        Err.Raise Err.LastDllError
    End If
End Function