Hashage SHA-256

Soyez le premier à donner votre avis sur cette source.

Snippet vu 9 622 fois - Téléchargée 7 fois

Contenu du snippet

Option Explicit
Private TotalAt(30) As Long  '# Valeur obtenue avec tous les n-1 bits à 1
Private Pow2(30) As Long     '# Puissances de 2
Private K(63) As Long        '# Valeurs spécifiques SHA256
Private Const MODULUS_BITS As Long = 512
Private Const CONGRUENT_BITS As Long = 448
Private Sub Class_Initialize()
Dim i As Long
Dim nValue As Long
Dim nTotal As Long
   '# On initialise les deux tableaux (puissances et cumul)
   Pow2(0) = 1
   TotalAt(0) = 1
   nValue = 1
   nTotal = 1
   For i = 1 To 30
       nValue = 2 * nValue
       nTotal = nTotal + nValue
       Pow2(i) = nValue
       TotalAt(i) = nTotal
   Next i
   '# Valeurs décrites dans les specs SHA
   K(0) = &H428A2F98:  K(16) = &HE49B69C1: K(32) = &H27B70A85: K(48) = &H19A4C116
   K(1) = &H71374491:  K(17) = &HEFBE4786: K(33) = &H2E1B2138: K(49) = &H1E376C08
   K(2) = &HB5C0FBCF:  K(18) = &HFC19DC6:  K(34) = &H4D2C6DFC: K(50) = &H2748774C
   K(3) = &HE9B5DBA5:  K(19) = &H240CA1CC: K(35) = &H53380D13: K(51) = &H34B0BCB5
   K(4) = &H3956C25B:  K(20) = &H2DE92C6F: K(36) = &H650A7354: K(52) = &H391C0CB3
   K(5) = &H59F111F1:  K(21) = &H4A7484AA: K(37) = &H766A0ABB: K(53) = &H4ED8AA4A
   K(6) = &H923F82A4:  K(22) = &H5CB0A9DC: K(38) = &H81C2C92E: K(54) = &H5B9CCA4F
   K(7) = &HAB1C5ED5:  K(23) = &H76F988DA: K(39) = &H92722C85: K(55) = &H682E6FF3
   K(8) = &HD807AA98:  K(24) = &H983E5152: K(40) = &HA2BFE8A1: K(56) = &H748F82EE
   K(9) = &H12835B01:  K(25) = &HA831C66D: K(41) = &HA81A664B: K(57) = &H78A5636F
   K(10) = &H243185BE: K(26) = &HB00327C8: K(42) = &HC24B8B70: K(58) = &H84C87814
   K(11) = &H550C7DC3: K(27) = &HBF597FC7: K(43) = &HC76C51A3: K(59) = &H8CC70208
   K(12) = &H72BE5D74: K(28) = &HC6E00BF3: K(44) = &HD192E819: K(60) = &H90BEFFFA
   K(13) = &H80DEB1FE: K(29) = &HD5A79147: K(45) = &HD6990624: K(61) = &HA4506CEB
   K(14) = &H9BDC06A7: K(30) = &H6CA6351:  K(46) = &HF40E3585: K(62) = &HBEF9A3F7
   K(15) = &HC19BF174: K(31) = &H14292967: K(47) = &H106AA070: K(63) = &HC67178F2
End Sub 
Private Function LShift(ByVal vnValue As Long, ByVal vnShiftBy As Integer) As Long
   If vnShiftBy = 0 Then
       LShift = vnValue
   ElseIf vnShiftBy = 31 Then
       If vnValue And 1 Then
           LShift = &H80000000
       End If
   ElseIf vnShiftBy >= 0 And vnShiftBy <= 31 Then
       If (vnValue And Pow2(31 - vnShiftBy)) Then
           LShift = ((vnValue And TotalAt(31 - (vnShiftBy + 1))) * Pow2(vnShiftBy)) Or &H80000000
       Else
           LShift = ((vnValue And TotalAt(31 - vnShiftBy)) * Pow2(vnShiftBy))
       End If
   End If
End Function 
Private Function RShift(ByVal vnValue As Long, ByVal vnShiftBy As Integer) As Long
   If vnShiftBy = 0 Then
       RShift = vnValue
   ElseIf vnShiftBy = 31 Then
       If vnValue And &H80000000 Then
           RShift = 1
       End If
   ElseIf vnShiftBy >= 0 And vnShiftBy <= 31 Then
       RShift = (vnValue And &H7FFFFFFE) \ Pow2(vnShiftBy)
       If (vnValue And &H80000000) Then
           RShift = (RShift Or (&H40000000 \ Pow2(vnShiftBy - 1)))
       End If
   End If
End Function 
Private Function AddU32(ByVal lX As Long, ByVal lY As Long) As Long
Dim lX4 As Long
Dim lY4 As Long
Dim lX8 As Long
Dim lY8 As Long
   lX8 = lX And &H80000000
   lY8 = lY And &H80000000
   lX4 = lX And &H40000000
   lY4 = lY And &H40000000
   AddU32 = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)
   If lX4 And lY4 Then
       AddU32 = AddU32 Xor &H80000000 Xor lX8 Xor lY8
   ElseIf lX4 Or lY4 Then
       If AddU32 And &H40000000 Then
           AddU32 = AddU32 Xor &HC0000000 Xor lX8 Xor lY8
       Else
           AddU32 = AddU32 Xor &H40000000 Xor lX8 Xor lY8
       End If
   Else
       AddU32 = AddU32 Xor lX8 Xor lY8
   End If
