home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / MODEM / HOST1.ZIP / HOSTDOS.SCR < prev    next >
Text File  |  1994-02-27  |  9KB  |  346 lines
  1. ' DOS Shell
  2.  
  3. function MakePrompt(prompt as string) as string
  4.   dim res as string, s as string
  5.   do while prompt <> ""
  6.     if left(prompt, 1) = "$" then
  7.       prompt = right(prompt, len(prompt)-1)
  8.       select case OemUpper(left(prompt, 1))
  9.         case "$"
  10.           s = "$"
  11.         case "B"
  12.           s = "|"
  13.         case "D"
  14.           s = date
  15.         case "E"
  16.           s = ESC
  17.         case "G"
  18.           s = ">"
  19.         case "H"
  20.           s = BS+" "+BS
  21.         case "L"
  22.           s = "<"
  23.         case "N"
  24.           s = curdrive
  25.         case "P"
  26.           s = curdir
  27.         case "Q"
  28.           s = "="
  29.         case "T"
  30.           s = time
  31.         case "V"
  32.           s = "version"
  33.         case "_"
  34.           s = CR+LF
  35.         case else
  36.           s = "$" + left(prompt, 1)
  37.       end select
  38.       res = res + s
  39.     else
  40.       res = res + left(prompt, 1)
  41.     end if
  42.     prompt = right(prompt, len(prompt)-1)
  43.   loop
  44.   MakePrompt = res
  45. end function
  46.  
  47. sub DosShellDir(fn as string)
  48.   dim sr as SearchRec
  49.   dim result as integer
  50.   dim i as integer, count as integer
  51.   dim dir as string
  52.   if fn = "" then
  53.     fn = "*.*"
  54.   end if
  55.   dir = JustPathname(fn)
  56.   if len(dir) = 0 then
  57.     dir = AddBackSlash(CurDir)
  58.   else
  59.     dir = AddBackSlash(dir)
  60.   end if
  61.   send #Port,
  62.   send #Port, " Volume in drive "; CurDrive;
  63.   result = FindFirst("\*.*", 8, sr)
  64.   if result = 0 then
  65.     send #Port, " is ", sr.name
  66.   else
  67.     send #Port, " has no label"
  68.   end if
  69.   send #Port, " Directory of "; dir
  70.   send #Port,
  71.   count = 0
  72.   result = FindFirst(fn, 16, sr)
  73.   if result = 0 then
  74.     do
  75.       i = instr(sr.name, ".")
  76.       if i > 0 then
  77.         send #Port, left(sr.name, i-1); tab(10); right(sr.name, len(sr.name)-i); tab(14);
  78.       else
  79.         send #Port, sr.name; tab(14);
  80.       end if
  81.       if (sr.attribute and 16) <> 0 then
  82.         send #Port, " <DIR>     ";
  83.       else
  84.         send #Port, space(11-len(str(sr.size))); sr.size;
  85.       end if
  86.       send #Port, DateToDateString(" mm-dd-yy", DMYtoDate(sr.date and 0x1f, (sr.date\32) and 0xf, 1980+(sr.date\512)));
  87.       send #Port, TimeToTimeString(" HH:mmt", HMStoTime(sr.time\2048, (sr.time\32) and 0x3f, (sr.time and 0x1f) * 2));
  88.       send #Port,
  89.       count = count + 1
  90.       if count >= 24 then
  91.         if OemUpper(GetLine("-Pause- [C]ontinue, [S]top? ", 1)) = "S" then
  92.           exit do
  93.         end if
  94.         count = 0
  95.       end if
  96.       result = FindNext(sr)
  97.     loop while result = 0
  98.   else
  99.     send #Port, "File not found"
  100.   end if
  101. end sub
  102.  
  103. type buffertype
  104.   data(1024) as byte
  105. end type
  106.  
  107. sub DosShellCopy(src as string, dest as string)
  108.   dim inf as integer, outf as integer
  109.   inf = freefile
  110.   open src for random as #inf len = len(buffertype)
  111.   outf = freefile
  112.   open dest for append as #outf len = len(buffertype)
  113.   close outf
  114.   open dest for random as #outf len = len(buffertype)
  115.   dim buf as buffertype
  116.   dim recs as long
  117.   recs = 0
  118.   do while not eof(inf)
  119.     get #inf, , buf
  120.     put #outf, , buf
  121.     recs = recs + 1
  122.   loop
  123.   close inf
  124.   close outf
  125.   open src for random as #inf len = 1
  126.   open dest for random as #outf len = 1
  127.   seek #inf, (recs - 1) * len(buffertype) + 1
  128.   do while not eof(inf)
  129.     get #inf, , buf
  130.     put #outf, , buf
  131.   loop
  132.   close inf
  133.   close outf
  134. end sub
  135.  
  136. sub ChangeDir
  137.   dim prompt as string
  138.   if User.Level = 0 or Setup.Sysopanypath = 0 then
  139.     send #Port, "Sorry, Changing directory not available at this access level."
  140.     send #Port, "Leave a MSG to the Sysop if this option is desired."
  141.     send #Port,
  142.     exit sub
  143.   end if
  144.   prompt = environ("PROMPT")
  145.   if prompt = "" then
  146.     prompt = "$P$G"
  147.   end if
  148.   send #Port, "Put a space between CD and \ when making a directory change."
  149.   send #Port, "Current directory is:"
  150. goagain:
  151.   do
  152.     send #Port,
  153.     dim cmdline as string, cmd as string, arg(10) as string, i as integer
  154.     cmdline = ltrim(rtrim(getLine(MakePrompt((prompt)))))
  155.     cmd = OemUpper(NextField(cmdline, " "))
  156.     for i = 1 to 10
  157.       arg(i) = NextField(cmdline, " ")
  158.     next i
  159.     select case cmd
  160.       case "CD", "CHDIR"
  161.          if arg(1) = "" then
  162.             send #Port, curdir
  163.          else
  164.             chdir arg(1)
  165.          end if
  166.       case "DIR"
  167.            DosShellDir(arg(1))
  168.       case "EXIT"
  169.          exit do
  170.       case "A:"
  171.              send #Port, "Floppy drive A cannot be accessed."
  172.       case "B:"
  173.              send #Port, "Floppy drive B cannot be accessed."
  174.       case is <> ""
  175.          if len(cmd) = 2 and right(cmd, 1) = ":" then
  176.              chdrive left(cmd, 1)
  177.              send #Port, "Current directory is:"
  178.              send #Port, curdir
  179.          else
  180.              send #Port, "Change drive using C: or D: etc."
  181.              send #Port, "Put a space between CD and \ when making a directory change."
  182.          end if
  183.       case ""
  184.           exit do
  185.    end select
  186.   loop until CallerHungUp
  187. catch err_path
  188.    send #Port, "Error in directory"
  189.    goto goagain
  190. end sub
  191.  
  192. sub DosShell
  193.   dim prompt as string, origdir as string, z as string
  194.   z = setup.dlpath
  195.   if User.Level = 0 or Setup.dospass = "" then
  196.     send #Port, "Sorry, drop to DOS not available at this access level."
  197.     send #Port,
  198.     exit sub
  199.   end if
  200.   if OemUpper(GetLine("Enter DOS password: ", 0, "", "*")) <> OemUpper(Setup.dospass) then
  201.     send #Port,
  202.     send #Port, "Wrong password entered."
  203.     send #Port,
  204.     exit sub
  205.   end if
  206.   chdir z
  207.   prompt = environ("PROMPT")
  208.   if prompt = "" then
  209.     prompt = "$P$G"
  210.   end if
  211.   origdir = z
  212. goagain:
  213.   do
  214.     send #Port,
  215.     dim cmdline as string, cmd as string, arg(10) as string, i as integer
  216.     cmdline = ltrim(rtrim(GetLine(MakePrompt((prompt)))))
  217.     cmd = OemUpper(NextField(cmdline, " "))
  218.     for i = 1 to 10
  219.       arg(i) = NextField(cmdline, " ")
  220.     next i
  221.     select case cmd
  222.       case "CD", "CHDIR"
  223.         if arg(1) = "" then
  224.           send #Port, curdir
  225.         else
  226.           chdir arg(1)
  227.         end if
  228.       case "CLS"
  229.         send #Port, chr(27)+"[2H"+chr(27)+"[2J";
  230.         cls
  231.       case "COPY"
  232.         if arg(1) <> "" and arg(2) <> "" then
  233.           if exists(arg(1)) then
  234.             if exists(arg(2)) then
  235.               send #Port, "Destination file "; arg(2); " already exists"
  236.             else
  237.               DosShellCopy arg(1), arg(2)
  238.             end if
  239.           else
  240.             send #Port, "Source file "; arg(1); " does not exist"
  241.           end if
  242.         end if
  243.       case "DATE"
  244.         send #Port, Date
  245.       case "DEL", "ERASE"
  246.         if arg(1) <> "" then
  247.           dim sr as SearchRec
  248.           dim result as integer
  249.           result = findfirst(arg(1), 0, sr)
  250.           do while result = 0
  251.             dim s as string
  252.             s = JustPathname(arg(1))
  253.             if len(s) > 0 then
  254.               del AddBackSlash(s)+sr.name
  255.             else
  256.               del sr.name
  257.             end if
  258.             result = findnext(sr)
  259.           loop
  260.           del arg(1) '!! wildcards
  261.         else
  262.           send #Port, "Filename expected"
  263.         end if
  264.       case "DIR"
  265.         DosShellDir(arg(1))
  266.       case "EXIT"
  267.         exit do
  268.       case "HELP"
  269.         if not DisplayFile("hostdos.hlp") then
  270.           send #Port, "No help available"
  271.         end if
  272.       case "MD", "MKDIR"
  273.         if arg(1) <> "" then
  274.           mkdir arg(1)
  275.         else
  276.           send #Port, "Directory expected"
  277.         end if
  278.       case "MOVE"
  279.         if arg(1) <> "" and arg(2) <> "" then
  280.           if exists(arg(1)) then
  281.             if exists(arg(2)) then
  282.               send #Port, "Destination file "; arg(2); " already exists"
  283.             else
  284.               name arg(1) as arg(2)
  285.             end if
  286.           else
  287.             send #Port, "Source file "; arg(1); " does not exist"
  288.           end if
  289.         end if
  290.       case "PROMPT"
  291.         if arg(1) = "" then
  292.           send #Port, prompt
  293.         else
  294.           prompt = arg(1)
  295.         end if
  296.       case "RD", "RMDIR"
  297.         if arg(1) <> "" then
  298.           rmdir arg(1)
  299.         else
  300.           send #Port, "Directory expected"
  301.         end if
  302.       case "REN", "RENAME"
  303.         if arg(1) <> "" and arg(2) <> "" then
  304.           name arg(1) as arg(2)
  305.         else
  306.           send #Port, "Two filenames expected"
  307.         end if
  308.       case "TIME"
  309.         send #Port, Time
  310.       case "TYPE"
  311.         if arg(1) <> "" then
  312.           DisplayFile arg(1)
  313.         else
  314.           send #Port, "Filename expected"
  315.         end if
  316.       case "VER"
  317.         send #Port, "QmodemPro for Windows "; version; " DOS shell"
  318.       case is <> ""
  319.         if len(cmd) = 2 and right(cmd, 1) = ":" then
  320.           chdrive left(cmd, 1)
  321.         else
  322.           send #Port, "Bad command or file name"
  323.         end if
  324.     end select
  325.   loop until CallerHungUp
  326.   chdrive origdir
  327.   chdir origdir
  328.  
  329. catch err_fileopen
  330.   send #Port, "Error opening file"
  331.   goto goagain
  332. catch err_path
  333.   send #Port, "Error in directory"
  334.   goto goagain
  335. catch err_filerename
  336.   send #Port, "Error renaming file"
  337.   goto goagain
  338. end sub
  339.  
  340.  
  341.  
  342.  
  343.  
  344.  
  345.  
  346.