home *** CD-ROM | disk | FTP | other *** search
/ Chip: Windows 95 / WIN95_CD.ISO / sharewar / internet / qmodem / scripts.z / HOSTDOS.QSC < prev    next >
Encoding:
Text File  |  1995-07-20  |  7.3 KB  |  283 lines
  1. ' DOS Shell
  2. '
  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.       i = instr(sr.filename, ".")
  77.       if i > 0 then
  78.         send #Port, left(sr.filename, i-1); tab(10); right(sr.filename, len(sr.filename)-i); tab(14);
  79.       else
  80.         send #Port, sr.filename; tab(14);
  81.       end if
  82.       if (sr.fileattributes and 16) <> 0 then
  83.         send #Port, " <DIR>     ";
  84.       else
  85.         send #Port, space(11-len(str(sr.filesize))); sr.filesize;
  86.       end if
  87.       send #Port, FormatDate(" mm-dd-yy", sr.LastWriteTime);
  88.       send #Port, FormatTime(" HH:mmt", sr.LastWriteTime);
  89.       send #Port,
  90.       count = count + 1
  91.       if count >= 24 then
  92.         if OemUpper(GetLine("-Pause- [C]ontinue, [S]top? ", 1)) = "S" then
  93.           exit do
  94.         end if
  95.         count = 0
  96.       end if
  97.       result = FindNext(sr)
  98.     loop while result = 0
  99.   else
  100.     send #Port, "File not found"
  101.   end if
  102. end sub
  103.  
  104. type buffertype
  105.   data(1024) as byte
  106. end type
  107.  
  108. sub DosShellCopy(src as string, dest as string)
  109.   dim inf as integer, outf as integer
  110.   inf = freefile
  111.   open src for random as #inf len = len(buffertype)
  112.   outf = freefile
  113.   open dest for append as #outf
  114.   close outf
  115.   open dest for random as #outf len = len(buffertype)
  116.   dim buf as buffertype
  117.   dim recs as long
  118.   recs = 0
  119.   do while not eof(inf)
  120.     get #inf, , buf
  121.     put #outf, , buf
  122.     recs = recs + 1
  123.   loop
  124.   close inf
  125.   close outf
  126.   open src for random as #inf len = 1
  127.   open dest for random as #outf len = 1
  128.   seek #inf, (recs - 1) * len(buffertype) + 1
  129.   seek #outf, (recs - 1) * len(buffertype) + 1
  130.   do while not eof(inf)
  131.     get #inf, , buf
  132.     put #outf, , buf
  133.   loop
  134.   close inf
  135.   close outf
  136. end sub
  137.  
  138. sub DosShell
  139.   dim prompt as string, origdir as string
  140.   if User.Level = 0 or Setup.dospass = "" then
  141.     send #Port, "Sorry, drop to DOS not available."
  142.     send #Port,
  143.     exit sub
  144.   end if
  145.   if OemUpper(GetLine("Enter DOS password: ", 0, "", "*")) <> OemUpper(Setup.dospass) then
  146.     send #Port,
  147.     send #Port, "Wrong password entered."
  148.     send #Port,
  149.     exit sub
  150.   end if
  151.   prompt = environ("PROMPT")
  152.   if prompt = "" then
  153.     prompt = "$P$G"
  154.   end if
  155.   origdir = curdir
  156. goagain:
  157.   do
  158.     send #Port,
  159.     dim cmdline as string, cmd as string, arg(10) as string, i as integer
  160.     cmdline = ltrim(rtrim(GetLine(MakePrompt(prompt))))
  161.     cmd = OemUpper(NextField(cmdline, " "))
  162.     for i = 1 to 10
  163.       arg(i) = NextField(cmdline, " ")
  164.     next i
  165.     select case cmd
  166.       case "CD", "CHDIR"
  167.         if arg(1) = "" then
  168.           send #Port, curdir
  169.         else
  170.           chdir arg(1)
  171.         end if
  172.       case "CLS"
  173.         send #Port, chr(27)+"[2H"+chr(27)+"[2J";
  174.         cls
  175.       case "COPY"
  176.         if arg(1) <> "" and arg(2) <> "" then
  177.           if exists(arg(1)) then
  178.             if exists(arg(2)) then
  179.               send #Port, "Destination file "; arg(2); " already exists"
  180.             else
  181.               DosShellCopy arg(1), arg(2)
  182.             end if
  183.           else
  184.             send #Port, "Source file "; arg(1); " does not exist"
  185.           end if
  186.         end if
  187.       case "DATE"
  188.         send #Port, Date
  189.       case "DEL", "ERASE"
  190.         if arg(1) <> "" then
  191.           dim sr as SearchRec
  192.           dim result as integer
  193.           result = findfirst(arg(1), sr)
  194.           do while result = 0
  195.             dim s as string
  196.             s = JustPathname(arg(1))
  197.             if len(s) > 0 then
  198.               del AddBackSlash(s)+sr.filename
  199.             else
  200.               del sr.filename
  201.             end if
  202.             result = findnext(sr)
  203.           loop
  204.           del arg(1) '!! wildcards
  205.         else
  206.           send #Port, "Filename expected"
  207.         end if
  208.       case "DIR"
  209.         DosShellDir(arg(1))
  210.       case "EXIT"
  211.         exit do
  212.       case "HELP"
  213.         if not DisplayFile("hostdos.hlp") then
  214.           send #Port, "No help available"
  215.         end if
  216.       case "MD", "MKDIR"
  217.         if arg(1) <> "" then
  218.           mkdir arg(1)
  219.         else
  220.           send #Port, "Directory expected"
  221.         end if
  222.       case "MOVE"
  223.         if arg(1) <> "" and arg(2) <> "" then
  224.           if exists(arg(1)) then
  225.             if exists(arg(2)) then
  226.               send #Port, "Destination file "; arg(2); " already exists"
  227.             else
  228.               name arg(1) as arg(2)
  229.             end if
  230.           else
  231.             send #Port, "Source file "; arg(1); " does not exist"
  232.           end if
  233.         end if
  234.       case "PROMPT"
  235.         if arg(1) = "" then
  236.           send #Port, prompt
  237.         else
  238.           prompt = arg(1)
  239.         end if
  240.       case "RD", "RMDIR"
  241.         if arg(1) <> "" then
  242.           rmdir arg(1)
  243.         else
  244.           send #Port, "Directory expected"
  245.         end if
  246.       case "REN", "RENAME"
  247.         if arg(1) <> "" and arg(2) <> "" then
  248.           name arg(1) as arg(2)
  249.         else
  250.           send #Port, "Two filenames expected"
  251.         end if
  252.       case "TIME"
  253.         send #Port, Time
  254.       case "TYPE"
  255.         if arg(1) <> "" then
  256.           DisplayFile arg(1)
  257.         else
  258.           send #Port, "Filename expected"
  259.         end if
  260.       case "VER"
  261.         send #Port, "QmodemPro for Windows "; version; " DOS shell"
  262.       case is <> ""
  263.         if len(cmd) = 2 and right(cmd, 1) = ":" then
  264.           chdrive left(cmd, 1)
  265.         else
  266.           send #Port, "Bad command or file name"
  267.         end if
  268.     end select
  269.   loop until CallerHungUp
  270.   chdrive origdir
  271.   chdir origdir
  272.  
  273. catch err_fileopen
  274.   send #Port, "Error opening file"
  275.   goto goagain
  276. catch err_path
  277.   send #Port, "Error in directory"
  278.   goto goagain
  279. catch err_filerename
  280.   send #Port, "Error renaming file"
  281.   goto goagain
  282. end sub
  283.