End Function 
Private Function Ch(ByVal X As Long, ByVal Y As Long, ByVal Z As Long) As Long
   Ch = ((X And Y) Xor ((Not X) And Z))
End Function 
Private Function Maj(ByVal X As Long, ByVal Y As Long, ByVal Z As Long) As Long
   Maj = ((X And Y) Xor (X And Z) Xor (Y And Z))
End Function 
Private Function S(ByVal X As Long, ByVal n As Long) As Long
   S = (RShift(X, (n And 31)) Or LShift(X, (32 - (n And 31))))
End Function 
Private Function R(ByVal X As Long, ByVal n As Long) As Long
   R = RShift(X, CInt(n And 31))
End Function 
Private Function Sigma0(ByVal X As Long) As Long
   Sigma0 = (S(X, 2) Xor S(X, 13) Xor S(X, 22))
End Function 
Private Function Sigma1(ByVal X As Long) As Long
   Sigma1 = (S(X, 6) Xor S(X, 11) Xor S(X, 25))
End Function 
Private Function Gamma0(ByVal X As Long) As Long
   Gamma0 = (S(X, 7) Xor S(X, 18) Xor R(X, 3))
End Function 
Private Function Gamma1(ByVal X As Long) As Long
   Gamma1 = (S(X, 17) Xor S(X, 19) Xor R(X, 10))
End Function 
Private Function ConvertToWordArray(ByRef vsMessage As String) As Long()
Dim nLength As Long
Dim xnReturn() As Long
Dim lNumberOfWords As Long
Dim lBytePosition As Long
Dim lByteCount As Long
Dim lWordCount As Long
Dim lByte As Long
   nLength = Len(vsMessage)
   lNumberOfWords = (((nLength + ((MODULUS_BITS - CONGRUENT_BITS) \ 8)) \ (MODULUS_BITS \ 8)) + 1) * (MODULUS_BITS \ 32)
   
   ReDim xnReturn(lNumberOfWords - 1)
   Do While lByteCount < nLength
       lWordCount = lByteCount \ 4
       lBytePosition = (3 - (lByteCount Mod 4)) * 8
       lByte = AscB(Mid$(vsMessage, lByteCount + 1, 1))
       xnReturn(lWordCount) = xnReturn(lWordCount) Or LShift(lByte, lBytePosition)
       lByteCount = lByteCount + 1
   Loop
   lWordCount = lByteCount \ 4
   lBytePosition = (3 - (lByteCount Mod 4)) * 8
   xnReturn(lWordCount) = xnReturn(lWordCount) Or LShift(&H80, lBytePosition)
   xnReturn(lNumberOfWords - 1) = LShift(nLength, 3)
   xnReturn(lNumberOfWords - 2) = RShift(nLength, 29)
   ConvertToWordArray = xnReturn
End Function 
Public Function ComputeHash(ByRef vsMessage As String) As String
Static HASH(7) As Long
Static w(63) As Long
Dim M() As Long
Dim A As Long
Dim B As Long
Dim C As Long
Dim D As Long
Dim E As Long
Dim F As Long
Dim G As Long
Dim H As Long
Dim i As Long
Dim J As Long
Dim T1 As Long
Dim T2 As Long
   HASH(0) = &H6A09E667
   HASH(1) = &HBB67AE85
   HASH(2) = &H3C6EF372
   HASH(3) = &HA54FF53A
   HASH(4) = &H510E527F
   HASH(5) = &H9B05688C
   HASH(6) = &H1F83D9AB
   HASH(7) = &H5BE0CD19
   
   M = ConvertToWordArray(vsMessage)
   
   For i = 0 To UBound(M) Step 16
       A = HASH(0)
       B = HASH(1)
       C = HASH(2)
       D = HASH(3)
       E = HASH(4)
       F = HASH(5)
       G = HASH(6)
       H = HASH(7)
       For J = 0 To 63
           If J < 16 Then
               w(J) = M(J + i)
           Else
               w(J) = AddU32(AddU32(AddU32(Gamma1(w(J - 2)), w(J - 7)), Gamma0(w(J - 15))), w(J - 16))
           End If
           T1 = AddU32(AddU32(AddU32(AddU32(H, Sigma1(E)), Ch(E, F, G)), K(J)), w(J))
           T2 = AddU32(Sigma0(A), Maj(A, B, C))
           H = G
           G = F
           F = E
           E = AddU32(D, T1)
           D = C
           C = B
           B = A
           A = AddU32(T1, T2)
       Next J
       
       HASH(0) = AddU32(A, HASH(0))
       HASH(1) = AddU32(B, HASH(1))
       HASH(2) = AddU32(C, HASH(2))
       HASH(3) = AddU32(D, HASH(3))
       HASH(4) = AddU32(E, HASH(4))
       HASH(5) = AddU32(F, HASH(5))
       HASH(6) = AddU32(G, HASH(6))
       HASH(7) = AddU32(H, HASH(7))
   Next i
   ComputeHash = LCase$(Right$("00000000" & Hex$(HASH(0)), 8) & _
                        Right$("00000000" & Hex$(HASH(1)), 8) & _
                        Right$("00000000" & Hex$(HASH(2)), 8) & _
                        Right$("00000000" & Hex$(HASH(3)), 8) & _
                        Right$("00000000" & Hex$(HASH(4)), 8) & _
                        Right$("00000000" & Hex$(HASH(5)), 8) & _
                        Right$("00000000" & Hex$(HASH(6)), 8) & _
                        Right$("00000000" & Hex$(HASH(7)), 8))
End Function 

Compatibilité : VB6, VBA

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.