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