Convertir un texte en chiffre

Logiciel & apps Logiciel Général
1

Bonjour,

Je ne suis pas fan d’excel pour faire des formules. donc mon souci c’est:

J’ai actuellement un fichier .csv pour mettre des users dans un AD automatiquement.
J’ai actuellement 3 colonnes ( 1:Nom, 2:Prénom, 3:Groupe) et je souhaite rajouter une colonne avec les mots de passe ( 1:Nom, 2:Prénom, 3:Mot de passe, 4:Groupe). Et je veux faire en sorte que soit par une formule soit en modifiant le vba, que la colonne 3 soit automatiquement créé en alphanumérique mais en prennent les colonnes 1&2 en référence.

se qui ferais (Ceci est un exemple):

(Colonne 1:Nom) Delbos + (Colonne 2: Prénoms) vincent = (Colonne3: Mot de passe) a25h5e836

Je vous remercie pour votre aide,

2

Je ne vois pas le rapport entre le titre et l’explication du problème :o(

Comment obtiens tu le mot de passe : a25h5e836 ???

3

Si j’ai bien compris, tu veux générer des mots de passe alphanumériques à partir des nom/prénoms? C’est pas une méthode que je recommande: si quelqu’un tombe sur le fichier servant à générer les mots de passe, ou bien découvre l’algo par rétro-ingénierie, c’est pas cool niveau sécurité :frowning:

En l’état actuel des choses, la solution la moins pire (enfin, celle que je te propose) consisterait à créer un password sur la base d’un hash, constitué par Nom+Prénom+Salt, puis une petite retouche (optionnelle) pour réduire un peu la taille du password.

Pour le hash, je propose d’implémenter une fonction VBA qui calcule un SHA-1 sur ta chaine de caractères. Pour faire tout ça, il “suffit” de créer un module dans le projet VBA, et d’y ajouter le code suivant:


Option Explicit

Private Type FourBytes
    A As Byte
    B As Byte
    C As Byte
    D As Byte
End Type
Private Type OneLong
    L As Long
End Type

Function HexDefaultSHA1(Message() As Byte) As String
 Dim H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long
 DefaultSHA1 Message, H1, H2, H3, H4, H5
 HexDefaultSHA1 = DecToHex5(H1, H2, H3, H4, H5)
End Function

Function HexSHA1(Message() As Byte, ByVal Key1 As Long, ByVal Key2 As Long, ByVal Key3 As Long, ByVal Key4 As Long) As String
 Dim H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long
 xSHA1 Message, Key1, Key2, Key3, Key4, H1, H2, H3, H4, H5
 HexSHA1 = DecToHex5(H1, H2, H3, H4, H5)
End Function

Sub DefaultSHA1(Message() As Byte, H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long)
 xSHA1 Message, &H5A827999, &H6ED9EBA1, &H8F1BBCDC, &HCA62C1D6, H1, H2, H3, H4, H5
End Sub

Sub xSHA1(Message() As Byte, ByVal Key1 As Long, ByVal Key2 As Long, ByVal Key3 As Long, ByVal Key4 As Long, H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long)
 
 Dim U As Long, P As Long
 Dim FB As FourBytes, OL As OneLong
 Dim i As Integer
 Dim W(80) As Long
 Dim A As Long, B As Long, C As Long, D As Long, E As Long
 Dim T As Long

 H1 = &H67452301: H2 = &HEFCDAB89: H3 = &H98BADCFE: H4 = &H10325476: H5 = &HC3D2E1F0

 U = UBound(Message) + 1: OL.L = U32ShiftLeft3(U): A = U \ &H20000000: LSet FB = OL 'U32ShiftRight29(U)

 ReDim Preserve Message(0 To (U + 8 And -64) + 63)
 Message(U) = 128

 U = UBound(Message)
 Message(U - 4) = A
 Message(U - 3) = FB.D
 Message(U - 2) = FB.C
 Message(U - 1) = FB.B
 Message(U) = FB.A

 While P < U
     For i = 0 To 15
         FB.D = Message(P)
         FB.C = Message(P + 1)
         FB.B = Message(P + 2)
         FB.A = Message(P + 3)
         LSet OL = FB
         W(i) = OL.L
         P = P + 4
     Next i

     For i = 16 To 79
         W(i) = U32RotateLeft1(W(i - 3) Xor W(i - 8) Xor W(i - 14) Xor W(i - 16))
     Next i

     A = H1: B = H2: C = H3: D = H4: E = H5

     For i = 0 To 19
         T = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(A), E), W(i)), Key1), ((B And C) Or ((Not B) And D)))
         E = D: D = C: C = U32RotateLeft30(B): B = A: A = T
     Next i
     For i = 20 To 39
         T = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(A), E), W(i)), Key2), (B Xor C Xor D))
         E = D: D = C: C = U32RotateLeft30(B): B = A: A = T
     Next i
     For i = 40 To 59
         T = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(A), E), W(i)), Key3), ((B And C) Or (B And D) Or (C And D)))
         E = D: D = C: C = U32RotateLeft30(B): B = A: A = T
     Next i
     For i = 60 To 79
         T = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(A), E), W(i)), Key4), (B Xor C Xor D))
         E = D: D = C: C = U32RotateLeft30(B): B = A: A = T
     Next i

     H1 = U32Add(H1, A): H2 = U32Add(H2, B): H3 = U32Add(H3, C): H4 = U32Add(H4, D): H5 = U32Add(H5, E)
 Wend
