Sorry your browser is not supported!

` (c)2005 Robert J. Saunders
` just in case it happens to be absolutely brilliant
` and warranting several million dollars.
sync on
sync rate 0
set display mode 800,600,32
set text size 12
color backdrop 0
autocam off
randomize timer()
set image colorkey 0,0,0
set text font "arial"
sync
sync

global source$
global output$
global timer$

red as integer
bytlen as integer

get_a_file:

cls
dir
print "enter a file name in this directory to encrypt"
sync
input source$

if file exist(source$)=0 then goto get_a_file

cls
set text size 70
center text 400,200,"ENCRYPTING!"
sync
 wait 500

for t=1 to len(source$)
 if mid$(source$,t)="." then exit
next t

timer$=str$(timer()/13337)

output$=timer$+left$(source$,t-1)+".enc"

open to write 1,output$

dim key(33)
restore encryptionkeydata
a=rnd(2)
keykey=a
for t=0 to a
 for u=1 to 33
  read b
  key(u)=b
 next u
next t

dim non(7)
restore nonsensedatakey
nonkey=rnd(9)
for t=0 to nonkey
 for u=1 to 7
  read b
  non(u)=b
 next u
next t

write byte 1,rnd(9)+1
write byte 1,keykey
write byte 1,rnd(9)+1
write byte 1,nonkey


count=0
noncount=0
nonstep=1
bytlen=0

open to read 2,source$
repeat
 read byte 2,red
 inc bytlen
until file end(2)=1
close file 2

write word 1,rnd(65535)
write long 1,bytlen
write word 1,rnd(65535)

open to read 2,source$

repeat

inc noncount
if noncount=non(nonstep)
 write byte 1,rnd(255)
 noncount=0
 inc nonstep
  if nonstep>7 then nonstep=1
endif

inc count
if count=34 then count=1

read byte 2,red
red=red*key(count)

write word 1,red

until file end(2)=1

close file 1

close file 2

to_decrypt()

end

function to_decrypt()

cls
set text size 100
center text 400,190,"DECRYPTING!"
sync
 wait 500

for t=0 to 33
 key(t)=0
next t
for t=0 to 7
 non(t)=0
next t

open to read 3,output$

n$="D"+timer$+source$

read byte 3,a
read byte 3,keykey
read byte 3,a
read byte 3,nonkey

read word 3,a
read long 3,bytlen
read word 3,a

restore encryptionkeydata
for t=0 to keykey
 for u=1 to 33
  read b
  key(u)=b
 next u
next t

restore nonsensedatakey
for t=0 to nonkey
 for u=1 to 7
  read b
  non(u)=b
 next u
next t

open to write 4,n$

count=0
noncount=0
nonstep=1

repeat

inc count
if count=34 then count=1

inc noncount
if noncount=non(nonstep)
 read byte 3,a
 noncount=0
 inc nonstep
  if nonstep>7 then nonstep=1
endif

read word 3,red
red=red/key(count)

write byte 4,red
dec bytlen

until file end(3)=1 or bytlen=0

close file 3

close file 4


endfunction

encryptionkeydata:
data 119,43,166,101,175,135,154,181,202,14,213,130,5,128,211,58,185,103,11,106,28,134,198,40,24,73,50,42,182,172,51,30,88
data 89,10,61,144,124,218,104,147,176,77,123,213,70,31,157,193,201,41,107,167,5,137,26,179,211,75,93,39,43,215,152,196,195
data 91,38,218,167,54,66,130,153,186,220,202,42,22,158,206,165,169,14,30,172,96,145,163,190,85,7,225,115,110,9,56,5,53
data 84,207,160,202,150,131,36,89,67,191,15,164,25,74,86,200,115,58,105,189,95,185,70,6,119,27,109,54,132,203,21,121,81
data 65,132,198,178,147,224,123,189,64,114,122,213,117,56,166,188,6,205,99,13,140,207,157,173,120,5,185,136,196,113,14,42,84
data 191,204,165,184,213,107,119,88,201,53,73,27,97,37,33,157,215,68,70,14,111,187,155,170,134,8,110,121,18,13,105,21,56
data 94,38,66,132,220,175,59,69,111,169,119,163,50,67,170,42,180,22,216,124,147,71,182,29,79,99,96,75,51,17,199,221,200
data 141,196,162,181,125,163,208,100,91,56,109,101,136,47,53,148,35,131,20,201,42,129,150,202,28,90,15,172,94,225,120,58,89
data 206,27,156,29,32,134,143,52,109,125,94,123,193,58,114,79,83,92,5,168,177,82,73,22,31,184,62,24,129,41,63,128,216
data 207,180,191,157,149,102,61,22,33,166,130,147,156,145,64,172,200,113,54,117,106,134,175,211,13,32,24,84,18,223,26,171,35

nonsensedatakey:
data 3,4,5,6,7,8,9
data 9,8,7,6,5,4,3
data 5,4,6,7,3,8,9
data 9,7,5,3,4,6,8
data 4,6,8,3,5,7,9
data 3,6,4,7,5,8,9
data 9,6,8,5,7,4,3
data 3,7,5,8,9,6,4
data 7,9,3,4,6,5,8
data 8,6,9,4,3,7,5

And no one tell Bob that I'm trying to get him disqualified by encouraging him to include a splash screen.

Open To Read 1,"datatest.exe"

y=1
Do
   For x = 1 to 32
      If File End(1) then Exit
      Read Byte 1,b
      Set Cursor x*30,y*15
      Print b;","
      Set Cursor x*30,400+y*15
      Print Chr$(b);","
   Next i
   y=y+1
   IF y>20
      Wait Key
      cls
      y=1
   Endif
   Print
Loop
Wait key

set display mode 800,600,32
sync on
sync rate 0
sync
sync
randomize timer()


 ` YOU can enter any filename here:
