AES256

 Option Explicit
Dim sbox, sboxinv, rcon sbox = Array( _
 &h63, &h7c, &h77, &h7b, &hf2, &h6b, &h6f, &hc5, &h30, &h01, &h67, &h2b, &hfe, &hd7, &hab, &h76, _
 &hca, &h82, &hc9, &h7d, &hfa, &h59, &h47, &hf0, &had, &hd4, &ha2, &haf, &h9c, &ha4, &h72, &hc0, _
 &hb7, &hfd, &h93, &h26, &h36, &h3f, &hf7, &hcc, &h34, &ha5, &he5, &hf1, &h71, &hd8, &h31, &h15, _
 &h04, &hc7, &h23, &hc3, &h18, &h96, &h05, &h9a, &h07, &h12, &h80, &he2, &heb, &h27, &hb2, &h75, _
 &h09, &h83, &h2c, &h1a, &h1b, &h6e, &h5a, &ha0, &h52, &h3b, &hd6, &hb3, &h29, &he3, &h2f, &h84, _
 &h53, &hd1, &h00, &hed, &h20, &hfc, &hb1, &h5b, &h6a, &hcb, &hbe, &h39, &h4a, &h4c, &h58, &hcf, _
 &hd0, &hef, &haa, &hfb, &h43, &h4d, &h33, &h85, &h45, &hf9, &h02, &h7f, &h50, &h3c, &h9f, &ha8, _
 &h51, &ha3, &h40, &h8f, &h92, &h9d, &h38, &hf5, &hbc, &hb6, &hda, &h21, &h10, &hff, &hf3, &hd2, _
 &hcd, &h0c, &h13, &hec, &h5f, &h97, &h44, &h17, &hc4, &ha7, &h7e, &h3d, &h64, &h5d, &h19, &h73, _
 &h60, &h81, &h4f, &hdc, &h22, &h2a, &h90, &h88, &h46, &hee, &hb8, &h14, &hde, &h5e, &h0b, &hdb, _
 &he0, &h32, &h3a, &h0a, &h49, &h06, &h24, &h5c, &hc2, &hd3, &hac, &h62, &h91, &h95, &he4, &h79, _
 &he7, &hc8, &h37, &h6d, &h8d, &hd5, &h4e, &ha9, &h6c, &h56, &hf4, &hea, &h65, &h7a, &hae, &h08, _
 &hba, &h78, &h25, &h2e, &h1c, &ha6, &hb4, &hc6, &he8, &hdd, &h74, &h1f, &h4b, &hbd, &h8b, &h8a, _
 &h70, &h3e, &hb5, &h66, &h48, &h03, &hf6, &h0e, &h61, &h35, &h57, &hb9, &h86, &hc1, &h1d, &h9e, _
 &he1, &hf8, &h98, &h11, &h69, &hd9, &h8e, &h94, &h9b, &h1e, &h87, &he9, &hce, &h55, &h28, &hdf, _
 &h8c, &ha1, &h89, &h0d, &hbf, &he6, &h42, &h68, &h41, &h99, &h2d, &h0f, &hb0, &h54, &hbb, &h16)
 
