Sorry your browser is not supported!

PRINT "Insert code:  "
INPUT command$

DO
if command$ = "PRINT Hello World!"
set cursor 0,0
PRINT "Hello World!"
endif
LOOP

do
   input "Enter command: ", cmd$
   if left$(lower$(cmd$),5) = "print" then print right$(cmd$,len(cmd$)-6)
loop

rem User Inputs
input code$

rem Creates DBA file
open to write 1,"commands.dba"
write string 1,"function command()"
write string 1,code$
write string 1,"endfunction"
close file 1

rem Initiates command
#include "commands.dba"
command()

tab:
do
print "Enter in your code"
input "COMMAND>"; cmd$
if cmd$="print" then printf()
loop

function printf()
print "What will be displayed?"
input "TEXT>"; txt$
print ""; txt$
endfunction

do
Dim commandList() as string
cmd$ = ""
var$ = ""

dir
print "What file will be read?"
input "FILE>", string$
cls
if file exist(string$+".src")=1 then open to read 1,string$+".src"
if file exist(string$+".src")=0 then goto errmsg1

main:
`Read the file and use the commands
if file open(1)=1
        while file end(1)=0
                do
                read string 1,cmd$
if left$(lower$(cmd$),5) = "print" then print right$(cmd$,len(cmd$)-6)
if cmd$ = "dir" then dir
if cmd$ = "pause" then print "Press any key to continue..." : suspend for key
if cmd$ = "drives" then drivelist
if cmd$ = "exit" then end
if cmd$ = "cls" then cls
if cmd$ = "done" then goto start
if cmd$ = "text color 1" then ink rgb(0,0,255),0
if cmd$ = "text color 2" then ink rgb(0,255,0),0
if cmd$ = "text color 3" then ink rgb(255,0,0),0
if cmd$ = "text color 4" then ink rgb(0,255,255),0
if cmd$ = "text color 5" then ink rgb(255,255,0),0
if cmd$ = "text color 6" then ink rgb(255,0,255),0
if cmd$ = "text color 7" then ink rgb(255,255,255),0
if cmd$ = "key wait" then suspend for key
if cmd$ = "get string" then input "STRING>"; string$
if cmd$ = "show string" then print ""; string$
if left$(lower$(cmd$),4) = "echo" then print right$(cmd$,len(cmd$)-5)
if left$(lower$(cmd$),7) = "encrypt" then encryptfile(right$(cmd$,len(cmd$)-8))
if left$(lower$(cmd$),7) = "decrypt" then decryptfile(right$(cmd$,len(cmd$)-8))
if left$(lower$(cmd$),7) = "execute" then executefile(right$(cmd$,len(cmd$)-8))
if left$(lower$(cmd$),4) = "call" then executefile(right$(cmd$,len(cmd$)-5))
if left$(lower$(cmd$),5) = "start" then executefile(right$(cmd$,len(cmd$)-6))
if left$(lower$(cmd$),2) = "cd" then setdir(right$(cmd$,len(cmd$)-3))
loop
                   array insert at bottom commandList()
                   commandList() = cmd$
        endwhile
        close file 1

endif


` Extra stuff
array index to top commandList()
repeat
        next array index commandList()
until array index valid(commandList()) = 0
loop

errmsg1:
cls
print "That file doesnt exist!!!"
print "You entered in the name ";string$+".src"
print "That file doesnt exist!!!"
print "Press any key to view the files in this directory..."
suspend for key
dir
suspend for key
cls
print "The program will now end..."
print "Press any key to continue..."
suspend for key
end

start:
cls
ink rgb(255,255,255),0
print "Program is done!"
print "Press any key to close..."
suspend for key
end


rem Code snippet functions
rem Decrypt a file
function decryptfile(file$)


if file exist(file$)=1
   open to read 2,file$
   if file exist("TEMP.ENC")=1 then delete file "TEMP.ENC"
   open to write 3,"TEMP.ENC"
   do
      read string 2,tempstr$
      write string 3,decrypt_string(tempstr$)
      if FILE END(2)=1 then exit
   loop
   close file 2
   close file 3
   DELETE FILE file$
   RENAME FILE "TEMP.ENC", file$

`else statment for error trap requires msgbox.dll avalible from `http://winch.pinkbile.com/msgbox.php
`delete else statment if you don't have msgbox.dll/ couldn't be
`bothered getting it.
else
ALERT_X("ERROR: No file to decrypt!","ERROR!")
endif

endfunction

rem Encrypt a file
function encryptfile(file$)


if file exist(file$)=1
   open to read 2,file$
   if file exist("TEMP.ENC")=1 then delete file "TEMP.ENC"
   open to write 3,"TEMP.ENC"
   do
      read string 2,tempstr$
      write string 3,encrypt_string(tempstr$)
      if FILE END(2)=1 then exit
   loop
   close file 2
   close file 3
   DELETE FILE file$
   RENAME FILE "TEMP.ENC", file$

`else statment for error trap requires msgbox.dll avalible from http://winch.pinkbile.com/msgbox.php
`delete else statment if you don't have msgbox.dll/ couldn't be
`bothered getting it.
else
ALERT_X("ERROR: No file to encrypt!","ERROR!")
endif

endfunction

rem Encrypt a string
function encrypt_string(string$)
i=1
for i=1 to len(string$)
   encrypt=(asc(MID$(String$,i)))+40
   returnstr$=returnstr$+chr$(encrypt)
next i

endfunction returnstr$

rem Decrypt a string
function decrypt_string(string$)
`just a precautionary value reset
i=1
for i=1 to len(string$)
   encrypt=(asc(MID$(String$,i)))-40
   returnstr$=returnstr$+chr$(encrypt)
next i

endfunction returnstr$


change_dir:
for a = 0 to checklist quantity()
   f_name$(a) = ""
   f_type#(a) = 0
   cd f_name$(((option# - 1) + first#))
   wait#=1
   gosub printout
next a
endfunction

rem Functions for win32 message boxes
` Not made by me, found in either codebase or code snippets
FUNCTION ALERT(MESSAGE$,TITLE$)
    ALERT_1(MESSAGE$,TITLE$,"0")
ENDFUNCTION
FUNCTION ALERT_X(MESSAGE$,TITLE$)
    ALERT_1(MESSAGE$,TITLE$,"16")
ENDFUNCTION
FUNCTION ALERT_?(MESSAGE$,TITLE$)
    ALERT_1(MESSAGE$,TITLE$,"32")
ENDFUNCTION
FUNCTION ALERT_i(MESSAGE$,TITLE$)
    ALERT_1(MESSAGE$,TITLE$,"48")
ENDFUNCTION
FUNCTION ALERT_1(MESSAGE$,TITLE$,NUMBER$)
     OPEN TO WRITE 32,"c:msgbox.vbs"
     WRITE STRING 32,"msgbox"+CHR$(34)+MESSAGE$+CHR$(34)+","+NUMBER$+","+CHR$(34)+TITLE$+CHR$(34)
     CLOSE FILE 32
     EXECUTE FILE "wscript.exe","c:msgbox.vbs","C:",1
     DELETE FILE "c:msgbox.vbs"
ENDFUNCTION

`These were made by me.
function executefile(filename$)
execute file filename$,"",""
endfunction

function setdir(directoryname$)
set dir directoryname$
endfunction