a$="filename.txt"
originalname$=a$
print a$

 ` this chops off the file extension
for t=1 to len(a$)
 if mid$(a$,t)="." then exit
next t
a$=left$(a$,t-1)

print a$

 ` this builds the name up to at least 13 characters long
b$=""
repeat
b$=b$+a$
until len(b$)>12

print b$

 ` this computes number values based on the ascii values of the name
c$=""
for t=1 to len(b$)
 a=asc(mid$(b$,t))
 print a;"    "+str$(t+(a*(2+t)*t))
 c$=c$+str$(t+(a*(2+t)*t))
next t

print c$
print len(c$)

 ` this multiplies each digit within the string by an ever-increasing number.
d$=""
for t=1 to len(c$)
 a=val(mid$(c$,t))*(t+1)
 d$=d$+str$(a)
next t
c$=d$
print
print d$
print len(d$)

 ` this removes zeroes.
for x=1 to 10
 a=len(c$)
 for t=1 to a
  d$=mid$(c$,t)
  if d$="0"
   e$=left$(c$,t-1)
   f$=right$(c$,a-t)
   c$=e$+f$
   dec a
  endif
 next t
next x

print
print c$
print len(c$)

 ` shorten c$ to an even number
a=len(c$)
if a mod 2>0
 c$=left$(c$,a-1)
endif
print
print c$
print len(c$)

`write to clipboard c$


a$=originalname$
 ` this chops off the file extension
for t=1 to len(a$)
 if mid$(a$,t)="." then exit
next t
a$=left$(a$,t-1)
a$=str$(rnd(99))+a$+".kee"

open to write 1,a$
write string 1,c$


 ` this makes the multiplication key:

dim key$(100) as string

a=len(c$)/2
if a>99 then a=98
for t=1 to a step 2
 a$=mid$(c$,t)
 b$=mid$(c$,t+1)
 key$(t)=a$+b$
 write string 1,key$(t)
next t
keylen=a/2
write string 1,"+"+str$(keylen)
 ` this makes the nonsense insertion key:

dim non(10)

n=1
a=3+val(mid$(c$,1))
for t=a to a+10
 b=val(mid$(c$,t))+2
 non(n)=b
 inc n
 write string 1,str$(b)
