home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 June / Chip_2001-06_cd1.bin / zkuste / vbasic / Data / Zdroj / skipjack.bas < prev   
BASIC Source File  |  1999-09-27  |  13KB  |  449 lines
  1. Attribute VB_Name = "modSkipJack"
  2. '---------------------------------
  3. 'This is the NSA algorithm Skipjack
  4. 'according to:
  5. '
  6. 'SKIPJACK and KEA Algorithm Specifications
  7. 'Version 2.0
  8. '29 May 1998
  9. '
  10. 'The algorithm can be operated in
  11. 'the following modes:
  12. 'OFB, CFB, ECB and CBC
  13. '
  14. 'More information concerning the algorithm
  15. 'can be found at:
  16. 'http://csrc.nist.gov/encryption/skipjack-kea.htm
  17. '---------------------------------
  18. 'If you make changes to this code then
  19. 'please send me a copy.
  20. '---------------------------------
  21. 'Author:
  22. '       Asgeir Bjarni Ingvarsson
  23. '       ICQ: 9243261
  24. '       E-Mail: abi@islandia.is
  25. '---------------------------------
  26. 'Skipjack is property of the NSA.
  27.  
  28. Private F
  29. Private K As Long
  30. Private u As Long
  31. Private key(0 To 131) As String
  32. Public Function CBC_Decrypt(inp As String, IV As String) As String
  33. Dim Dat As String, NewIV As String, Outp As String
  34.  
  35. For i = 1 To Len(inp) Step 16
  36.     Dat = Mid(inp, i, 16)
  37.     If i > 1 Then
  38.         NewIV = Mid(inp, i - 16, 16)
  39.     End If
  40.     Dat = Decrypt(Dat)
  41.     If i = 1 Then
  42.         Dat = CryptoXOR(Dat, IV)
  43.     Else
  44.         Dat = CryptoXOR(Dat, NewIV)
  45.     End If
  46.     Outp = Outp & Dat
  47. Next i
  48. CBC_Decrypt = Outp
  49. End Function
  50. Public Function CBC_Encrypt(inp As String, IV As String) As String
  51. Dim Dat As String, NewIV As String, Outp As String
  52.  
  53. For i = 1 To Len(inp) Step 16
  54.     Dat = Mid(inp, i, 16)
  55.     If i = 1 Then
  56.         Dat = CryptoXOR(Dat, IV)
  57.     Else
  58.         Dat = CryptoXOR(Dat, NewIV)
  59.     End If
  60.     NewIV = Encrypt(Dat)
  61.     Outp = Outp & NewIV
  62. Next i
  63. CBC_Encrypt = Outp
  64. End Function
  65. Public Function CFB_Decrypt(inp As String, IV As String) As String
  66. Dim Dat As String, Outp As String, old As String
  67. Dim OldDat As String
  68.  
  69. For i = 1 To Len(inp) Step 16
  70.     Dat = Mid(inp, i, 16)
  71.     If i = 1 Then
  72.         old = Encrypt(IV)
  73.     Else
  74.         old = Encrypt(OldDat)
  75.     End If
  76.     OldDat = Dat
  77.     Outp = Outp & CryptoXOR(Dat, old)
  78. Next i
  79. CFB_Decrypt = Outp
  80. End Function
  81. Public Function CFB_Encrypt(inp As String, IV As String) As String
  82. Dim Dat As String, Outp As String, old As String
  83. Dim OldDat As String
  84.  
  85. For i = 1 To Len(inp) Step 16
  86.     Dat = Mid(inp, i, 16)
  87.     If i = 1 Then
  88.         old = Encrypt(IV)
  89.     Else
  90.         old = Encrypt(OldDat)
  91.     End If
  92.     OldDat = CryptoXOR(Dat, old)
  93.     Outp = Outp & OldDat
  94. Next i
  95. CFB_Encrypt = Outp
  96. End Function
  97. Private Function CryptoXOR(ByVal value1 As String, ByVal value2 As String) As String
  98. Dim valueans As String
  99. Dim loopit As Integer, tempnum As Integer
  100.  
  101.     tempnum = Len(value1) - Len(value2)
  102.     If tempnum < 0 Then
  103.         valueans = Left$(value2, Abs(tempnum))
  104.         value2 = Mid$(value2, Abs(tempnum) + 1)
  105.     ElseIf tempnum > 0 Then
  106.         valueans = Left$(value1, Abs(tempnum))
  107.         value1 = Mid$(value1, tempnum + 1)
  108.     End If
  109.  
  110.     For loopit = 1 To Len(value1)
  111.         valueans = valueans + Hex$(Val("&H" + Mid$(value1, loopit, 1)) Xor Val("&H" + Mid$(value2, loopit, 1)))
  112.     Next loopit
  113.  
  114.     CryptoXOR = Right(valueans, 16)
  115. End Function
  116.  
  117. Private Function Decrypt(inp As String) As String
  118. Dim w1(0 To 32) As String, w3(0 To 32) As String, w4(0 To 32) As String, w2(0 To 32) As String
  119. Dim Counter(0 To 32) As Byte
  120.  
  121. w1(32) = Mid(inp, 1, 4)
  122. w2(32) = Mid(inp, 5, 4)
  123. w3(32) = Mid(inp, 9, 4)
  124. w4(32) = Mid(inp, 13, 4)
  125. K = 32
  126. u = 31
  127. For i = 0 To 32
  128.     Counter(i) = i + 1
  129. Next
  130.  
  131. For i = 1 To 8
  132.     w1(K - 1) = InvG(w2(K), key())
  133.     w2(K - 1) = BigXOR(InvG(w2(K), key()), BigXOR(w3(K), Hex(Counter(K - 1))))
  134.     w3(K - 1) = w4(K)
  135.     w4(K - 1) = w1(K)
  136.     u = u - 1
  137.     K = K - 1
  138. Next
  139. For i = 1 To 8
  140.     w1(K - 1) = InvG(w2(K), key())
  141.     w2(K - 1) = w3(K)
  142.     w3(K - 1) = w4(K)
  143.     w4(K - 1) = BigXOR(BigXOR(w1(K), w2(K)), Hex(Counter(K - 1)))
  144.     u = u - 1
  145.     K = K - 1
  146. Next
  147. For i = 1 To 8
  148.     w1(K - 1) = InvG(w2(K), key())
  149.     w2(K - 1) = BigXOR(InvG(w2(K), key()), BigXOR(w3(K), Hex(Counter(K - 1))))
  150.     w3(K - 1) = w4(K)
  151.     w4(K - 1) = w1(K)
  152.     u = u - 1
  153.     K = K - 1
  154. Next
  155. For i = 1 To 8
  156.     w1(K - 1) = InvG(w2(K), key())
  157.     w2(K - 1) = w3(K)
  158.     w3(K - 1) = w4(K)
  159.     w4(K - 1) = BigXOR(BigXOR(w1(K), w2(K)), Hex(Counter(K - 1)))
  160.     u = u - 1
  161.     K = K - 1
  162. Next
  163.  
  164. Decrypt = w1(0) & w2(0) & w3(0) & w4(0)
  165. End Function
  166. Public Function ECB_Decrypt(inp As String) As String
  167. Dim Dat As String, Outp As String
  168.  
  169. For i = 1 To Len(inp) Step 16
  170.     Dat = Mid(inp, i, 16)
  171.     Outp = Outp & Decrypt(Dat)
  172. Next i
  173. ECB_Decrypt = Outp
  174. End Function
  175. Public Function ECB_Encrypt(inp As String) As String
  176. Dim Dat As String, Outp As String
  177.  
  178. For i = 1 To Len(inp) Step 16
  179.     Dat = Mid(inp, i, 16)
  180.     Outp = Outp & Encrypt(Dat)
  181. Next i
  182. ECB_Encrypt = Outp
  183. End Function
  184. Private Function Encrypt(inp As String) As String
  185. Dim w1(0 To 32) As String, w3(0 To 32) As String, w4(0 To 32) As String, w2(0 To 32) As String
  186. Dim Counter As Long
  187.  
  188. w1(0) = Mid(inp, 1, 4)
  189. w2(0) = Mid(inp, 5, 4)
  190. w3(0) = Mid(inp, 9, 4)
  191. w4(0) = Mid(inp, 13, 4)
  192. K = 0
  193. Counter = 1
  194.  
  195. For i = 1 To 8
  196.     w1(K + 1) = BigXOR(BigXOR(G(w1(K), key()), w4(K)), Hex(Counter))
  197.     w2(K + 1) = G(w1(K), key())
  198.     w3(K + 1) = w2(K)
  199.     w4(K + 1) = w3(K)
  200.     Counter = Counter + 1
  201.     K = K + 1
  202. Next
  203. For i = 1 To 8
  204.     w1(K + 1) = w4(K)
  205.     w2(K + 1) = G(w1(K), key())
  206.     w3(K + 1) = BigXOR(BigXOR(w1(K), w2(K)), Hex(Counter))
  207.     w4(K + 1) = w3(K)
  208.     Counter = Counter + 1
  209.     K = K + 1
  210. Next
  211. For i = 1 To 8
  212.     w1(K + 1) = BigXOR(BigXOR(G(w1(K), key()), w4(K)), Hex(Counter))
  213.     w2(K + 1) = G(w1(K), key())
  214.     w3(K + 1) = w2(K)
  215.     w4(K + 1) = w3(K)
  216.     Counter = Counter + 1
  217.     K = K + 1
  218. Next
  219. For i = 1 To 8
  220.     w1(K + 1) = w4(K)
  221.     w2(K + 1) = G(w1(K), key())
  222.     w3(K + 1) = BigXOR(BigXOR(w1(K), w2(K)), Hex(Counter))
  223.     w4(K + 1) = w3(K)
  224.     Counter = Counter + 1
  225.     K = K + 1
  226. Next
  227.  
  228. Encrypt = w1(32) & w2(32) & w3(32) & w4(32)
  229. End Function
  230. Private Function G(inp As String, key() As String) As String
  231. Dim g1 As String
  232. Dim g2 As String
  233. Dim g3 As String
  234. Dim g4 As String
  235. Dim g5 As String
  236. Dim g6 As String
  237. Dim l As String
  238.  
  239. g1 = Mid(inp, 1, 2)
  240. g2 = Mid(inp, 3, 2)
  241.  
  242. l = F(CByte(BigTrans(BigXOR(g2, key(4 * K)))))
  243. g3 = BigXOR(l, g1)
  244. l = F(CByte(BigTrans(BigXOR(g3, key((4 * K) + 1)))))
  245. g4 = BigXOR(l, g2)
  246. l = F(CByte(BigTrans(BigXOR(g4, key((4 * K) + 2)))))
  247. g5 = BigXOR(l, g3)
  248. l = F(CByte(BigTrans(BigXOR(g5, key((4 * K) + 3)))))
  249. g6 = BigXOR(l, g4)
  250.  
  251. l = g5 & g6
  252. G = l
  253. End Function
  254. Private Function BigTrans(ByVal inp As String) As Double
  255.     inp = Right$(inp, 8)
  256.     TempStr = String$(8 - Len(inp), "0") + inp
  257.     inp = ""
  258.  
  259.     ' Convert to binary
  260.     For loopit = 1 To 8
  261.         tempnum = Val("&H" + Mid$(TempStr, loopit, 1))
  262.         For loopinner = 3 To 0 Step -1
  263.             If tempnum And 2 ^ loopinner Then
  264.                 inp = inp + "1"
  265.             Else
  266.                 inp = inp + "0"
  267.             End If
  268.         Next loopinner
  269.     Next loopit
  270.  
  271.     Dim o As Double, i As Integer
  272.     o = 0
  273.     For i = Len(inp) To 1 Step -1
  274.         If Mid(inp, i, 1) = "1" Then
  275.             y = 1
  276.             p = (Len(inp) - i)
  277.             x = 2
  278.             Do While p > 0
  279.                 Do While (p / 2) = (p \ 2)
  280.                     x = (x * x) Mod 255
  281.                     p = p / 2
  282.                 Loop
  283.                 y = (x * y) Mod 255
  284.                 p = p - 1
  285.             Loop
  286.             o = o + y
  287.         End If
  288.     Next i
  289.     BigTrans = o
  290. End Function
  291. Private Function BigXOR(ByVal value1 As String, ByVal value2 As String) As String
  292. Dim valueans As String
  293. Dim loopit As Integer, tempnum As Integer
  294.  
  295.     tempnum = Len(value1) - Len(value2)
  296.     If tempnum < 0 Then
  297.         valueans = Left$(value2, Abs(tempnum))
  298.         value2 = Mid$(value2, Abs(tempnum) + 1)
  299.     ElseIf tempnum > 0 Then
  300.         valueans = Left$(value1, Abs(tempnum))
  301.         value1 = Mid$(value1, tempnum + 1)
  302.     End If
  303.  
  304.     For loopit = 1 To Len(value1)
  305.         valueans = valueans + Hex$(Val("&H" + Mid$(value1, loopit, 1)) Xor Val("&H" + Mid$(value2, loopit, 1)))
  306.     Next loopit
  307.  
  308.     BigXOR = Right(valueans, 8)
  309. End Function
  310. Public Sub Init(Pass As String)
  311. F = Array("A3", "D7", "09", "83", "F8", "48", "F6", "F4", "B3", "21", "15", "78", "99", "B1", "AF", "F9", "E7", "2D", "4D", _
  312.           "8A", "CE", "4C", "CA", "2E", "52", "95", "D9", "1E", "4E", "38", "44", "28", "0A", "DF", "02", "A0", "17", "F1", _
  313.           "60", "68", "12", "B7", "7A", "C3", "E9", "FA", "3D", "53", "96", "84", "6B", "BA", "F2", "63", "9A", "19", "7C", _
  314.           "AE", "E5", "F5", "F7", "16", "6A", "A2", "39", "B6", "7B", "0F", "C1", "93", "81", "1B", "EE", "B4", "1A", "EA", _
  315.           "D0", "91", "2F", "B8", "55", "B9", "DA", "85", "3F", "41", "BF", "E0", "5A", "58", "80", "5F", "66", "0B", "D8", _
  316.           "90", "35", "D5", "C0", "A7", "33", "06", "65", "69", "45", "00", "94", "56", "6D", "98", "9B", "76", "97", "FC", _
  317.           "B2", "C2", "B0", "FE", "DB", "20", "E1", "EB", "D6", "E4", "DD", "47", "4A", "1D", "42", "ED", "9E", "6E", "49", _
  318.           "3C", "CD", "43", "27", "D2", "07", "D4", "DE", "C7", "67", "18", "89", "CB", "30", "1F", "8D", "C6", "8F", "AA", _
  319.           "C8", "74", "DC", "C9", "5D", "5C", "31", "A4", "70", "88", "61", "2C", "9F", "0D", "2B", "87", "50", "82", "54", _
  320.           "64", "26", "7D", "03", "40", "34", "4B", "1C", "73", "D1", "C4", "FD", "3B", "CC", "FB", "7F", "AB", "E6", "3E", _
  321.           "5B", "A5", "AD", "04", "23", "9C", "14", "51", "22", "F0", "29", "79", "71", "7E", "FF", "8C", "0E", "E2", "0C", _
  322.           "EF", "BC", "72", "75", "6F", "37", "A1", "EC", "D3", "8E", "62", "8B", "86", "10", "E8", "08", "77", "11", "BE", _
  323.           "92", "4F", "24", "C5", "32", "36", "9D", "CF", "F3", "A6", "BB", "AC", "5E", "6C", "A9", "13", "57", "25", "B5", _
  324.           "E3", "BD", "A8", "3A", "01", "05", "59", "2A", "46")
  325.           
  326. SetKey Pass
  327. End Sub
  328.  
  329. Private Function InvG(inp As String, key() As String) As String
  330. Dim g1 As String
  331. Dim g2 As String
  332. Dim g3 As String
  333. Dim g4 As String
  334. Dim g5 As String
  335. Dim g6 As String
  336. Dim l As String
  337.  
  338. g5 = Mid(inp, 1, 2)
  339. g6 = Mid(inp, 3, 2)
  340.  
  341. l = F(CByte(BigTrans(BigXOR(g5, key((4 * u) + 3)))))
  342. g4 = BigXOR(l, g6)
  343. l = F(CByte(BigTrans(BigXOR(g4, key((4 * u) + 2)))))
  344. g3 = BigXOR(l, g5)
  345. l = F(CByte(BigTrans(BigXOR(g3, key((4 * u) + 1)))))
  346. g2 = BigXOR(l, g4)
  347. l = F(CByte(BigTrans(BigXOR(g2, key(4 * u)))))
  348. g1 = BigXOR(l, g3)
  349.  
  350. l = g1 & g2
  351. InvG = l
  352. End Function
  353. Public Function OFB_Crypto(inp As String, IV As String) As String
  354. Dim Dat As String, Outp As String, old As String
  355. Dim OldDat As String
  356.  
  357. For i = 1 To Len(inp) Step 16
  358.     Dat = Mid(inp, i, 16)
  359.     If i = 1 Then
  360.         old = Encrypt(IV)
  361.     Else
  362.         old = Encrypt(OldDat)
  363.     End If
  364.     OldDat = old
  365.     Outp = Outp & CryptoXOR(Dat, old)
  366. Next i
  367. OFB_Crypto = Outp
  368. End Function
  369.  
  370. Private Sub SetKey(Pass As String)
  371. For i = 0 To 131 Step 10
  372.     If i = 130 Then
  373.         key(i + 0) = Mid(Pass, 1, 2)
  374.         key(i + 1) = Mid(Pass, 3, 2)
  375.     Else
  376.         key(i + 0) = Mid(Pass, 1, 2)
  377.         key(i + 1) = Mid(Pass, 3, 2)
  378.         key(i + 2) = Mid(Pass, 5, 2)
  379.         key(i + 3) = Mid(Pass, 7, 2)
  380.         key(i + 4) = Mid(Pass, 9, 2)
  381.         key(i + 5) = Mid(Pass, 11, 2)
  382.         key(i + 6) = Mid(Pass, 13, 2)
  383.         key(i + 7) = Mid(Pass, 15, 2)
  384.         key(i + 8) = Mid(Pass, 17, 2)
  385.         key(i + 9) = Mid(Pass, 19, 2)
  386.     End If
  387. Next
  388. End Sub
  389. Public Sub main()
  390. Dim Pass As String, inp As String, S As String, l As String
  391.  
  392. If Test = True Then 'Check if the algorithm has been tampered with(Atn. This is not required except for the first time)
  393. For i = 1 To 10 'Generate random 80-bit key
  394.     Randomize
  395.     m = Hex(Rnd * 255)
  396.     If Len(m) = 1 Then m = "0" & m
  397.     Pass = Pass & m
  398. Next i
  399.  
  400. Init Pass 'Initialize the key (This is required before encryption and decryption)
  401.  
  402. 'This is the input data. (only 8 bytes at a time)
  403. inp = EnHex("Asgeir!!")
  404. S = Encrypt(inp) 'Encrypt the data in ECB Mode
  405. l = Decrypt(S)
  406. If inp = Decrypt(S) Then 'Check if decrypted correctly(This will have to be checked in another manner)
  407.     MsgBox DeHex(l)
  408.     End
  409. Else
  410.     MsgBox "Incorrect Key!" 'Did not decrypt correctly so show error message
  411.     End
  412. End If
  413. Else
  414.     MsgBox "Failed to verify the algorithm!" 'The algorithm has been tampered with so stop
  415.     End
  416. End If
  417. End Sub
  418. Public Function Test() As Boolean
  419. 'Test the algorithm using test vectors
  420. Init "00998877665544332211"
  421. Test = False
  422. If Encrypt("33221100DDCCBBAA") = "2587CAE27A12D300" And Decrypt("2587CAE27A12D300") = "33221100DDCCBBAA" Then
  423.     Test = True
  424.     Exit Function
  425. End If
  426. End Function
  427. Public Function DeHex(inp As String) As String
  428. For i = 1 To Len(inp) Step 2
  429.     x = x & Chr(Val("&H" & Mid(inp, i, 2)))
  430. Next i
  431. DeHex = x
  432. End Function
  433. Public Function EnHex(x As String) As String
  434. For i = 1 To Len(x)
  435.     v = Hex(Asc(Mid(x, i, 1)))
  436.     If Len(v) = 1 Then v = "0" & v
  437.     inp = inp & v
  438. Next i
  439. EnHex = inp
  440. End Function
  441. Public Function Pad(ByVal inp As String) As String
  442. Top:
  443. If Not Len(inp) Mod 8 = 0 Then
  444.     inp = inp & " "
  445.     GoTo Top
  446. End If
  447. Pad = inp
  448. End Function
  449.