sboxinv = Array( _
 &h52, &h09, &h6a, &hd5, &h30, &h36, &ha5, &h38, &hbf, &h40, &ha3, &h9e, &h81, &hf3, &hd7, &hfb, _
 &h7c, &he3, &h39, &h82, &h9b, &h2f, &hff, &h87, &h34, &h8e, &h43, &h44, &hc4, &hde, &he9, &hcb, _
 &h54, &h7b, &h94, &h32, &ha6, &hc2, &h23, &h3d, &hee, &h4c, &h95, &h0b, &h42, &hfa, &hc3, &h4e, _
 &h08, &h2e, &ha1, &h66, &h28, &hd9, &h24, &hb2, &h76, &h5b, &ha2, &h49, &h6d, &h8b, &hd1, &h25, _
 &h72, &hf8, &hf6, &h64, &h86, &h68, &h98, &h16, &hd4, &ha4, &h5c, &hcc, &h5d, &h65, &hb6, &h92, _
 &h6c, &h70, &h48, &h50, &hfd, &hed, &hb9, &hda, &h5e, &h15, &h46, &h57, &ha7, &h8d, &h9d, &h84, _
 &h90, &hd8, &hab, &h00, &h8c, &hbc, &hd3, &h0a, &hf7, &he4, &h58, &h05, &hb8, &hb3, &h45, &h06, _
 &hd0, &h2c, &h1e, &h8f, &hca, &h3f, &h0f, &h02, &hc1, &haf, &hbd, &h03, &h01, &h13, &h8a, &h6b, _
 &h3a, &h91, &h11, &h41, &h4f, &h67, &hdc, &hea, &h97, &hf2, &hcf, &hce, &hf0, &hb4, &he6, &h73, _
 &h96, &hac, &h74, &h22, &he7, &had, &h35, &h85, &he2, &hf9, &h37, &he8, &h1c, &h75, &hdf, &h6e, _
 &h47, &hf1, &h1a, &h71, &h1d, &h29, &hc5, &h89, &h6f, &hb7, &h62, &h0e, &haa, &h18, &hbe, &h1b, _
 &hfc, &h56, &h3e, &h4b, &hc6, &hd2, &h79, &h20, &h9a, &hdb, &hc0, &hfe, &h78, &hcd, &h5a, &hf4, _
 &h1f, &hdd, &ha8, &h33, &h88, &h07, &hc7, &h31, &hb1, &h12, &h10, &h59, &h27, &h80, &hec, &h5f, _
 &h60, &h51, &h7f, &ha9, &h19, &hb5, &h4a, &h0d, &h2d, &he5, &h7a, &h9f, &h93, &hc9, &h9c, &hef, _
 &ha0, &he0, &h3b, &h4d, &hae, &h2a, &hf5, &hb0, &hc8, &heb, &hbb, &h3c, &h83, &h53, &h99, &h61, _
 &h17, &h2b, &h04, &h7e, &hba, &h77, &hd6, &h26, &he1, &h69, &h14, &h63, &h55, &h21, &h0c, &h7d)
 
rcon = Array( _
 &h8d, &h01, &h02, &h04, &h08, &h10, &h20, &h40, &h80, &h1b, &h36, &h6c, &hd8, &hab, &h4d, &h9a, _
 &h2f, &h5e, &hbc, &h63, &hc6, &h97, &h35, &h6a, &hd4, &hb3, &h7d, &hfa, &hef, &hc5, &h91, &h39, _
 &h72, &he4, &hd3, &hbd, &h61, &hc2, &h9f, &h25, &h4a, &h94, &h33, &h66, &hcc, &h83, &h1d, &h3a, _
 &h74, &he8, &hcb, &h8d, &h01, &h02, &h04, &h08, &h10, &h20, &h40, &h80, &h1b, &h36, &h6c, &hd8, _
 &hab, &h4d, &h9a, &h2f, &h5e, &hbc, &h63, &hc6, &h97, &h35, &h6a, &hd4, &hb3, &h7d, &hfa, &hef, _
 &hc5, &h91, &h39, &h72, &he4, &hd3, &hbd, &h61, &hc2, &h9f, &h25, &h4a, &h94, &h33, &h66, &hcc, _
 &h83, &h1d, &h3a, &h74, &he8, &hcb, &h8d, &h01, &h02, &h04, &h08, &h10, &h20, &h40, &h80, &h1b, _
 &h36, &h6c, &hd8, &hab, &h4d, &h9a, &h2f, &h5e, &hbc, &h63, &hc6, &h97, &h35, &h6a, &hd4, &hb3, _
 &h7d, &hfa, &hef, &hc5, &h91, &h39, &h72, &he4, &hd3, &hbd, &h61, &hc2, &h9f, &h25, &h4a, &h94, _
 &h33, &h66, &hcc, &h83, &h1d, &h3a, &h74, &he8, &hcb, &h8d, &h01, &h02, &h04, &h08, &h10, &h20, _
 &h40, &h80, &h1b, &h36, &h6c, &hd8, &hab, &h4d, &h9a, &h2f, &h5e, &hbc, &h63, &hc6, &h97, &h35, _
 &h6a, &hd4, &hb3, &h7d, &hfa, &hef, &hc5, &h91, &h39, &h72, &he4, &hd3, &hbd, &h61, &hc2, &h9f, _
 &h25, &h4a, &h94, &h33, &h66, &hcc, &h83, &h1d, &h3a, &h74, &he8, &hcb, &h8d, &h01, &h02, &h04, _
 &h08, &h10, &h20, &h40, &h80, &h1b, &h36, &h6c, &hd8, &hab, &h4d, &h9a, &h2f, &h5e, &hbc, &h63, _
 &hc6, &h97, &h35, &h6a, &hd4, &hb3, &h7d, &hfa, &hef, &hc5, &h91, &h39, &h72, &he4, &hd3, &hbd, _
 &h61, &hc2, &h9f, &h25, &h4a, &h94, &h33, &h66, &hcc, &h83, &h1d, &h3a, &h74, &he8, &hcb) Dim expandedKey, block(16), aesKey, i, isDone, j, intMode
