Post by xcoder on Jul 7, 2023 4:11:02 GMT
'Block Text Encryption
'author = xcoder
'Purpose - To encrypt blocks of text, use up to 16 hex characters for key
' Just paste your code into the texteditor and press encrypt button
' nomainwin
BackgroundColor$ = "darkcyan"
ForegroundColor$ = "black"
dim 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 "Easy Block Encryptor 2.0 " 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$, "textEditor") then
open "textEditor" for input as #1
#main.text , text$ 'read from textEditor
close #1
#main.text "!origin 0 0" 'reset cursor
end if
wait
[encrypt]
#main.key "!contents? key$"
call subKey
call flipBox
#main.text "!contents? text$" ' read from textEditor
text$ = trim$(text$)
alpha$ = txMain$(text$) '***** encrypt
#main.text "!cls"
#main.text alpha$ 'write to textEditor
open "textEditor" for output as #1
#1 alpha$
close #1
#main.text "!origin 0 0" 'reset cursor
wait
[decrypt]
#main.key "!contents? key$"
#main.text "!contents? text$"
call subKey
call flipBox
#main.text "!contents? text$" 'read from textEditor
text$ = trim$(text$)
bravo$ = hex2Text$(text$) '***** decrypt
#main.text "!cls"
#main.text bravo$ 'write to textEditor
open "textEditor" for output as #1
#1 bravo$
close #1
#main.text "!origin 0 0" 'reset cursor
wait
[clearKey]
#main.key ""
wait
[clearText]
#main.text "!cls"
wait
[refresh]
if fileExists(DefaultDir$, "textEditor") then kill DefaultDir$;"\textEditor"
#main.text "!cls"
wait
[copytext]
#main.text "!selectall"
#main.text "!copy"
wait
[quit]
close #main
End
print "---------------------------------------------------------------------------------------------------"
'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
sub subKey '''''key expansion
num = hexDec(key$)
alpha = leftRotate(num,1)
hexKey1$ = decHex$(alpha)
bravo = leftRotate(num,4)
hexKey2$ = decHex$(bravo)
x = 1
for i = 1 to len(hexKey1$)step 2
chunk$ = mid$(hexKey1$,i,2)
byte = hexDec(chunk$)
K1(x) = byte '''' 1st sub key
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 '''' 2nd sub key
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 (transposition)
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 (transposition)
for i = 1 to 8
read bravo
Fbox2(i) = bravo
next i
restore ''''^^^^ required
end sub
function txMain$(text$)
x = 1
for i = 1 to len(text$) step 8
chunk$ = mid$(text$,i,8)
if len(chunk$) < 8 then
pad$ = chr$(94)+ chr$(94)+ chr$(94)+ chr$(94)+ chr$(94)+ chr$(94)+ chr$(94)+ chr$(94)
chunk$ = chunk$ + left$(pad$, 8 - len(chunk$))
end if
print "Block "; x ''''mainwin testing
x = x + 1
outStr$ = outStr$ + txRound1$(chunk$)
next i
txMain$ = outStr$
end function
function txRound1$(in$)
in$ = right$(in$,1) + left$(in$,7) '''pemutation
for i = 1 to len(in$)
byte = asc(mid$(in$,i,1))
D(i) = byte
sum = D(i) xor K1(i) xor Fbox1(i) '''^^ substitution
char$ = char$ + chr$(sum)
next i
print char$ '''''mainwin testing
txRound1$ = txRound2$(char$)
end function
function txRound2$(in$)
in$ = right$(in$,1) + left$(in$,7) '''''' permutation
for i = 1 to len(in$)
byte = asc(mid$(in$,i,1))
D(i) = byte
sum = D(i) xor K2(i) xor Fbox2(i) ''''^^^ substitution
char$ = char$ + chr$(sum)
next i
print char$ '''''' mainwin testing
txRound2$ = text2Hex$(char$)
print "" ''''skip line
end function
function text2Hex$(cipher$)
for i = 1 to len(cipher$) 'encrypted text
byte = asc(mid$(cipher$,i,1)) 'encrypted ascii
hex$ = decHex$(byte)
hex$ = right$("0" + hex$,2)
hexOut$ = hexOut$ + hex$ 'encrypted hex
next i
print hexOut$ '''''mainwin testing
text2Hex$ = hexOut$
end function
print "############ Decryption Functions ############"
function hex2Text$(hex$)
for i = 1 to len(hex$)step 2 'encrypted hex
chunk$ = mid$(hex$,i,2)
byte = hexDec(chunk$) 'encrypted ascii
text$ = text$ + chr$(byte) 'encrypted text
next i
hex2Text$= rxMain$(text$)
print hex2Text$ '******mainwin testing
end function
function rxMain$(text$)
x = 1
for i = 1 to len(text$) step 8
chunk$ = mid$(text$,i,8)
print "Block "; x ''''mainwin testing
outStr$ = outStr$ + rxRound2$(chunk$) 'envoke the rounds of cipher
x = x + 1 '''' data block counter
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) ''''substitution
char$ = char$ + chr$(sum)
next i
print char$ '''''mainwin testing
rxRound2$ = rxRound1$(right$(char$,7) + left$(char$,1)) '''permutation
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) '''substitution
char$ = char$ + chr$(sum)
next i
print char$ '''' mainwin testng
print ''skip line
rxRound1$ = right$(char$,7) + left$(char$,1) ''''permutation
end function
'author = xcoder
'Purpose - To encrypt blocks of text, use up to 16 hex characters for key
' Just paste your code into the texteditor and press encrypt button
' nomainwin
BackgroundColor$ = "darkcyan"
ForegroundColor$ = "black"
dim 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 "Easy Block Encryptor 2.0 " 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$, "textEditor") then
open "textEditor" for input as #1
#main.text , text$ 'read from textEditor
close #1
#main.text "!origin 0 0" 'reset cursor
end if
wait
[encrypt]
#main.key "!contents? key$"
call subKey
call flipBox
#main.text "!contents? text$" ' read from textEditor
text$ = trim$(text$)
alpha$ = txMain$(text$) '***** encrypt
#main.text "!cls"
#main.text alpha$ 'write to textEditor
open "textEditor" for output as #1
#1 alpha$
close #1
#main.text "!origin 0 0" 'reset cursor
wait
[decrypt]
#main.key "!contents? key$"
#main.text "!contents? text$"
call subKey
call flipBox
#main.text "!contents? text$" 'read from textEditor
text$ = trim$(text$)
bravo$ = hex2Text$(text$) '***** decrypt
#main.text "!cls"
#main.text bravo$ 'write to textEditor
open "textEditor" for output as #1
#1 bravo$
close #1
#main.text "!origin 0 0" 'reset cursor
wait
[clearKey]
#main.key ""
wait
[clearText]
#main.text "!cls"
wait
[refresh]
if fileExists(DefaultDir$, "textEditor") then kill DefaultDir$;"\textEditor"
#main.text "!cls"
wait
[copytext]
#main.text "!selectall"
#main.text "!copy"
wait
[quit]
close #main
End
print "---------------------------------------------------------------------------------------------------"
'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
sub subKey '''''key expansion
num = hexDec(key$)
alpha = leftRotate(num,1)
hexKey1$ = decHex$(alpha)
bravo = leftRotate(num,4)
hexKey2$ = decHex$(bravo)
x = 1
for i = 1 to len(hexKey1$)step 2
chunk$ = mid$(hexKey1$,i,2)
byte = hexDec(chunk$)
K1(x) = byte '''' 1st sub key
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 '''' 2nd sub key
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 (transposition)
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 (transposition)
for i = 1 to 8
read bravo
Fbox2(i) = bravo
next i
restore ''''^^^^ required
end sub
function txMain$(text$)
x = 1
for i = 1 to len(text$) step 8
chunk$ = mid$(text$,i,8)
if len(chunk$) < 8 then
pad$ = chr$(94)+ chr$(94)+ chr$(94)+ chr$(94)+ chr$(94)+ chr$(94)+ chr$(94)+ chr$(94)
chunk$ = chunk$ + left$(pad$, 8 - len(chunk$))
end if
print "Block "; x ''''mainwin testing
x = x + 1
outStr$ = outStr$ + txRound1$(chunk$)
next i
txMain$ = outStr$
end function
function txRound1$(in$)
in$ = right$(in$,1) + left$(in$,7) '''pemutation
for i = 1 to len(in$)
byte = asc(mid$(in$,i,1))
D(i) = byte
sum = D(i) xor K1(i) xor Fbox1(i) '''^^ substitution
char$ = char$ + chr$(sum)
next i
print char$ '''''mainwin testing
txRound1$ = txRound2$(char$)
end function
function txRound2$(in$)
in$ = right$(in$,1) + left$(in$,7) '''''' permutation
for i = 1 to len(in$)
byte = asc(mid$(in$,i,1))
D(i) = byte
sum = D(i) xor K2(i) xor Fbox2(i) ''''^^^ substitution
char$ = char$ + chr$(sum)
next i
print char$ '''''' mainwin testing
txRound2$ = text2Hex$(char$)
print "" ''''skip line
end function
function text2Hex$(cipher$)
for i = 1 to len(cipher$) 'encrypted text
byte = asc(mid$(cipher$,i,1)) 'encrypted ascii
hex$ = decHex$(byte)
hex$ = right$("0" + hex$,2)
hexOut$ = hexOut$ + hex$ 'encrypted hex
next i
print hexOut$ '''''mainwin testing
text2Hex$ = hexOut$
end function
print "############ Decryption Functions ############"
function hex2Text$(hex$)
for i = 1 to len(hex$)step 2 'encrypted hex
chunk$ = mid$(hex$,i,2)
byte = hexDec(chunk$) 'encrypted ascii
text$ = text$ + chr$(byte) 'encrypted text
next i
hex2Text$= rxMain$(text$)
print hex2Text$ '******mainwin testing
end function
function rxMain$(text$)
x = 1
for i = 1 to len(text$) step 8
chunk$ = mid$(text$,i,8)
print "Block "; x ''''mainwin testing
outStr$ = outStr$ + rxRound2$(chunk$) 'envoke the rounds of cipher
x = x + 1 '''' data block counter
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) ''''substitution
char$ = char$ + chr$(sum)
next i
print char$ '''''mainwin testing
rxRound2$ = rxRound1$(right$(char$,7) + left$(char$,1)) '''permutation
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) '''substitution
char$ = char$ + chr$(sum)
next i
print char$ '''' mainwin testng
print ''skip line
rxRound1$ = right$(char$,7) + left$(char$,1) ''''permutation
end function