It turned out to be easier than I thought. Here is the code for the two .dba files. The first is just a quick and rough app. The second is the encryption algorithm. Note that I had to make some changes to the algorithm file, so it is different from the previous one I posted earlier.
`Crypto.dba version 1.0
`by The Sab
`This is quick (and very rough) file encryption program.
`Use at your own risk. Feel free to modify.
`In this incarnation, when you encrypt a file, the program
`creates a new file with the same name plus a '.ENC' extension.
`When that file with the '.ENC' extension is decrypted, it
`creates yet another file with the original file name, except
`with a '.DEC' extension. This file should be identical to the
`original.
`It does NOT delete the original file, as I do not wish for
`people to track me down and irritate me because they destroyed
`some important file, because the program didn't work properly.
`So far, it has worked on all of the files that I have tried,
`but I cannot take responsiblity if there is a file it does NOT
`work on properly.
set display mode 800, 600, 32
set window on
#constant MENU_MAIN 0
#constant MENU_ENCRYPT 1
#constant MENU_DECRYPT 2
global state as byte
global com as string
global password as string
global temp as dword
global crypt as dword
state = MENU_MAIN
do
menu()
loop
end
function menu()
select state
case MENU_MAIN:
print "CRYPTO MAIN MENU"
print "----------------"
print "1) Encrypt"
print "2) Decrypt"
print "3) Quit"
print ""
input ">>> ", com
select com
case "1":
state = MENU_ENCRYPT
endcase
case "2":
state = MENU_DECRYPT
endcase
case "3":
print "So long and thanks for all the fish."
wait 3000
end
endcase
case default
print "That is not an option."
endcase
endselect
endcase
case MENU_ENCRYPT:
print ""
print "Enter the path and filename of the file to encrypt:"
input ">>> ", com
if file exist(com)
print "Enter a password to encrypt this file:"
input ">>> ", password
writefile$ = com + ".ENC"
if file exist(writefile$)
print "It looks like this file already has an encrypted copy. Overwrite it?"
input "Y/N >>> ", overwrite$
select lower$(overwrite$)
case "y":
delete file writefile$
endcase
case "n":
state = MENU_MAIN
exitfunction
endcase
case default
print "I don't understand, so I will take that as a 'No'"
state = MENU_MAIN
exitfunction
endcase
endselect
endif
print "Encrypting..."
encrypt(com, password)
print "Encrypted File created."
state = MENU_MAIN
else
print "Sorry, could not find that file."
state = MENU_MAIN
endif
endcase
case MENU_DECRYPT:
print ""
print "Enter the path and filename of the file to decrypt:"
input ">>> ", com
if file exist(com)
print "Enter the password to decrypt this file:"
input ">>> ", password
writefile$ = left$(com, len(com) - 4) + ".DEC"
if file exist(writefile$)
print "It looks like this file already has a decrypted copy. Overwrite it?"
input "Y/N >>> ", overwrite$
select lower$(overwrite$)
case "y":
delete file writefile$
endcase
case "n":
state = MENU_MAIN
exitfunction
endcase
case default
print "I don't understand, so I will take that as a 'No'"
state = MENU_MAIN
exitfunction
endcase
endselect
endif
print "Decrypting..."
decrypt(com, password)
print "Decrypted File created."
state = MENU_MAIN
else
print "Sorry, could not find that file."
state = MENU_MAIN
endif
endcase
endselect
endfunction
`crypt_file.dba version 1.0
`by The Sab
`The following algorithm is called XXTEA (Tiny Encryption Algorithm)
`created by Roger Needham and David Wheeler. It was further modified
`by Chris Veness to give it the ability to encrypt/decrypt text instead
`of binary data, as well as being translated into javascript.
`This version was modified from the javascript to work within DBPro to
`load entire files, and encrypting them with a supplied password.
`To encrypt, call the function 'encrypt(<filename$>, <password$>)' and a new
`shiny encrypted version of the original file will be created with the
`same name plus '.ENC' extension.
`To decrypt, call the function 'decrypt(<filename$>, <password$>)' and a new
`shiny decrypted file, identical to the original, will be created with the
`'.DEC' extension.
`This was a quick and dirty modification of previous code, and so might not
`be optimized as well as it could. If I have time later, I will clean it up
`a bit.
function encrypt(filename as string, password as string)
cryptfile as string
n as dword
z as dword
y as dword
delta as dword
mx as dword
e as dword
q as dword
sum as dword
cryptfile = filename + ".ENC"
dim v() as dword
load_file_to_array(filename)
dim k(ceil(16.0/4.0) - 1) as dword
for i = 0 to array count(k())
k(i) = asc(mid$(password, i*4+1)) + (asc(mid$(password, i*4+2))<<8) + (asc(mid$(password, i*4+3))<<16) + (asc(mid$(password, i*4+4))<<24)
next i
n = array count(v()) + 1
z = v(n-1)
y = v(0)
delta = 0x9E3779B9
q = floor(6.0 + 52.0/n)
sum = 0
while q > 0
inc sum, delta
e = sum>>2 && 3
for p = 0 to n-1
y = v((p+1) mod n)
mx = (z>>5 ~~ y<<2) + (y>>3 ~~ z<<4) ~~ (sum~~y) + (k(p&&3 ~~ e) ~~ z)
z = v(p) + mx
v(p) = v(p) + mx
next p
dec q
endwhile
save_array_to_file(cryptfile)
undim v()
undim k()
endfunction
function decrypt(filename as string, password as string)
cryptfile as string
n as dword
z as dword
y as dword
delta as dword
mx as dword
e as dword
q as dword
sum as dword
cryptfile = left$(filename, len(filename) - 4) + ".DEC"
dim v() as dword
load_file_to_array(filename)
`For some reason, when the encrypted file is loaded up, it picks up an additional dword from somewhere.
`Since I am not sure where the additional element comes from, and because I am lazy, lets just delete it.
array delete element v(), array count(v())
dim k(ceil(16/4.0) - 1) as dword
for i = 0 to array count(k())
k(i) = asc(mid$(password, i*4+1)) + (asc(mid$(password, i*4+2))<<8) + (asc(mid$(password, i*4+3))<<16) + (asc(mid$(password, i*4+4))<<24)
next i
n = array count(v()) + 1
z = v(n-1)
y = v(0)
delta = 0x9E3779B9
q = floor(6.0 + 52.0/n)
sum = q*delta
while sum <> 0
e = sum>>2 && 3
for p = n-1 to 0 step -1
if p > 0
z = v(p-1)
else
z = v(n-1)
endif
mx = (z>>5 ~~ y<<2) + (y>>3 ~~ z<<4) ~~ (sum~~y) + (k(p&&3 ~~ e) ~~ z)
y = v(p) - mx
v(p) = v(p) - mx
next p
dec sum, delta
endwhile
save_array_to_file(cryptfile)
undim v()
undim k()
endfunction
function load_file_to_array(filename as string)
open to read 1, filename
while file end(1) <> 1
array insert at bottom v()
read long 1, v()
endwhile
close file 1
if file exist(filename + ".INT")
delete file filename + ".INT"
endif
save_array_to_file(filename + ".INT")
endfunction
function save_array_to_file(filename as string)
if array count(v()) > -1
open to write 1, filename
for i = 0 to array count(v())
write long 1, v(i)
next i
close file 1
endif
endfunction
function write_array_to_txt(filename as string)
if file exist(filename)
delete file filename
endif
open to write 1, filename
for i = 0 to array count(v())
write string 1, str$(v(i))
next i
close file 1
endfunction
I threw this together in a couple of hours, so I won't claim to have done exhaustive testing on it. It does not overwrite the original files, but instead creates encrypted/decrypted copies.
It has worked on the few files I tried it on, and seems to be working well. Feel free to modify (as if I could stop you) or rewrite any of the code to suit your needs.
<Edited>
Also keep in mind that this is encryption, not compression. Encrypting something the size of a reasonable size jpeg will only take a few seconds. Something the size of full length song in mp3 format may take several minutes. A full length movie would probably take several hours. This algorithm was originally designed to encrypt internet traffic like emails and instant messages.