Email Encryption

[xcoder]

print "#######################################"

print " ARC4 Stream Cipher Base 85 Format";space$(7);"V"

print " Accepts only hex values for key";space$(19);"V"

print " Email Compatible";space$(48);"V"

print"#######################################"

global key$ '************

print:print



print space$(10);" Select an Option: "

print space$(10);" Select (1) for Encrypt"

print space$(10);" Select (2) for Decrypt"

print space$(10);" Select (3) to quit"

input "Enter your choice: ";var

select case var

case 1

call readWriteFile

case 2

call readWriteNext

case 3

call Quit

case else

call invalid

end select





print:print

wait

End



sub hexKey$ keybd$

print "Hex" + space$(5) + "Decimal"

for i = 1 to len(keybd$)step 2

chunk$ = mid$(keybd$,i,2)

byte = hexDec(chunk$)

if byte = 0 then

cls

call invalid

end if

key$ = key$ + chr$(byte)

print chunk$, byte

next i

print key$

end sub





sub KSA

dim S(256)

dim K(256)

i = 0

j = 0

for i = 0 to 255

S(i)= i

next i

for i = 0 to 255

K(i)= asc(mid$(key$,i mod len(key$)+1))

next i

for i = 0 to 255

j = (j+ S(i)+ K(i))mod 256

temp = S(i)

S(i)= S(j)

S(j)= temp

next i

end sub



sub readWriteFile

input "Enter key code: ";key$

call hexKey$ key$

call KSA

input "Enter file to read: ";infile$

dim info$(10,10)

if fileExists(infile$) then

print infile$; " exist!"

else

print infile$; " doesn't exist!"

call Quit

end if

input "Enter file to write: ";outfile$

open infile$ for input as #r

open outfile$ for output as #w

while eof(#r) = 0

input #r, text$

alpha$ = txPRGA$(text$)

print #w, alpha$

wend

close #r

close #w

for i = 0 to 7

print space$(i); "Encrypting"

next i

print ""

print "Process Completed"

end sub





function txPRGA$(inString$)

i = 0 :j = 0

for x = 1 to len(inString$)

i = i + 1

byte = asc(mid$(inString$,x,1))

j = (j + S(i))mod 256

temp = S(i)

S(i) = S(j)

S(j) = temp

St = (S(i) + S(j))mod 256

k = byte xor St

char$ = char$ + chr$(k)

next x

txPRGA$ = Format85$(char$)

end function



function Format85$(dat$)

Z85$ = "0123456789abcdefghijklmnopqrstuvwxyz" +_ 'divide string

"ABCDEFGHIJKLMNOPQRSTUVWXYZ.-:+=^!/*?&<>()[]{}@%$#"

datLenMod = len(dat$) mod 4

if datLenMod then padding = 4 - datLenMod

for x = 1 to padding

dat$ = dat$ + chr$(0)

next x

for x = 1 to len(dat$) step 4

temp$ = mid$(dat$, x, 4)

for y = 1 to 4

conv = (conv * 256) + asc(mid$(temp$, y, 1))

next y

for convCount = 1 to 5

char = (conv mod 85) + 1

chunk$ = mid$(Z85$, char, 1) + chunk$

conv = int(conv / 85)

next convCount

Format85$ = Format85$ + chunk$

chunk$ = ""

next x

Format85$ = left$(Format85$, len(Format85$) - padding)

end function



print "-----------------------------------------------"



sub readWriteNext

input "Enter key code: ";key$

call hexKey$ key$

call KSA

input "Enter file to read: ";infile$

dim info$(10,10)

if fileExists(infile$) then

print infile$; " exist!"

else

print infile$; " doesn't exist!"

call Quit

end if

input "Enter file to write: ";outfile$

open infile$ for input as #r

open outfile$ for output as #w

while eof(#r) = 0

input #r, text$

alpha$ = unFormat85$(text$)

print #w, alpha$

wend

close #r

close #w

for i = 0 to 7

print space$(i); "Decrypting"

next i

print ""

print "Process Completed"

end sub



function unFormat85$(dat$)

Z85$ = "0123456789abcdefghijklmnopqrstuvwxyz" +_ 'divide string

"ABCDEFGHIJKLMNOPQRSTUVWXYZ.-:+=^!/*?&<>()[]{}@%$#"

padChr$ = right$(Z85$, 1)

datLenMod = len(dat$) mod 5

if datLenMod then padding = 5 - datLenMod

for x = 1 to padding

dat$ = dat$ + padChr$

next x

for x = 1 to len(dat$) step 5

temp$ = mid$(dat$, x, 5)

for y = 1 to 5

t$ = mid$(temp$, y, 1)

conv = (conv * 85) + (instr(Z85$, t$) - 1)

next y

for deconvCount = 1 to 4

char = conv mod 256

chunk$ = chr$(char) + chunk$

conv = int(conv / 256)

next deconvCount

unFormat85$ = unFormat85$ + chunk$

chunk$ = ""

next x

pass$ = left$(unFormat85$, len(unFormat85$) - padding)

unFormat85$ = rxPRGA$(pass$)

end function





function rxPRGA$(inString$)

i = 0 :j = 0

for x = 1 to len(inString$)

i = i + 1

byte = asc(mid$(inString$,x,1))

j = (j + S(i))mod 256

temp = S(i)

S(i) = S(j)

S(j) = temp

St = (S(i) + S(j))mod 256

k = byte xor St

char$ = char$ + chr$(k)

next x

rxPRGA$ = char$

end function

'--------------------------------------------------------------------------------------------------------

function fileExists(fullPath$)

files pathOnly$(fullPath$), filenameOnly$(fullPath$), info$()

fileExists = val(info$(0, 0)) > 0

end function



function pathOnly$(fullPath$)

pathOnly$ = fullPath$

while right$(pathOnly$, 1) <> "\" and pathOnly$ <> ""

pathOnly$ = left$(pathOnly$, len(pathOnly$)-1)

wend

end function



function filenameOnly$(fullPath$)

pathLength = len(pathOnly$(fullPath$))

filenameOnly$ = right$(fullPath$, len(fullPath$)-pathLength)

end function



sub Quit

print "quiting application"

print "goodbye!"

wait

End

end sub



sub invalid

print "invalid input. Select options from the menu"

print "Use hex characters for key"

print "Goodbye!"

wait

End

end sub