This version only encrypts, ill add decryption tomorrow. Unlike DES, MARS uses a very different process to decrypt than to encrypt, so it may be up around tomorrow night. Ill also fix it to be a .bi w/ example file. as usual, third param for MARS_Encrypt is 1 for encryption, 2 for decryption.
Interestingly enough, this is the only implimentaion available on the web besides IBMs original C++ version.
Code: Select all
Option Explicit
Dim shared as ulongint aa1,bb1
Dim shared as longint aa2,bb2,cc2
Dim shared as uinteger BegSBOX(0 to 511) = {_
&H09D0C479, &H28C8FFE0, &H84AA6C39, &H9DAD7287, _
&H7DFF9BE3, &HD4268361, &HC96DA1D4, &H7974CC93, _
&H85D0582E, &H2A4B5705, &H1CA16A62, &HC3BD279D, _
&H0F1F25E5, &H5160372F, &HC695C1FB, &H4D7FF1E4, _
&HAE5F6BF4, &H0D72EE46, &HFF23DE8A, &HB1CF8E83, _
&HF14902E2, &H3E981E42, &H8BF53EB6, &H7F4BF8AC, _
&H83631F83, &H25970205, &H76AFE784, &H3A7931D4, _
&H4F846450, &H5C64C3F6, &H210A5F18, &HC6986A26, _
&H28F4E826, &H3A60A81C, &HD340A664, &H7EA820C4, _
&H526687C5, &H7EDDD12B, &H32A11D1D, &H9C9EF086, _
&H80F6E831, &HAB6F04AD, &H56FB9B53, &H8B2E095C, _
&HB68556AE, &HD2250B0D, &H294A7721, &HE21FB253, _
&HAE136749, &HE82AAE86, &H93365104, &H99404A66, _
&H78A784DC, &HB69BA84B, &H04046793, &H23DB5C1E, _
&H46CAE1D6, &H2FE28134, &H5A223942, &H1863CD5B, _
&HC190C6E3, &H07DFB846, &H6EB88816, &H2D0DCC4A, _
&HA4CCAE59, &H3798670D, &HCBFA9493, &H4F481D45, _
&HEAFC8CA8, &HDB1129D6, &HB0449E20, &H0F5407FB, _
&H6167D9A8, &HD1F45763, &H4DAA96C3, &H3BEC5958, _
&HABABA014, &HB6CCD201, &H38D6279F, &H02682215, _
&H8F376CD5, &H092C237E, &HBFC56593, &H32889D2C, _
&H854B3E95, &H05BB9B43, &H7DCD5DCD, &HA02E926C, _
&HFAE527E5, &H36A1C330, &H3412E1AE, &HF257F462, _
&H3C4F1D71, &H30A2E809, &H68E5F551, &H9C61BA44, _
&H5DED0AB8, &H75CE09C8, &H9654F93E, &H698C0CCA, _
&H243CB3E4, &H2B062B97, &H0F3B8D9E, &H00E050DF, _
&HFC5D6166, &HE35F9288, &HC079550D, &H0591AEE8, _
&H8E531E74, &H75FE3578, &H2F6D829A, &HF60B21AE, _
&H95E8EB8D, &H6699486B, &H901D7D9B, &HFD6D6E31, _
&H1090ACEF, &HE0670DD8, &HDAB2E692, &HCD6D4365, _
&HE5393514, &H3AF345F0, &H6241FC4D, &H460DA3A3, _
&H7BCF3729, &H8BF1D1E0, &H14AAC070, &H1587ED55, _
&H3AFD7D3E, &HD2F29E01, &H29A9D1F6, &HEFB10C53, _
&HCF3B870F, &HB414935C, &H664465ED, &H024ACAC7, _
&H59A744C1, &H1D2936A7, &HDC580AA6, &HCF574CA8, _
&H040A7A10, &H6CD81807, &H8A98BE4C, &HACCEA063, _
&HC33E92B5, &HD1E0E03D, &HB322517E, &H2092BD13, _
&H386B2C4A, &H52E8DD58, &H58656DFB, &H50820371, _
&H41811896, &HE337EF7E, &HD39FB119, &HC97F0DF6, _
&H68FEA01B, &HA150A6E5, &H55258962, &HEB6FF41B, _
&HD7C9CD7A, &HA619CD9E, &HBCF09576, &H2672C073, _
&HF003FB3C, &H4AB7A50B, &H1484126A, &H487BA9B1, _
&HA64FC9C6, &HF6957D49, &H38B06A75, &HDD805FCD, _
&H63D094CF, &HF51C999E, &H1AA4D343, &HB8495294, _
&HCE9F8E99, &HBFFCD770, &HC7C275CC, &H378453A7, _
&H7B21BE33, &H397F41BD, &H4E94D131, &H92CC1F98, _
&H5915EA51, &H99F861B7, &HC9980A88, &H1D74FD5F, _
&HB0A495F8, &H614DEED0, &HB5778EEA, &H5941792D, _
&HFA90C1F8, &H33F824B4, &HC4965372, &H3FF6D550, _
&H4CA5FEC0, &H8630E964, &H5B3FBBD6, &H7DA26A48, _
&HB203231A, &H04297514, &H2D639306, &H2EB13149, _
&H16A45272, &H532459A0, &H8E5F4872, &HF966C7D9, _
&H07128DC0, &H0D44DB62, &HAFC8D52D, &H06316131, _
&HD838E7CE, &H1BC41D00, &H3A2E8C0F, &HEA83837E, _
&HB984737D, &H13BA4891, &HC4F8B949, &HA6D6ACB3, _
&HA215CDCE, &H8359838B, &H6BD1AA31, &HF579DD52, _
&H21B93F93, &HF5176781, &H187DFDDE, &HE94AEB76, _
&H2B38FD54, &H431DE1DA, &HAB394825, &H9AD3048F, _
&HDFEA32AA, &H659473E3, &H623F7863, &HF3346C59, _
&HAB3AB685, &H3346A90B, &H6B56443E, &HC6DE01F8, _
&H8D421FC0, &H9B0ED10C, &H88F1A1E9, &H54C1F029, _
&H7DEAD57B, &H8D7BA426, &H4CF5178A, &H551A7CCA, _
&H1A9A5F08, &HFCD651B9, &H25605182, &HE11FC6C3, _
&HB6FD9676, &H337B3027, &HB7C8EB14, &H9E5FD030, _
&H6B57E354, &HAD913CF7, &H7E16688D, &H58872A69, _
&H2C2FC7DF, &HE389CCC6, &H30738DF1, &H0824A734, _
&HE1797A8B, &HA4A8D57B, &H5B5D193B, &HC8A8309B, _
&H73F9A978, &H73398D32, &H0F59573E, &HE9DF2B03, _
&HE8A5B6C8, &H848D0704, &H98DF93C2, &H720A1DC3, _
&H684F259A, &H943BA848, &HA6370152, &H863B5EA3, _
&HD17B978B, &H6D9B58EF, &H0A700DD4, &HA73D36BF, _
&H8E6A0829, &H8695BC14, &HE35B3447, &H933AC568, _
&H8894B022, &H2F511C27, &HDDFBCC3C, &H006662B6, _
&H117C83FE, &H4E12B414, &HC2BCA766, &H3A2FEC10, _
&HF4562420, &H55792E2A, &H46F5D857, &HCEDA25CE, _
&HC3601D3B, &H6C00AB46, &HEFAC9C28, &HB3C35047, _
&H611DFEE3, &H257C3207, &HFDD58482, &H3B14D84F, _
&H23BECB64, &HA075F3A3, &H088F8EAD, &H07ADF158, _
&H7796943C, &HFACABF3D, &HC09730CD, &HF7679969, _
&HDA44E9ED, &H2C854C12, &H35935FA3, &H2F057D9F, _
&H690624F8, &H1CB0BAFD, &H7B0DBDC6, &H810F23BB, _
&HFA929A1A, &H6D969A17, &H6742979B, &H74AC7D05, _
&H010E65C4, &H86A3D963, &HF907B5A0, &HD0042BD3, _
&H158D7D03, &H287A8255, &HBBA8366F, &H096EDC33, _
&H21916A7B, &H77B56B86, &H951622F9, &HA6C5E650, _
&H8CEA17D1, &HCD8C62BC, &HA3D63433, &H358A68FD, _
&H0F9B9D3C, &HD6AA295B, &HFE33384A, &HC000738E, _
&HCD67EB2F, &HE2EB6DC2, &H97338B02, &H06C9F246, _
&H419CF1AD, &H2B83C045, &H3723F18A, &HCB5B3089, _
&H160BEAD7, &H5D494656, &H35F8A74B, &H1E4E6C9E, _
&H000399BD, &H67466880, &HB4174831, &HACF423B2, _
&HCA815AB3, &H5A6395E7, &H302A67C5, &H8BDB446B, _
&H108F8FA4, &H10223EDA, &H92B8B48B, &H7F38D0EE, _
&HAB2701D4, &H0262D415, &HAF224A30, &HB3D88ABA, _
&HF8B2C3AF, &HDAF7EF70, &HCC97D3B7, &HE9614B6C, _
&H2BAEBFF4, &H70F687CF, &H386C9156, &HCE092EE5, _
&H01E87DA6, &H6CE91E6A, &HBB7BCC84, &HC7922C20, _
&H9D3B71FD, &H060E41C6, &HD7590F15, &H4E03BB47, _
&H183C198E, &H63EEB240, &H2DDBF49A, &H6D5CBA54, _
&H923750AF, &HF9E14236, &H7838162B, &H59726C72, _
&H81B66760, &HBB2926C1, &H48A0CE0D, &HA6C0496D, _
&HAD43507B, &H718D496A, &H9DF057AF, &H44B1BDE6, _
&H054356DC, &HDE7CED35, &HD51A138B, &H62088CC9, _
&H35830311, &HC96EFCA2, &H686F86EC, &H8E77CB68, _
&H63E1D6B8, &HC80F9778, &H79C491FD, &H1B4C67F2, _
&H72698D7D, &H5E368C31, &HF7D95E2E, &HA1D3493F, _
&HDCD9433E, &H896F1552, &H4BC4CA7A, &HA6D1BAF4, _
&HA5A96DCC, &H0BEF8B46, &HA169FDA7, &H74DF40B7, _
&H4E208804, &H9A756607, &H038E87C8, &H20211E44, _
&H8B7AD4BF, &HC6403F35, &H1848E36D, &H80BDB038, _
&H1E62891C, &H643D2107, &HBF04D6F8, &H21092C8C, _
&HF644F389, &H0778404E, &H7B78ADB8, &HA2C52D53, _
&H42157ABE, &HA2253E2E, &H7BF3F4AE, &H80F594F9, _
&H953194E7, &H77EB92ED, &HB3816930, &HDA8D9336, _
&HBF447469, &HF26D9483, &HEE6FAED5, &H71371235, _
&HDE425F73, &HB4E59F43, &H7DBE2D4E, &H2D37B185, _
&H49DC9A63, &H98C39D98, &H1301C9A2, &H389B1BBF, _
&H0C18588D, &HA421C1BA, &H7AA3865C, &H71E08558, _
&H3C5CFCAA, &H7D239CA4, &H0297D9DD, &HD7DC2830, _
&H4B37802B, &H7428AB54, &HAEEE0347, &H4B3FBB85, _
&H692F2F08, &H134E578E, &H36D9E0BF, &HAE8B5FCF, _
&HEDB93ECF, &H2B27248E, &H170EB1EF, &H7DC57FD6, _
&H1E760F16, &HB1136601, &H864E1B9B, &HD7EA7319, _
&H3AB871BD, &HCFA4D76F, &HE31BD782, &H0DBEB469, _
&HABB96061, &H5370F85D, &HFFB07E37, &HDA30D0FB, _
&HEBC977B6, &H0B98B40F, &H3A4D0FE6, &HDF4FC26B, _
&H159CF22A, &HC298D6E2, &H2B78EF6A, &H61A94AC0, _
&HAB561187, &H14EEA0F0, &HDF0D4164, &H19AF70EE}
#macro AddMod(a,b,c)
aa1 = a: bb1 = b
c = ((aa1+bb1) and &HFFFFFFFF)
#endmacro
#macro SubMod(a,b,c)
aa2 = a: bb2 = b
cc2 = aa2-bb2
If cc2 < 0 Then
c = &HFFFFFFFF-((ABS(cc2) and &HFFFFFFFF)-1)
else
c = cc2
Endif
#endmacro
#macro MulMod(a,b,c)
aa1 = a: bb1 = b
c = ((aa1*bb1) And &HFFFFFFFF)
#endmacro
#macro AddModS(a,b,c,m)
aa1 = a: bb1 = b
c = ((aa1+bb1) mod m)
#endmacro
#macro SubModS(a,b,c,m)
aa2 = a: bb2 = b
cc2 = aa2-bb2
If cc2 < 0 Then
c = m-(ABS(cc2) mod m)
else
c = cc2
Endif
#endmacro
Function MARS_StrToHex (Byref convstr As String) As String
Dim as string c
c = convstr
Dim As Uinteger i
Dim As String ftext
For i = 1 To Len(c)
ftext += Hex(Asc(Mid$(c,i,1)),2)
Next i
Return ftext
End Function
Function MARS_HexToStr (Byref convstr As String) As String
Dim as string c
c = convstr
If Len(c) Mod 2 = 1 Then c += "0"
Dim As Uinteger i
Dim As String f
For i = 1 To Len(c) Step 2
f += Chr$(Val("&H"+Mid$(c,i,2)))
Next i
Return f
End Function
Sub MARS_SplitTextBlock128(byref text as string, F() as uinteger)
F(0) = VAL("&H"+MARS_StrToHex(LEFT$ (text,4 )))
F(1) = VAL("&H"+MARS_StrToHex(MID$ (text,5,4)))
F(2) = VAL("&H"+MARS_StrToHex(MID$ (text,9,4)))
F(3) = VAL("&H"+MARS_StrToHex(RIGHT$(text,4 )))
End Sub
Sub MARS_ExpandKey(byref okey as string, byval klength as uinteger, F() as uinteger)
Dim as string key = okey
Static as uinteger B(0 to 3) = {&HA4A8D57B, &H5B5D193B, &HC8A8309B, &H73F9A978}
Dim as uinteger T(0 to 14), i, j, c, w
For i = 0 to klength-1
T(i) = VAL("&H" + MID$(key, i*8+1, 8))
Next i
T(klength) = klength
For i = klength+1 to 14
T(i) = 0
Next i
Dim as uinteger temp1, temp2, temp3
For j = 0 to 3
For i = 0 to 14
SubModS(i,7,temp1,15)
temp1 = T(temp1)
SubModS(i,2,temp2,15)
temp2 = T(temp2)
temp3 = temp1 XOR temp2
asm rol dword ptr[temp3], 3
temp1 = i SHL 2
AddMod(temp1, j, temp2)
T(i) = temp3 XOR temp2
Next i
For c = 1 to 4
For i = 0 to 14
SubModS(i,1,temp1,15)
temp1 = T(temp1)
temp1 = BegSBOX(temp1 AND &H1FF)
AddMod(T(i),temp1,temp2)
asm rol dword ptr[temp2], 9
T(i) = temp2
Next i
Next
For i = 0 to 9
temp1 = j*10+i
F(temp1) = T((i SHL 2) mod 15)
Next i
Next j
Dim as uinteger M, cm, scan, cbit, nbit, bcnt, q, b1, b2, b3
For i = 5 to 35 step 2
j = i AND &H3
w = F(i) OR &H3
cbit = -1
cm = 0
M = 0
bcnt = 0
For scan = 0 to 32
nbit = (w SHR scan) AND &H1
bcnt += 1
If nbit <> cbit or cbit = -1 or scan = 32 Then
If scan >= 9 and bcnt >= 10 Then
For q = scan-bcnt to scan-1
M = M OR (&H1 SHL q)
Next q
Endif
bcnt = 0
cbit = nbit
Endif
If scan >= 1 and scan <= 30 Then
b1 = (w shr (scan-1)) AND &H1
b2 = nbit
b3 = (w SHR (scan+1)) AND &H1
If b1 = b2 and b3 = b2 Then
cm = cm OR (&H1 SHL scan)
Endif
Endif
Next scan
M = M AND cm
M = M AND &H7FFFFFFF
M = M AND &HFFFFFFFC
temp1 = F(i-1) AND &H1F
temp2 = B(j)
asm mov cl, byte ptr[temp1]
asm rol dword ptr[temp2], cl
F(i) = w XOR (temp2 and M)
Next i
end sub
Sub E(byval in as uinteger, byval k1 as uinteger, byval k2 as uinteger, byref out1 as uinteger, byref out2 as uinteger, byref out3 as uinteger)
Dim as uinteger L, M, R, temp1
AddMod(in, k1, M)
temp1 = in
asm rol dword ptr[temp1], 13
R = temp1 * k2
temp1 = (M AND &H1FF)
L = BegSBOX(temp1)
asm rol dword ptr[R], 5
temp1 = R and &H1F
asm mov cl, byte ptr[temp1]
asm rol dword ptr[M], cl
L = L XOR R
asm rol dword ptr[R], 5
L = L XOR R
temp1 = R AND &H1F
asm mov cl, byte ptr[temp1]
asm rol dword ptr[L], cl
out1 = L
out2 = M
out3 = R
End Sub
Function MARS_BlockEncrypt(byref tstr as string, K() as uinteger) as string
Dim as string msg = tstr
Dim as string xp
Dim as uinteger D(0 to 3)
MARS_SplitTextBlock128 msg, D()
Dim as uinteger tempdw, i
For i = 0 to 3
AddMod(D(i),K(i),D(i))
Next i
For i = 0 To 7
D(1) = D(1) XOR BegSBOX(D(0) And &HFF)
tempdw = BegSBOX(256+((D(0) SHR 8) AND &HFF))
AddMod(D(1), tempdw, D(1))
tempdw = BegSBOX((D(0) SHR 16) AND &HFF)
AddMod(D(2), tempdw, D(2))
D(3) = D(3) XOR BegSBOX(256+(D(0) SHR 24))
tempdw = D(0)
asm ror dword ptr[tempdw], 24
If i = 0 or i = 4 Then
AddMod(D(0), D(3), D(0))
Elseif i = 1 or i = 5 Then
AddMod(D(0), D(1), D(0))
Endif
tempdw = D(3)
D(3) = D(0)
D(0) = D(1)
D(1) = D(2)
D(2) = tempdw
Next i
Dim as uinteger o1, o2, o3, p
For i = 0 to 15
p = i SHL 1
E D(0), K(p+4), K(p+5), o1, o2, o3
tempdw = D(0)
asm rol dword ptr[tempdw], 13
D(0) = tempdw
AddMod(D(2), o2, D(2))
If i < 8 Then
AddMod(D(1), o1, D(1))
D(3) = D(3) XOR o3
Else
AddMod(D(3), o1, D(3))
D(1) = D(1) XOR o3
Endif
tempdw = D(3)
D(3) = D(0)
D(0) = D(1)
D(1) = D(2)
D(2) = tempdw
Next i
For i = 0 to 7
If i = 2 or i = 6 then
SubMod(D(0),D(3),D(0))
elseif i = 3 or i = 7 then
SubMod(D(0),D(1),D(0))
endif
D(1) = D(1) XOR BegSBOX(256+(D(0) And &HFF))
tempdw = BegSBOX(D(0) SHR 24)
SubMod(D(2), tempdw, D(2))
tempdw = BegSBOX(256+((D(0) SHR 16) AND &HFF))
SubMod(D(3), tempdw, D(3))
D(3) = D(3) XOR BegSBOX((D(0) SHR 8) AND &HFF)
tempdw = D(0)
asm rol dword ptr[tempdw], 13
D(0) = tempdw
tempdw = D(3)
D(3) = D(0)
D(0) = D(1)
D(1) = D(2)
D(2) = tempdw
Next i
For i = 0 to 3
p = 36+i
SubMod(D(i), K(p), D(i))
Next i
Return MARS_HexToStr(HEX(D(0),8)) & MARS_HexToStr(HEX(D(1),8)) & MARS_HexToStr(HEX(D(2),8)) & MARS_HexToStr(HEX(D(3),8))
End Function
Function MARS_Encrypt(byref tstr as string, byref ttstr as string, byval ed as uinteger) as string
Dim as string msg1, key1, bk, passto
msg1 = tstr
key1 = ttstr
If msg1 = "" or key1 = "" Then
Beep
Return "ERROR - KEY/MESSAGE LENGTH CANNOT BE NULL"
Endif
Dim as uinteger K(0 to 39), i
MARS_ExpandKey key1, LEN(key1) SHR 3, K()
If ed = 1 Then 'encrypt
Dim as uinteger pad, i, rnds
pad = LEN(msg1) MOD 16
If pad > 0 Then
For i = 1 to (16-pad)
msg1 += CHR$(0)
Next i
Endif
rnds = LEN(msg1) SHR 4
bk = ""
For i = 1 To rnds
passto = MID$(msg1, (i-1)*16+1, 16)
bk += MARS_BlockEncrypt(passto, K())
Next i
Elseif ed = 2 then 'decrypt
else
beep
return "ERROR - INVALID ENCRYPTION MODE"
Endif
Return bk
End function
Print MARS_StrToHex(MARS_Encrypt("ummm... yeahummm, sig figs.... now if you will get out your periODIC tablllleee...", "00000000000000000000000000000000", 1))
sleep
end