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