home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / QM95REAL.ZIP / SCRIPTS.Z / HOSTDOS.QSC < prev    next >
Text File  |  1995-08-24  |  8KB  |  286 lines
  1. ' DOS Shell
  2. '    x
  3. ' DO NOT COMPILE THIS FILE BY ITSELF!
  4. '
  5. ' This file is a part of the complete HOST.QSC and will not compile
  6. ' alone.  To recompile the host scripts, select Scripts/Compile from
  7. ' the QmodemPro for Windows menu and select HOST.QSC in the "Compile
  8. ' script" dialog box.  This file will automatically be compiled as
  9. ' part of the full script.
  10.  
  11. function MakePrompt(byval prompt as string) as string
  12.   dim res as string, s as string
  13.   do while prompt <> ""
  14.     if left(prompt, 1) = "$" then
  15.       prompt = right(prompt, len(prompt)-1)
  16.       select case OemUpper(left(prompt, 1))
  17.         case "$"
  18.           s = "$"
  19.         case "B"
  20.           s = "|"
  21.         case "D"
  22.           s = date
  23.         case "E"
  24.           s = ESC
  25.         case "G"
  26.           s = ">"
  27.         case "H"
  28.           s = BS+" "+BS
  29.         case "L"
  30.           s = "<"
  31.         case "N"
  32.           s = curdrive
  33.         case "P"
  34.           s = curdir
  35.         case "Q"
  36.           s = "="
  37.         case "T"
  38.           s = time
  39.         case "V"
  40.           s = "version"
  41.         case "_"
  42.           s = CR+LF
  43.         case else
  44.           s = "$" + left(prompt, 1)
  45.       end select
  46.       res = res + s
  47.     else
  48.       res = res + left(prompt, 1)
  49.     end if
  50.     prompt = right(prompt, len(prompt)-1)
  51.   loop
  52.   MakePrompt = res
  53. end function
  54.  
  55. sub DosShellDir(fn as string)
  56.   dim sr as SearchRec
  57.   dim result as integer
  58.   dim i as integer, count as integer
  59.   dim dir as string
  60.   if fn = "" then
  61.     fn = "*.*"
  62.   end if
  63.   dir = JustPathname(fn)
  64.   if len(dir) = 0 then
  65.     dir = AddBackSlash(CurDir)
  66.   else
  67.     dir = AddBackSlash(dir)
  68.   end if
  69.   send #Port,
  70.   send #Port, " Directory of "; dir
  71.   send #Port,
  72.   count = 0
  73.   result = FindFirst(fn, sr)
  74.   if result = 0 then
  75.     do
  76.       if sr.AlternateFileName = "" then
  77.         sr.AlternateFileName = sr.FileName
  78.       end if
  79.       i = instr(sr.Alternatefilename, ".")
  80.       if i > 0 then
  81.         send #Port, left(sr.Alternatefilename, i-1); tab(10); right(sr.Alternatefilename, len(sr.Alternatefilename)-i); tab(14);
  82.       else
  83.         send #Port, sr.Alternatefilename; tab(14);
  84.       end if
  85.       if (sr.fileattributes and 16) <> 0 then
  86.         send #Port, " <DIR>     ";
  87.       else
  88.         send #Port, space(11-len(str(sr.filesize))); sr.filesize;
  89.       end if
  90.       send #Port, FormatDate(" MM-dd-yy", sr.LastWriteTime);
  91.       send #Port, FormatTime(" HH:mmt ", sr.LastWriteTime);
  92.       send #Port, sr.FileName
  93.       count = count + 1
  94.       if count >= 24 then
  95.         if OemUpper(GetLine("-Pause- [C]ontinue, [S]top? ", 1)) = "S" then
  96.           exit do
  97.         end if
  98.         count = 0
  99.       end if
  100.       result = FindNext(sr)
  101.     loop while result = 0
  102.   else
  103.     send #Port, "File not found"
  104.   end if
  105. end sub
  106.  
  107. type buffertype
  108.   data(1024) as byte
  109. end type
  110.  
  111. sub DosShellCopy(src as string, dest as string)
  112.   dim inf as integer, outf as integer
  113.   inf = freefile
  114.   open src for random as #inf len = len(buffertype)
  115.   outf = freefile
  116.   open dest for append as #outf
  117.   close outf
  118.   open dest for random as #outf len = len(buffertype)
  119.   dim buf as buffertype
  120.   dim recs as long
  121.   recs = 0
  122.   do while not eof(inf)
  123.     get #inf, , buf
  124.     put #outf, , buf
  125.     recs = recs + 1
  126.   loop
  127.   close inf
  128.   close outf
  129.   open src for random as #inf len = 1
  130.   open dest for random as #outf len = 1
  131.   seek #inf, (recs - 1) * len(buffertype) + 1
  132.   seek #outf, (recs - 1) * len(buffertype) + 1
  133.   do while not eof(inf)
  134.     get #inf, , buf
  135.     put #outf, , buf
  136.   loop
  137.   close inf
  138.   close outf
  139. end sub
  140.  
  141. sub DosShell
  142.   dim prompt as string, origdir as string
  143.   if User.Level = 0 or Setup.dospass = "" then
  144.     send #Port, "Sorry, drop to DOS not available."
  145.     send #Port,
  146.     exit sub
  147.   end if
  148.   if OemUpper(GetLine("Enter DOS password: ", 0, "", "*")) <> OemUpper(Setup.dospass) then
  149.     send #Port,
  150.     send #Port, "Wrong password entered."
  151.     send #Port,
  152.     exit sub
  153.   end if
  154.   prompt = environ("PROMPT")
  155.   if prompt = "" then
  156.     prompt = "$P$G"
  157.   end if
  158.   origdir = curdir
  159. goagain:
  160.   do
  161.     send #Port,
  162.     dim cmdline as string, cmd as string, arg(10) as string, i as integer
  163.     cmdline = ltrim(rtrim(GetLine(MakePrompt(prompt))))
  164.     cmd = OemUpper(NextField(cmdline, " "))
  165.     for i = 1 to 10
  166.       arg(i) = NextField(cmdline, " ")
  167.     next i
  168.     select case cmd
  169.       case "CD", "CHDIR"
  170.         if arg(1) = "" then
  171.           send #Port, curdir
  172.         else
  173.           chdir arg(1)
  174.         end if
  175.       case "CLS"
  176.         send #Port, chr(27)+"[2H"+chr(27)+"[2J";
  177.         cls
  178.       case "COPY"
  179.         if arg(1) <> "" and arg(2) <> "" then
  180.           if exists(arg(1)) then
  181.             if exists(arg(2)) then
  182.               send #Port, "Destination file "; arg(2); " already exists"
  183.             else
  184.               DosShellCopy arg(1), arg(2)
  185.             end if
  186.           else
  187.             send #Port, "Source file "; arg(1); " does not exist"
  188.           end if
  189.         end if
  190.       case "DATE"
  191.         send #Port, Date
  192.       case "DEL", "ERASE"
  193.         if arg(1) <> "" then
  194.           dim sr as SearchRec
  195.           dim result as integer
  196.           result = findfirst(arg(1), sr)
  197.           do while result = 0
  198.             dim s as string
  199.             s = JustPathname(arg(1))
  200.             if len(s) > 0 then
  201.               del AddBackSlash(s)+sr.filename
  202.             else
  203.               del sr.filename
  204.             end if
  205.             result = findnext(sr)
  206.           loop
  207.           del arg(1) '!! wildcards
  208.         else
  209.           send #Port, "Filename expected"
  210.         end if
  211.       case "DIR"
  212.         DosShellDir(arg(1))
  213.       case "EXIT"
  214.         exit do
  215.       case "HELP"
  216.         if not DisplayFile("hostdos.hlp") then
  217.           send #Port, "No help available"
  218.         end if
  219.       case "MD", "MKDIR"
  220.         if arg(1) <> "" then
  221.           mkdir arg(1)
  222.         else
  223.           send #Port, "Directory expected"
  224.         end if
  225.       case "MOVE"
  226.         if arg(1) <> "" and arg(2) <> "" then
  227.           if exists(arg(1)) then
  228.             if exists(arg(2)) then
  229.               send #Port, "Destination file "; arg(2); " already exists"
  230.             else
  231.               name arg(1) as arg(2)
  232.             end if
  233.           else
  234.             send #Port, "Source file "; arg(1); " does not exist"
  235.           end if
  236.         end if
  237.       case "PROMPT"
  238.         if arg(1) = "" then
  239.           send #Port, prompt
  240.         else
  241.           prompt = arg(1)
  242.         end if
  243.       case "RD", "RMDIR"
  244.         if arg(1) <> "" then
  245.           rmdir arg(1)
  246.         else
  247.           send #Port, "Directory expected"
  248.         end if
  249.       case "REN", "RENAME"
  250.         if arg(1) <> "" and arg(2) <> "" then
  251.           name arg(1) as arg(2)
  252.         else
  253.           send #Port, "Two filenames expected"
  254.         end if
  255.       case "TIME"
  256.         send #Port, Time
  257.       case "TYPE"
  258.         if arg(1) <> "" then
  259.           DisplayFile arg(1)
  260.         else
  261.           send #Port, "Filename expected"
  262.         end if
  263.       case "VER"
  264.         send #Port, "QmodemPro for Windows "; version; " DOS shell"
  265.       case is <> ""
  266.         if len(cmd) = 2 and right(cmd, 1) = ":" then
  267.           chdrive left(cmd, 1)
  268.         else
  269.           send #Port, "Bad command or file name"
  270.         end if
  271.     end select
  272.   loop until CallerHungUp
  273.   chdrive origdir
  274.   chdir origdir
  275.  
  276. catch err_fileopen
  277.   send #Port, "Error opening file"
  278.   goto goagain
  279. catch err_path
  280.   send #Port, "Error in directory"
  281.   goto goagain
  282. catch err_filerename
  283.   send #Port, "Error renaming file"
  284.   goto goagain
  285. end sub
  286.