Dim blockKey(16), sPlain, sPass, sCipher, sTemp sPass = InputBox("Password:", "Enter Password")
sPlain = InputBox("Message:", "Enter Message")
sCipher = ""
isDone = False
j = 0
aesKey = passwordToKey(sPass)
expandedKey = expandKey(aesKey)
For i = 0 To 15
 blockKey(i) = aesKey(i)
Next If MsgBox("Yes to Encrypt, No to Decrypt" & vbCrLf & "Output is in Hex for Encryption" & vbCrLf & "Input must be in Hex for Decryption", vbYesNo, "Select Mode") = vbYes Then
 intMode = 1
Else
 intMode = 2
End If Do Until isDone
 sTemp = Mid(sPlain, j*16*intMode + 1, 16*intMode)
 
 If intMode = 1 Then
  If Len(sTemp) < 16 Then
   For i = Len(sTemp) To 15
    sTemp = sTemp & Chr(0)
   Next
  End If
 End If
 
 For i = 1 To 16
  If intMode = 1 Then
   block(i-1) = Asc(Mid(sTemp, i, 1))
  Else
   block(i-1) = CLng("&h" & Mid(sPlain, i*2 - 1, 2))
  End If
 Next
 
 If (j + 1) * 16 * intMode >= Len(sPlain) Then
  isDone = True
 End If
 
 j = j + 1
 
 If intMode = 1 Then
  aesRoundsInv blockKey
  For i = 0 To 15
   sCipher = sCipher & Right("0" & Hex(block(i) Xor blockKey(i)), 2)
  Next
 Else
  aesRoundsInv blockKey
  For i = 0 To 15
   sCipher = sCipher & Chr(block(i) Xor blockKey(i))
  Next
 End If
Loop
  
MsgBox sCipher, 0, "" Function passwordToKey(ByVal sPass)
 'sha256 hash
 Dim i, result(32), fracsqprime, fraccubeprimes
 
 fracsqprime = Array( _
  &h6a09e667, &hbb67ae85, &h3c6ef372, &ha54ff53a, _
  &h510e527f, &h9b05688c, &h1f83d9ab, &h5be0cd19)  fraccubeprimes = Array( _
  &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)  For i = 0 To 31
  result(i) = Asc(Mid(sPass, (i Mod Len(sPass)) + 1, 1))
 Next
 
 passwordToKey = result
End Function Function keyScheduleCore(ByVal row(), a)
 Dim result, i
 
 result = shift(row, 5, 1)
 For i = 0 To 3
  result(i) = sbox(result(i))
 Next
 
 result(0) = result(0) Xor rcon(a)
 keyScheduleCore = result
End Function Function expandKey(ByRef key())
 Dim rConIter, temp, i, result(240)
 
 ReDim temp(4)
 rConIter = 1
 
 For i = 0 To 31
  result(i) = key(i)
 Next
 
 For i = 32 To 239 Step 4
  temp(0) = result(i - 4)
  temp(1) = result(i - 3)
  temp(2) = result(i - 2)
  temp(3) = result(i - 1)
  
  If i Mod 32 = 0 Then
   temp = keyScheduleCore(temp, rConIter)
   rConIter = rConIter + 1
  End If
  
  If i Mod 32 = 16 Then
   temp(0) = sbox(temp(0))
   temp(1) = sbox(temp(1))
   temp(2) = sbox(temp(2))
   temp(3) = sbox(temp(3))
  End If
  
  result(i) = result(i-32) Xor temp(0)
  result(i+1) = result(i-31) Xor temp(1)
  result(i+2) = result(i-30) Xor temp(2)
  result(i+3) = result(i-29) Xor temp(3)
 Next
 
 exPandKey = result