End Sub

Function U32Add(ByVal A As Long, ByVal B As Long) As Long
 If (A Xor B) < 0 Then
     U32Add = A + B
 Else
     U32Add = (A Xor &H80000000) + B Xor &H80000000
 End If
End Function

Function U32ShiftLeft3(ByVal A As Long) As Long
 U32ShiftLeft3 = (A And &HFFFFFFF) * 8
 If A And &H10000000 Then U32ShiftLeft3 = U32ShiftLeft3 Or &H80000000
End Function

Function U32ShiftRight29(ByVal A As Long) As Long
 U32ShiftRight29 = (A And &HE0000000) \ &H20000000 And 7
End Function

Function U32RotateLeft1(ByVal A As Long) As Long
 U32RotateLeft1 = (A And &H3FFFFFFF) * 2
 If A And &H40000000 Then U32RotateLeft1 = U32RotateLeft1 Or &H80000000
 If A And &H80000000 Then U32RotateLeft1 = U32RotateLeft1 Or 1
End Function
Function U32RotateLeft5(ByVal A As Long) As Long
 U32RotateLeft5 = (A And &H3FFFFFF) * 32 Or (A And &HF8000000) \ &H8000000 And 31
 If A And &H4000000 Then U32RotateLeft5 = U32RotateLeft5 Or &H80000000
End Function
Function U32RotateLeft30(ByVal A As Long) As Long
 U32RotateLeft30 = (A And 1) * &H40000000 Or (A And &HFFFC) \ 4 And &H3FFFFFFF
 If A And 2 Then U32RotateLeft30 = U32RotateLeft30 Or &H80000000
End Function

Function DecToHex5(ByVal H1 As Long, ByVal H2 As Long, ByVal H3 As Long, ByVal H4 As Long, ByVal H5 As Long) As String
 Dim H As String, L As Long
 DecToHex5 = "00000000 00000000 00000000 00000000 00000000"
 H = Hex(H1): L = Len(H): Mid(DecToHex5, 9 - L, L) = H
 H = Hex(H2): L = Len(H): Mid(DecToHex5, 18 - L, L) = H
 H = Hex(H3): L = Len(H): Mid(DecToHex5, 27 - L, L) = H
 H = Hex(H4): L = Len(H): Mid(DecToHex5, 36 - L, L) = H
 H = Hex(H5): L = Len(H): Mid(DecToHex5, 45 - L, L) = H
End Function


Public Function SHA1HASH(str) As String
  Dim i As Integer
  Dim arr() As Byte
  ReDim arr(0 To Len(str) - 1) As Byte
  For i = 0 To Len(str) - 1
   arr(i) = Asc(Mid(str, i + 1, 1))
  Next i
  SHA1HASH = Replace(LCase(HexDefaultSHA1(arr)), " ", "")
End Function

Function Hex2Dec(Hexa As String) As Double
Dim i As Integer, Multi As Integer
Hex2Dec = 0
Hexa = UCase(Trim(Hexa))
If Not Hexa Like "*[G-Z]*" Then
For i = 1 To Len(Hexa)
Multi = CInt("&H" & (Mid(Hexa, Len(Hexa) - i + 1, 1)))
Hex2Dec = Hex2Dec + (Multi * 16 ^ (i - 1))
Next i
End If
End Function

Public Function MDP(hash) As String
Dim i As Integer, str As String, j As Integer

str = ""
For i = 1 To Len(hash) Step 2
    j = Hex2Dec(Mid(hash, i, 2)) Mod 62 + 48
    
    While (j >= 58 And j <= 64) Or (j >= 91 And j <= 96)
        j = j Mod 62 + 48
    Wend
    str = str & Chr(j)

Next

MDP = str

End Function

Ce code permet de créer de nouvelles fonctions, dont une qui s’appelle SHA1HASH. Donc, par exemple, si en A1 tu as DELBOS, en B1 Vincent, en C1 tu tapes ceci:

=SHA1HASH(A1&"-"&B1&"-Salt")

(NB.: tu peux remplacer “-Salt” par ce que tu veux, un truc au pif)

Chez moi, ça donne le résultat suivant:

b4bee44b5f1d79f334cdae52c834969e92a19529

La suite est optionnelle: comme c’est de l’hexadécimal, on reconvertit ce qu’on peut dans un jeu de caractères [Aa-Zz][0-9], via la fonction MDP:

=MDP("b4bee44b5f1d79f334cdae52c834969e92a19529")
==> h4ZmQMkidCbD0dJRFUIY

Pour avoir directement ce résultat, la formule est donc:

=MDP(SHA1HASH(A1&"-"&B1&"-Salt"))

Voili voilou, bon courage :wink: