home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1994 #1
/
monster.zip
/
monster
/
MODEM
/
HOST1.ZIP
/
HOSTDOS.SCR
< prev
next >
Wrap
Text File
|
1994-02-27
|
9KB
|
346 lines
' DOS Shell
function MakePrompt(prompt as string) as string
dim res as string, s as string
do while prompt <> ""
if left(prompt, 1) = "$" then
prompt = right(prompt, len(prompt)-1)
select case OemUpper(left(prompt, 1))
case "$"
s = "$"
case "B"
s = "|"
case "D"
s = date
case "E"
s = ESC
case "G"
s = ">"
case "H"
s = BS+" "+BS
case "L"
s = "<"
case "N"
s = curdrive
case "P"
s = curdir
case "Q"
s = "="
case "T"
s = time
case "V"
s = "version"
case "_"
s = CR+LF
case else
s = "$" + left(prompt, 1)
end select
res = res + s
else
res = res + left(prompt, 1)
end if
prompt = right(prompt, len(prompt)-1)
loop
MakePrompt = res
end function
sub DosShellDir(fn as string)
dim sr as SearchRec
dim result as integer
dim i as integer, count as integer
dim dir as string
if fn = "" then
fn = "*.*"
end if
dir = JustPathname(fn)
if len(dir) = 0 then
dir = AddBackSlash(CurDir)
else
dir = AddBackSlash(dir)
end if
send #Port,
send #Port, " Volume in drive "; CurDrive;
result = FindFirst("\*.*", 8, sr)
if result = 0 then
send #Port, " is ", sr.name
else
send #Port, " has no label"
end if
send #Port, " Directory of "; dir
send #Port,
count = 0
result = FindFirst(fn, 16, sr)
if result = 0 then
do
i = instr(sr.name, ".")
if i > 0 then
send #Port, left(sr.name, i-1); tab(10); right(sr.name, len(sr.name)-i); tab(14);
else
send #Port, sr.name; tab(14);
end if
if (sr.attribute and 16) <> 0 then
send #Port, " <DIR> ";
else
send #Port, space(11-len(str(sr.size))); sr.size;
end if
send #Port, DateToDateString(" mm-dd-yy", DMYtoDate(sr.date and 0x1f, (sr.date\32) and 0xf, 1980+(sr.date\512)));
send #Port, TimeToTimeString(" HH:mmt", HMStoTime(sr.time\2048, (sr.time\32) and 0x3f, (sr.time and 0x1f) * 2));
send #Port,
count = count + 1
if count >= 24 then
if OemUpper(GetLine("-Pause- [C]ontinue, [S]top? ", 1)) = "S" then
exit do
end if
count = 0
end if
result = FindNext(sr)
loop while result = 0
else
send #Port, "File not found"
end if
end sub
type buffertype
data(1024) as byte
end type
sub DosShellCopy(src as string, dest as string)
dim inf as integer, outf as integer
inf = freefile
open src for random as #inf len = len(buffertype)
outf = freefile
open dest for append as #outf len = len(buffertype)
close outf
open dest for random as #outf len = len(buffertype)
dim buf as buffertype
dim recs as long
recs = 0
do while not eof(inf)
get #inf, , buf
put #outf, , buf
recs = recs + 1
loop
close inf
close outf
open src for random as #inf len = 1
open dest for random as #outf len = 1
seek #inf, (recs - 1) * len(buffertype) + 1
do while not eof(inf)
get #inf, , buf
put #outf, , buf
loop
close inf
close outf
end sub
sub ChangeDir
dim prompt as string
if User.Level = 0 or Setup.Sysopanypath = 0 then
send #Port, "Sorry, Changing directory not available at this access level."
send #Port, "Leave a MSG to the Sysop if this option is desired."
send #Port,
exit sub
end if
prompt = environ("PROMPT")
if prompt = "" then
prompt = "$P$G"
end if
send #Port, "Put a space between CD and \ when making a directory change."
send #Port, "Current directory is:"
goagain:
do
send #Port,
dim cmdline as string, cmd as string, arg(10) as string, i as integer
cmdline = ltrim(rtrim(getLine(MakePrompt((prompt)))))
cmd = OemUpper(NextField(cmdline, " "))
for i = 1 to 10
arg(i) = NextField(cmdline, " ")
next i
select case cmd
case "CD", "CHDIR"
if arg(1) = "" then
send #Port, curdir
else
chdir arg(1)
end if
case "DIR"
DosShellDir(arg(1))
case "EXIT"
exit do
case "A:"
send #Port, "Floppy drive A cannot be accessed."
case "B:"
send #Port, "Floppy drive B cannot be accessed."
case is <> ""
if len(cmd) = 2 and right(cmd, 1) = ":" then
chdrive left(cmd, 1)
send #Port, "Current directory is:"
send #Port, curdir
else
send #Port, "Change drive using C: or D: etc."
send #Port, "Put a space between CD and \ when making a directory change."
end if
case ""
exit do
end select
loop until CallerHungUp
catch err_path
send #Port, "Error in directory"
goto goagain
end sub
sub DosShell
dim prompt as string, origdir as string, z as string
z = setup.dlpath
if User.Level = 0 or Setup.dospass = "" then
send #Port, "Sorry, drop to DOS not available at this access level."
send #Port,
exit sub
end if
if OemUpper(GetLine("Enter DOS password: ", 0, "", "*")) <> OemUpper(Setup.dospass) then
send #Port,
send #Port, "Wrong password entered."
send #Port,
exit sub
end if
chdir z
prompt = environ("PROMPT")
if prompt = "" then
prompt = "$P$G"
end if
origdir = z
goagain:
do
send #Port,
dim cmdline as string, cmd as string, arg(10) as string, i as integer
cmdline = ltrim(rtrim(GetLine(MakePrompt((prompt)))))
cmd = OemUpper(NextField(cmdline, " "))
for i = 1 to 10
arg(i) = NextField(cmdline, " ")
next i
select case cmd
case "CD", "CHDIR"
if arg(1) = "" then
send #Port, curdir
else
chdir arg(1)
end if
case "CLS"
send #Port, chr(27)+"[2H"+chr(27)+"[2J";
cls
case "COPY"
if arg(1) <> "" and arg(2) <> "" then
if exists(arg(1)) then
if exists(arg(2)) then
send #Port, "Destination file "; arg(2); " already exists"
else
DosShellCopy arg(1), arg(2)
end if
else
send #Port, "Source file "; arg(1); " does not exist"
end if
end if
case "DATE"
send #Port, Date
case "DEL", "ERASE"
if arg(1) <> "" then
dim sr as SearchRec
dim result as integer
result = findfirst(arg(1), 0, sr)
do while result = 0
dim s as string
s = JustPathname(arg(1))
if len(s) > 0 then
del AddBackSlash(s)+sr.name
else
del sr.name
end if
result = findnext(sr)
loop
del arg(1) '!! wildcards
else
send #Port, "Filename expected"
end if
case "DIR"
DosShellDir(arg(1))
case "EXIT"
exit do
case "HELP"
if not DisplayFile("hostdos.hlp") then
send #Port, "No help available"
end if
case "MD", "MKDIR"
if arg(1) <> "" then
mkdir arg(1)
else
send #Port, "Directory expected"
end if
case "MOVE"
if arg(1) <> "" and arg(2) <> "" then
if exists(arg(1)) then
if exists(arg(2)) then
send #Port, "Destination file "; arg(2); " already exists"
else
name arg(1) as arg(2)
end if
else
send #Port, "Source file "; arg(1); " does not exist"
end if
end if
case "PROMPT"
if arg(1) = "" then
send #Port, prompt
else
prompt = arg(1)
end if
case "RD", "RMDIR"
if arg(1) <> "" then
rmdir arg(1)
else
send #Port, "Directory expected"
end if
case "REN", "RENAME"
if arg(1) <> "" and arg(2) <> "" then
name arg(1) as arg(2)
else
send #Port, "Two filenames expected"
end if
case "TIME"
send #Port, Time
case "TYPE"
if arg(1) <> "" then
DisplayFile arg(1)
else
send #Port, "Filename expected"
end if
case "VER"
send #Port, "QmodemPro for Windows "; version; " DOS shell"
case is <> ""
if len(cmd) = 2 and right(cmd, 1) = ":" then
chdrive left(cmd, 1)
else
send #Port, "Bad command or file name"
end if
end select
loop until CallerHungUp
chdrive origdir
chdir origdir
catch err_fileopen
send #Port, "Error opening file"
goto goagain
catch err_path
send #Port, "Error in directory"
goto goagain
catch err_filerename
send #Port, "Error renaming file"
goto goagain
end sub