End Function Sub aesRounds(ByRef state())
 Dim roundKey, i
 
 roundKey = createRoundKey(0)
 addRoundKey state, roundKey
 
 For i = 1 To 13
  roundKey = createRoundKey(i)
  subBytes state, sbox
  shiftRows state, 5
  mixColumns state, 0, 0
  addRoundKey state, roundKey
 Next
 
 roundKey = createRoundKey(14)
 subBytes state, sbox
 shiftRows state, 5
 addRoundKey state, roundKey
End Sub Sub aesRoundsInv(ByRef state())
 Dim roundKey, i
 
 roundKey = createRoundKey(14)
 addRoundKey state, roundKey
 shiftRows state, 3
 subBytes state, sboxinv
 
 For i = 13 To 1 Step -1
  roundKey = createRoundKey(i)
  addRoundKey state, roundKey
  mixColumns state, 12, 8
  shiftRows state, 3
  subBytes state, sboxinv
 Next
 
 roundKey = createRoundKey(0)
 addRoundKey state, roundKey
End Sub Function createRoundKey(ByVal a)
 a = a * 16
 createRoundKey = Array( _
  expandedKey(a), expandedKey(a+1), expandedKey(a+2), expandedKey(a+3), _
  expandedKey(a+4), expandedKey(a+5), expandedKey(a+6), expandedKey(a+7), _
  expandedKey(a+8), expandedKey(a+9), expandedKey(a+10), expandedKey(a+11), _
  expandedKey(a+12), expandedKey(a+13), expandedKey(a+14), expandedKey(a+15))
End Function Sub addRoundKey(ByRef state(), ByVal roundKey())
 Dim i
 
 For i = 0 To 15
  state(i) = state(i) Xor roundKey(i)
 Next
End Sub Sub subBytes(ByRef state(), ByRef box())
 'box = sbox for encryption, sboxinv for descryption
 Dim i
 
 For i = 0 To 15
  state(i) = box(state(i))
 Next
End Sub Sub shiftRows(ByRef state(), ByVal a)
 'a = 5 for left shift, 3 for right shift
 Dim temp, i, j  For i = 1 To 3
  temp = shift(Array(state(i*4), state(i*4 + 1), state(i*4 + 2), state(i*4 + 3)), a, i)
  
  For j = 0 To 3
   state(i*4 + j) = temp(j)
  Next
 Next
End Sub Function shift(ByVal row(), ByVal a, ByVal shiftAmount)
 Dim i, result(4)
 
 For i = 0 To 3
  result(i) = row((i + shiftAmount * a) Mod 4)
 Next
 
 shift = result
End Function Function galoisMult(ByVal a, ByVal b)
 Dim p, hiBitSet, i
 
 p = 0
 hiBitSet = 0
 
 For i = 1 To 8
  If (b And 1) = 1 Then
   p = p Xor a
   hiBitSet = a And &h80
   a = a * 2
  End If
  
  If hiBitSet = &h80 Then
   b = (b / 2) \ 1
  End If
 Next
  
 galoisMult = p Mod 256
End FUnction Sub mixColumns(ByRef state(), ByVal a, ByVal b)
 'a = 0 and b = 0 for encryption, 12 and 8 for decryption
 Dim i, temp(4)
 
 For i = 0 To 3
  temp(0) = state(i)
  temp(1) = state(i+4)
  temp(2) = state(i+8)
  temp(3) = state(i+12)
  
  state(i) = galoisMult(temp(0), 2+a) Xor galoisMult(temp(3), 1+b) Xor galoisMult(temp(2), 1+a) Xor galoisMult(temp(1), 3+b)
  state(i+4) = galoisMult(temp(1), 2+a) Xor galoisMult(temp(0), 1+b) Xor galoisMult(temp(3), 1+a) Xor galoisMult(temp(2), 3+b)
  state(i+8) = galoisMult(temp(2), 2+a) Xor galoisMult(temp(1), 1+b) Xor galoisMult(temp(0), 1+a) Xor galoisMult(temp(3), 3+b)
  state(i+12) = galoisMult(temp(3), 2+a) Xor galoisMult(temp(2), 1+b) Xor galoisMult(temp(1), 1+a) Xor galoisMult(temp(0), 3+b)
 Next
End Sub