next t

close file 1

sync
wait key

end

10 Points - IBOL
 8 Points - Riidii
 6 Points - Neofish
 4 Points - Tomu (just for entering ;-))

and finally, Nil Points - England.. Just has to be done :-)

Well done to all the coders who tried. I think that if Neofish's code has worked on more than just ASCII & was a little faster, IBOL's didn't fatten the code to over double and Riidii's had got some commenting going on there would have been 3 winners!! (Tomu, you'd have had to finish it btw :-)

/******************************************
 **                                      **
 **   FUNCTIONS FOR DETECTING TYPE OF    **
 **                                      **
 **           LETTER PROVIDED            **
 **                                      **
 ******************************************/
function isAscii($letter)
{
	$test = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789";
	return (strpos($test, $letter) > -1);
}
function isNumber($letter)
{
	$test = "0123456789";
	return (strpos($test, $letter) > -1);
}




/******************************************
 **                                      **
 **    THIS SECTION IS FOR PROCESSING    **
 **                                      **
 **     DARK BASIC SOURCE CODE INTO      **
 **                                      **
 **        COLOURED OUTPUT (HTML)        **
 **                                      **
 ** CREATED BY                           **
 **    * STUART MCHATTIE                 **
 **    * NICHOLAS THOMPSON               **
 **                                      **
 ******************************************/
function Process_DBP_Source($content)
{
	//Convert source to uppercase
	$contentUpper = strtoupper($content);				
	
	//Load command list
	$commandHandle = fopen("dbpcommands.ini", "r");
	$commandsContent = fread($commandHandle, filesize("dbpcommands.ini"));
	$commandsContent = explode("n",$commandsContent);
	
	for ($i = 0; $i < count($commandsContent); $i++)
	{
	    $commandsContent[$i] = trim($commandsContent[$i]);
	}
	

	
	
	//Fill the array so its all not code by default
	$codeColor = array_fill(0, strlen($content), "nC");

	
	//Color the numbers
	$pos = -1;
	$numbers = array("1","2","3","4","5","6","7","8","9","0");
	foreach($numbers as $a)
	{
		$pos = -1;
		while(($pos = strpos($contentUpper, $a, $pos + 1)) > -1)
		{
			$codeColor[$pos] = "N";
		}
	}

	//Color the code
	foreach($commandsContent as $a)
	{
		$pos = -1;
		while(($pos = strpos($contentUpper, $a, $pos + 1)) > -1)
		{
			if ((!isAscii(substr($contentUpper, $pos - 1, 1)) || $pos == 0) && (!isAscii(substr($contentUpper, $pos + strlen($a), 1)) || $pos == strlen($contentUpper) - strlen($a)))
			{
				for($i = $pos; $i < $pos + strlen($a); $i++)
				{
					$codeColor[$i] = "C";
				}
			}
		}
	}
	
	//markup the remarks
	$pos = -1;
	while(($pos = strpos($contentUpper, "`", $pos + 1)) > -1)
	{
		$endOfLine = strpos($contentUpper, "n", $pos+1);
		for($i = $pos; $i < $endOfLine; $i++)
		{
			$codeColor[$i] = "R";
		}
		$pos = $endOfLine;
	}

	
	
	
	$outputContent = "";
	$outputContent .= "<BLOCKQUOTE><FONT CLASS="".$codeColor[0]."">".substr($content, 0, 1);
	
	for ($i = 1; $i < count($codeColor); $i++)
	{
		if ($codeColor[$i] != $codeColor[$i - 1])
		{
			$outputContent .= "</FONT><FONT CLASS="".$codeColor[$i]."">";
		}
		$character = substr($content, $i, 1);
		
		if($character == "n")
			$outputContent .= "<BR>n";
		else if($character == " " && substr($content, $i+1, 1) == " ")
			$outputContent .= " ";
		else
			$outputContent .= $character;
	}
	$outputContent .= "</FONT><BLOCKQUOTE>";
	
	return $outputContent;
}