Function SHA_256(Byval message As String) As String #Macro Ch (x, y, z) (((x) And (y)) Xor ((Not (x)) And z)) #EndMacro #Macro Maj (x, y, z) (((x) And (y)) Xor ((x) And (z)) Xor ((y) And (z))) #EndMacro #Macro sigma0 (x) (((x) Shr 2 Or (x) Shl 30) Xor ((x) Shr 13 Or (x) Shl 19) Xor ((x) Shr 22 Or (x) Shl 10)) #EndMacro #Macro sigma1 (x) (((x) Shr 6 Or (x) Shl 26) Xor ((x) Shr 11 Or (x) Shl 21) Xor ((x) Shr 25 Or (x) Shl 7)) #EndMacro #Macro sigma2 (x) (((x) Shr 7 Or (x) Shl 25) Xor ((x) Shr 18 Or (x) Shl 14) Xor ((x) Shr 3)) #EndMacro #Macro sigma3 (x) (((x) Shr 17 Or (x) Shl 15) Xor ((x) Shr 19 Or (x) Shl 13) Xor ((x) Shr 10)) #EndMacro Dim As Long i, j Dim As Ubyte Ptr ww1 Dim As Uinteger<32> Ptr ww4 Dim As Ulongint l = Len(message) ' set the first bit after the message to 1 message = message + Chr(1 Shl 7) ' add one char to the length Dim As Ulong padding = 64 - ((l + 1) Mod (512 \ 8)) ' check if we have enough room for inserting the length If padding < 8 Then padding += 64 message += String(padding, Chr(0)) ' adjust length Dim As Ulong l1 = Len(message) ' new length l = l * 8 ' orignal length in bits ' create ubyte ptr to point to l ( = length in bits) Dim As Ubyte Ptr ub_ptr = Cast(Ubyte Ptr, @l) For i = 0 To 7 'copy length of message to the last 8 bytes message[l1 -1 - i] = ub_ptr[i] Next 'table of constants Dim As Uinteger<32> K(0 To ...) = { _ &H428a2f98, &H71374491, &Hb5c0fbcf, &He9b5dba5, &H3956c25b, &H59f111f1, _ &H923f82a4, &Hab1c5ed5, &Hd807aa98, &H12835b01, &H243185be, &H550c7dc3, _ &H72be5d74, &H80deb1fe, &H9bdc06a7, &Hc19bf174, &He49b69c1, &Hefbe4786, _ &H0fc19dc6, &H240ca1cc, &H2de92c6f, &H4a7484aa, &H5cb0a9dc, &H76f988da, _ &H983e5152, &Ha831c66d, &Hb00327c8, &Hbf597fc7, &Hc6e00bf3, &Hd5a79147, _ &H06ca6351, &H14292967, &H27b70a85, &H2e1b2138, &H4d2c6dfc, &H53380d13, _ &H650a7354, &H766a0abb, &H81c2c92e, &H92722c85, &Ha2bfe8a1, &Ha81a664b, _ &Hc24b8b70, &Hc76c51a3, &Hd192e819, &Hd6990624, &Hf40e3585, &H106aa070, _ &H19a4c116, &H1e376c08, &H2748774c, &H34b0bcb5, &H391c0cb3, &H4ed8aa4a, _ &H5b9cca4f, &H682e6ff3, &H748f82ee, &H78a5636f, &H84c87814, &H8cc70208, _ &H90befffa, &Ha4506ceb, &Hbef9a3f7, &Hc67178f2 } Dim As Uinteger<32> h0 = &H6a09e667 Dim As Uinteger<32> h1 = &Hbb67ae85 Dim As Uinteger<32> h2 = &H3c6ef372 Dim As Uinteger<32> h3 = &Ha54ff53a Dim As Uinteger<32> h4 = &H510e527f Dim As Uinteger<32> h5 = &H9b05688c Dim As Uinteger<32> h6 = &H1f83d9ab Dim As Uinteger<32> h7 = &H5be0cd19 Dim As Uinteger<32> a, b, c, d, e, f, g, h Dim As Uinteger<32> t1, t2, w(0 To 63) For j = 0 To (l1 -1) \ 64 ' split into block of 64 bytes ww1 = Cast(Ubyte Ptr, @message[j * 64]) ww4 = Cast(Uinteger<32> Ptr, @message[j * 64]) For i = 0 To 60 Step 4 'little endian -> big endian Swap ww1[i ], ww1[i +3] Swap ww1[i +1], ww1[i +2] Next i For i = 0 To 15 ' copy the 16 32bit block into the array W(i) = ww4[i] Next i For i = 16 To 63 ' fill the rest of the array w(i) = sigma3(W(i -2)) + W(i -7) + sigma2(W(i -15)) + W(i -16) Next i a = h0 : b = h1 : c = h2 : d = h3 : e = h4 : f = h5 : g = h6 : h = h7 For i = 0 To 63 t1 = h + sigma1(e) + Ch(e, f, g) + K(i) + W(i) t2 = sigma0(a) + Maj(a, b, c) h = g : g = f : f = e e = d + t1 d = c : c = b : b = a a = t1 + t2 Next i h0 += a : h1 += b : h2 += c : h3 += d h4 += e : h5 += f : h6 += g : h7 += h Next j Dim As String answer = Hex(h0, 8) + Hex(h1, 8) + Hex(h2, 8) + Hex(h3, 8) answer += Hex(h4, 8) + Hex(h5, 8) + Hex(h6, 8) + Hex(h7, 8) Return Lcase(answer) End Function Dim t0 As Double = Timer Dim Shared sha256fp(0 To 2) As String sha256fp(0) = "1115dd800feaacefdf481f1f9070374a2a81e27880f187396db67958b207cbad" sha256fp(1) = "3a7bd3e2360a3d29eea436fcfb7e44c735d117c42d1c1835420b6b9942dd4f1b" sha256fp(2) = "74e1bb62f8dabb8125a58852b63bdf6eaef667cb56ac7f7cdba6d7305c50a22f" Sub PrintCode(n As Integer) Dim As String fp = sha256fp(n) Dim As Integer c1, c2, c3, c4, c5 For c1 = 97 To 122 For c2 = 97 To 122 For c3 = 97 To 122 For c4 = 97 To 122 For c5 = 97 To 122 If fp = SHA_256(Chr(c1)+Chr(c2)+Chr(c3)+Chr(c4)+Chr(c5)) Then Print Chr(c1)+Chr(c2)+Chr(c3)+Chr(c4)+Chr(c5); " => "; fp Exit For, For, For, For, For End If Next c5 Next c4 Next c3 Next c2 Next c1 End Sub For i As Byte= 0 to 2 PrintCode(i) Next i Sleep