Post by xcoder on Mar 1, 2023 16:01:26 GMT
'Text Encryption
'author = xcoder
'Date Mar 2023
'Purpose - To encrypt blocks of text, for example > Just Basic Programs
' Just paste your code into the texteditor and press encrypt button
'Uses Base 85 Text Format that is Word Processor and Email compatible
nomainwin
dim A$(100), K1(8), K2(8), D(8)
dim Fbox1(8), Fbox2(8)
global key$, two64
two64 = 2^ 64
WindowWidth = 600 : WindowHeight = 400
UpperLeftX=int((DisplayWidth-WindowWidth)/2)
UpperLeftY=int((DisplayHeight-WindowHeight)/2)
texteditor #main.text, 200, 20, 360, 320
button #main.enc, "Encrypt", [encrypt], ul, 55, 155, 110, 25
button #main.dec, "Decrypt", [decrypt], ul, 55, 195, 110, 25
button #main.clearKey , "Clear Key", [clearKey], ul, 30, 75, 70, 20
button #main.dec , "Clear Text", [clearText], ul, 110, 75, 70, 20
button #main.refresh , "Delete Encrypted File", [refresh], ul, 40, 240, 135, 25
button #main.copytext , "Copy Text", [copytext], ul, 75, 105, 60, 25
textbox #main.key, 30, 45, 150, 20
statictext #main.editor, "Type or Paste Text Here", 335, 5, 190, 15
statictext #main.encKey, "Encryption Key (16 Character HEX)", 20, 30, 170, 15
Open "Encryptor by xcoder" for window as #main
#main "trapclose [quit]"
key$ = "9e3779b9a1b2c3d4" 'hex 8 bytes (64 bits) '- original code key value = 16 chars
#main.key key$
#main.text "!autoresize"
if fileExists(DefaultDir$, "key") then
open "key" for input as #1 ''' not a binary file
#main.text input$(#1, lof(#1))
close #1
#main.text "!origin 0 0"
end if
wait
[encrypt]
if cript = 1 then [decrypt]
#main.key "!contents? key$"
call subKey
call flipBox
#main.text "!contents? text$"
text$ = trim$(text$)
redim A$(len(text$))
alpha$ = txMain$(text$)
alpha$ = trim$(alpha$)
#main.text "!cls"
cript = 1
#main.text alpha$
open "key" for output as #1 ''' not a binary file
#1 alpha$
close #1
restore
#main.text "!origin 0 0"
wait
[decrypt]
#main.key "!contents? key$"
#main.text "!contents? text$" 'this doesn't work when pasting encrypted text, as expected. IT WORKS NOW!!!!!
redim A$(len(text$))
call subKey
call flipBox
#main.text "!contents? text$"
text$ = trim$(text$)
bravo$ = unFormat85$(text$)
bravo$ = trim$(bravo$)
#main.text "!cls"
#main.text bravo$
cript = 0
#main.text "!origin 0 0"
wait
[clearKey]
#main.key ""
wait
[clearText]
#main.text "!cls"
wait
[refresh]
if fileExists(DefaultDir$, "key") then kill DefaultDir$;"\key"
#main.text "!cls"
wait
[copytext]
#main.text "!selectall"
#main.text "!copy"
wait
[quit]
close #main
End
sub subKey
num = hexDec(key$)
alpha = leftRotate(num,1)
hexKey1$ = decHex$(alpha)
print hexKey1$, "subKey 1"
bravo = leftRotate(num,4)
hexKey2$ = decHex$(bravo)
print hexKey2$, "subKey2"
print ""
x = 1
for i = 1 to len(hexKey1$)step 2
chunk$ = mid$(hexKey1$,i,2)
byte = hexDec(chunk$)
K1(x) = byte
print K1(x)
x = x + 1
next i
print ""
x = 1
for i = 1 to len(hexKey2$)step 2
chunk$ = mid$(hexKey2$,i,2)
byte = hexDec(chunk$)
K2(x) = byte
print K2(x)
x = x + 1
next i
end sub
' rotates bits left n times
function leftRotate(num,times)
num = num mod two64
r = (num * 2^ times) mod two64
l = int(num /(2^ (64 - times)))
leftRotate = r + l
end function
sub flipBox
data 128, 64, 32, 16, 8, 4, 2, 1 'odd block bit flips
for i = 1 to 8
read alpha
Fbox1(i) = alpha
next i
print:print
data 1, 2, 4, 8, 16, 32, 64, 128 'even block bit flips
for i = 1 to 8
read bravo
Fbox2(i) = bravo
next i
restore
end sub
function txMain$(text$)
x = 1
for i = 1 to len(text$) step 8
chunk$ = mid$(text$,i,8)
y = len(chunk$)
if y < 8 then chunk$ = chunk$ + addPad$(y)
A$(x) = chunk$ '*********************
print "BLOCK "; x, A$(x)
outStr$ = outStr$ + txRound1$(chunk$) 'envoke the rounds of cipher
x = x + 1 'number of text blocks
next i
txMain$ = outStr$
end function
function addPad$(x) 'pads the final text block
if x < 8 then
dif = 8 - x
for i = 1 to dif
pad$ = pad$ + chr$(0)
next i
end if
addPad$ = pad$
end function
function txRound1$(in$)
in$ = right$(in$,1) + left$(in$,7) '***********
for i = 1 to len(in$)
byte = asc(mid$(in$,i,1))
D(i) = byte
sum = D(i) xor K1(i) xor Fbox1(i)
char$ = char$ + chr$(sum)
next i
txRound1$ = txRound2$(char$)
end function
function txRound2$(in$)
in$ = right$(in$,1) + left$(in$,7) '***********
for i = 1 to len(in$)
byte = asc(mid$(in$,i,1))
D(i) = byte
sum = D(i) xor K2(i) xor Fbox2(i)
char$ = char$ + chr$(sum)
next i
print ''skip line
txRound2$ = 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 "############ Decryption Functions ############"
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$ = rxMain$(pass$)
end function
function rxMain$(text$)
x = 1
for i = 1 to len(text$) step 8
chunk$ = mid$(text$,i,8)
A$(x) = chunk$ '*********************
print "BLOCK "; x, A$(x)
outStr$ = outStr$ + rxRound2$(chunk$) 'envoke the rounds of cipher
x = x + 1 'reverse order
next i
rxMain$ = outStr$
end function
function rxRound2$(in$)
for i = 1 to len(in$)
byte = asc(mid$(in$,i,1))
D(i) = byte
sum = D(i) xor K2(i) xor Fbox2(i)
char$ = char$ + chr$(sum)
next i
rxRound2$ = rxRound1$(right$(char$,7) + left$(char$,1)) '***************
end function
function rxRound1$(in$)
for i = 1 to len(in$)
byte = asc(mid$(in$,i,1))
D(i) = byte
sum = D(i) xor K1(i) xor Fbox1(i)
char$ = char$ + chr$(sum)
next i
print ''skip line
rxRound1$ = right$(char$,7) + left$(char$,1) '***************
end function
'function for checking file existence
function fileExists(path$, filename$)
dim info$(0, 0)
files path$, filename$, info$()
fileExists = val(info$(0, 0)) 'non zero is true
end function
'author = xcoder
'Date Mar 2023
'Purpose - To encrypt blocks of text, for example > Just Basic Programs
' Just paste your code into the texteditor and press encrypt button
'Uses Base 85 Text Format that is Word Processor and Email compatible
nomainwin
dim A$(100), K1(8), K2(8), D(8)
dim Fbox1(8), Fbox2(8)
global key$, two64
two64 = 2^ 64
WindowWidth = 600 : WindowHeight = 400
UpperLeftX=int((DisplayWidth-WindowWidth)/2)
UpperLeftY=int((DisplayHeight-WindowHeight)/2)
texteditor #main.text, 200, 20, 360, 320
button #main.enc, "Encrypt", [encrypt], ul, 55, 155, 110, 25
button #main.dec, "Decrypt", [decrypt], ul, 55, 195, 110, 25
button #main.clearKey , "Clear Key", [clearKey], ul, 30, 75, 70, 20
button #main.dec , "Clear Text", [clearText], ul, 110, 75, 70, 20
button #main.refresh , "Delete Encrypted File", [refresh], ul, 40, 240, 135, 25
button #main.copytext , "Copy Text", [copytext], ul, 75, 105, 60, 25
textbox #main.key, 30, 45, 150, 20
statictext #main.editor, "Type or Paste Text Here", 335, 5, 190, 15
statictext #main.encKey, "Encryption Key (16 Character HEX)", 20, 30, 170, 15
Open "Encryptor by xcoder" for window as #main
#main "trapclose [quit]"
key$ = "9e3779b9a1b2c3d4" 'hex 8 bytes (64 bits) '- original code key value = 16 chars
#main.key key$
#main.text "!autoresize"
if fileExists(DefaultDir$, "key") then
open "key" for input as #1 ''' not a binary file
#main.text input$(#1, lof(#1))
close #1
#main.text "!origin 0 0"
end if
wait
[encrypt]
if cript = 1 then [decrypt]
#main.key "!contents? key$"
call subKey
call flipBox
#main.text "!contents? text$"
text$ = trim$(text$)
redim A$(len(text$))
alpha$ = txMain$(text$)
alpha$ = trim$(alpha$)
#main.text "!cls"
cript = 1
#main.text alpha$
open "key" for output as #1 ''' not a binary file
#1 alpha$
close #1
restore
#main.text "!origin 0 0"
wait
[decrypt]
#main.key "!contents? key$"
#main.text "!contents? text$" 'this doesn't work when pasting encrypted text, as expected. IT WORKS NOW!!!!!
redim A$(len(text$))
call subKey
call flipBox
#main.text "!contents? text$"
text$ = trim$(text$)
bravo$ = unFormat85$(text$)
bravo$ = trim$(bravo$)
#main.text "!cls"
#main.text bravo$
cript = 0
#main.text "!origin 0 0"
wait
[clearKey]
#main.key ""
wait
[clearText]
#main.text "!cls"
wait
[refresh]
if fileExists(DefaultDir$, "key") then kill DefaultDir$;"\key"
#main.text "!cls"
wait
[copytext]
#main.text "!selectall"
#main.text "!copy"
wait
[quit]
close #main
End
sub subKey
num = hexDec(key$)
alpha = leftRotate(num,1)
hexKey1$ = decHex$(alpha)
print hexKey1$, "subKey 1"
bravo = leftRotate(num,4)
hexKey2$ = decHex$(bravo)
print hexKey2$, "subKey2"
print ""
x = 1
for i = 1 to len(hexKey1$)step 2
chunk$ = mid$(hexKey1$,i,2)
byte = hexDec(chunk$)
K1(x) = byte
print K1(x)
x = x + 1
next i
print ""
x = 1
for i = 1 to len(hexKey2$)step 2
chunk$ = mid$(hexKey2$,i,2)
byte = hexDec(chunk$)
K2(x) = byte
print K2(x)
x = x + 1
next i
end sub
' rotates bits left n times
function leftRotate(num,times)
num = num mod two64
r = (num * 2^ times) mod two64
l = int(num /(2^ (64 - times)))
leftRotate = r + l
end function
sub flipBox
data 128, 64, 32, 16, 8, 4, 2, 1 'odd block bit flips
for i = 1 to 8
read alpha
Fbox1(i) = alpha
next i
print:print
data 1, 2, 4, 8, 16, 32, 64, 128 'even block bit flips
for i = 1 to 8
read bravo
Fbox2(i) = bravo
next i
restore
end sub
function txMain$(text$)
x = 1
for i = 1 to len(text$) step 8
chunk$ = mid$(text$,i,8)
y = len(chunk$)
if y < 8 then chunk$ = chunk$ + addPad$(y)
A$(x) = chunk$ '*********************
print "BLOCK "; x, A$(x)
outStr$ = outStr$ + txRound1$(chunk$) 'envoke the rounds of cipher
x = x + 1 'number of text blocks
next i
txMain$ = outStr$
end function
function addPad$(x) 'pads the final text block
if x < 8 then
dif = 8 - x
for i = 1 to dif
pad$ = pad$ + chr$(0)
next i
end if
addPad$ = pad$
end function
function txRound1$(in$)
in$ = right$(in$,1) + left$(in$,7) '***********
for i = 1 to len(in$)
byte = asc(mid$(in$,i,1))
D(i) = byte
sum = D(i) xor K1(i) xor Fbox1(i)
char$ = char$ + chr$(sum)
next i
txRound1$ = txRound2$(char$)
end function
function txRound2$(in$)
in$ = right$(in$,1) + left$(in$,7) '***********
for i = 1 to len(in$)
byte = asc(mid$(in$,i,1))
D(i) = byte
sum = D(i) xor K2(i) xor Fbox2(i)
char$ = char$ + chr$(sum)
next i
print ''skip line
txRound2$ = 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 "############ Decryption Functions ############"
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$ = rxMain$(pass$)
end function
function rxMain$(text$)
x = 1
for i = 1 to len(text$) step 8
chunk$ = mid$(text$,i,8)
A$(x) = chunk$ '*********************
print "BLOCK "; x, A$(x)
outStr$ = outStr$ + rxRound2$(chunk$) 'envoke the rounds of cipher
x = x + 1 'reverse order
next i
rxMain$ = outStr$
end function
function rxRound2$(in$)
for i = 1 to len(in$)
byte = asc(mid$(in$,i,1))
D(i) = byte
sum = D(i) xor K2(i) xor Fbox2(i)
char$ = char$ + chr$(sum)
next i
rxRound2$ = rxRound1$(right$(char$,7) + left$(char$,1)) '***************
end function
function rxRound1$(in$)
for i = 1 to len(in$)
byte = asc(mid$(in$,i,1))
D(i) = byte
sum = D(i) xor K1(i) xor Fbox1(i)
char$ = char$ + chr$(sum)
next i
print ''skip line
rxRound1$ = right$(char$,7) + left$(char$,1) '***************
end function
'function for checking file existence
function fileExists(path$, filename$)
dim info$(0, 0)
files path$, filename$, info$()
fileExists = val(info$(0, 0)) 'non zero is true
end function