home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / DOSSHELL.ZIP / DOSSHELL.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1993-01-04  |  6.0 KB  |  178 lines
  1. { A bit wordy - but easy to include in an application - three "hooks" in }
  2. { the form of the first three internal procedures to customize the code. }
  3. { NOTE! MaxHeap must be limited to allow the EXEC procedure to function. }
  4. { By Carl York with code by Neil J. Rubenking and Richard S. Sandowsky.  }
  5.  
  6. UNIT DOSShell;
  7.  
  8. INTERFACE
  9. procedure ShellToDOS;
  10.  
  11. IMPLEMENTATION
  12. USES CRT, DOS;
  13.  
  14. procedure ShellToDOS;
  15. const
  16.   SmallestAllowableRam = 5;                   { Set   }
  17.   Normal               = 7;                   { to    }
  18.   Reverse              = 112;                 { your  }
  19.   ApplicationName      = 'MY OWN PROGRAM';    { specs }
  20. var
  21.   ProgramName,
  22.   CmdLineParam,
  23.   NewDirect,
  24.   HoldDirect     : PathStr;
  25.   HoldAttr       : byte;
  26.   HoldMin,
  27.   HoldMax        : word;
  28.   SlashSpot,
  29.   BlankSpot      : byte;
  30.  
  31. {+++++++++++++++++++++++++++++++}
  32. procedure PrintMessage;
  33. begin
  34.   { Clever message to make your end user feel foolish }
  35. end;
  36. {-------------------------------}
  37.  
  38. {++++++++++++++++++++++}
  39. procedure SwapScreenOut;
  40. begin
  41.   { Whatever routine you want to use to    }
  42.   { save the contents on the active screen }
  43. end;
  44. {---------}
  45.  
  46. {++++++++++++++++++++++}
  47. procedure SwapScreenIn;
  48. begin
  49.   { Whatever routine you want to use to }
  50.   { restore the contents on the screen  }
  51. end;
  52. {---------}
  53.  
  54. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  55. function GetProgramToRun : PathStr;
  56. { Courtesy of Neil Rubenking, this code duplicates the way DOS normally }
  57. { searches the path for a file name typed in at the DOS level using the }
  58. { TP5 routines FSearch and FExpand (code published PC Magazine 1/17/89) }
  59. var
  60.   Name : PathStr;
  61. begin
  62.   Name := FSearch(ProgramName + '.COM','');          { Search    }
  63.   If Name = '' then                                  { the       }
  64.     Name := FSearch(ProgramName + '.EXE','');        { active    }
  65.   If Name = '' then                                  { drive/    }
  66.     Name := FSearch(ProgramName + '.BAT','');        { directory }
  67.   If Name = '' then
  68.     Name := FSearch(ProgramName + '.COM',GetEnv('PATH'));
  69.   If Name = '' then                                          { Search }
  70.     Name := FSearch(ProgramName + '.EXE',GetEnv('PATH'));    { the    }
  71.   If Name = '' then                                          { path   }
  72.     Name := FSearch(ProgramName + '.BAT',GetEnv('PATH'));
  73.   If Name <> '' then
  74.     Name := FExpand(Name);
  75.   GetProgramToRun := Name;
  76. end;
  77. {------------------------------------------------------------------------}
  78.  
  79. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  80. function RAMFreeInK : Word;
  81. { A tidy little chunk of Inline code from Rich Sandowsky }
  82. Inline(
  83.   $B8/$00/$48/           {  mov   AX,$4800  ; set for DOS function 48h}
  84.   $BB/$FF/$FF/           {  mov   BX,$FFFF  ; try to allocate more RAM}
  85.                          {                  ; than is possible}
  86.   $CD/$21/               {  int   $21       ; execute the DOS call}
  87.   $B1/$06/               {  mov   CL,6      ;}
  88.   $D3/$EB/               {  shr   BX,CL     ; convert to 1K blocks}
  89.   $89/$D8);              {  mov   AX,BX     ; return number of 1K blocks}
  90.                          {                  ; RAM free as function result}
  91. {------------------------------------------------------------------------}
  92.  
  93. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  94. procedure WritePrompt;
  95. { Create a DOS prompt for the user }
  96. begin
  97.   TextAttr := Normal;
  98.   Write('Temporarily in DOS (',RAMFreeInK,'K available) ... Type ');
  99.   TextAttr := Reverse;
  100.   Write('EXIT');
  101.   TextAttr := Normal;
  102.   WriteLn(' to return to ',ApplicationName);
  103.   Write(NewDirect,'>');
  104. end;
  105. {------------------------------------------------------------------------}
  106.  
  107. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  108. procedure RunTheShell;
  109. { The actual use of the EXEC procedure }
  110. var
  111.   Index : integer;
  112. begin
  113.   GetDir(0,NewDirect);
  114.   WritePrompt;
  115.   CmdLineParam := '';
  116.   ReadLn(ProgramName);
  117.   For Index := 1 to length(ProgramName) do
  118.     ProgramName[index] := Upcase(ProgramName[Index]);
  119.   While ProgramName[length(ProgramName)] = #32 do
  120.     Dec(ProgramName[0]);
  121.   While (length(ProgramName) > 0) and (ProgramName[1] = #32) do
  122.     Delete(ProgramName,1,1);
  123.   If (ProgramName <> 'EXIT') then
  124.     begin
  125.       EXEC(GetEnv('COMSPEC'),'/C '+ ProgramName + CmdLineParam);
  126.       { Brute force to see if we need to pursue any further }
  127.       If Lo(DOSExitCode) <> 0 then
  128.         begin
  129.           BlankSpot := pos(' ',ProgramName);
  130.           SlashSpot := pos('/',ProgramName);
  131.           If SlashSpot > 0 then
  132.             If (SlashSpot < BlankSpot) or (BlankSpot = 0) then
  133.               BlankSpot := SlashSpot;
  134.           If BlankSpot > 0 then
  135.             begin
  136.               CmdLineParam := copy(ProgramName,BlankSpot,Length(ProgramName));
  137.               ProgramName[0] := Chr(pred(BlankSpot));
  138.             end;
  139.           ProgramName := GetProgramToRun;
  140.           If ProgramName <> '' then
  141.             If pos('.BAT',ProgramName) > 0 then
  142.               EXEC(GetEnv('COMSPEC'),'/C '+ ProgramName + CmdLineParam)
  143.             else EXEC(ProgramName,CmdLineParam);
  144.         end;
  145.     end;
  146.   WriteLn;
  147. end;
  148. {------------------------------------------------------------------------}
  149.  
  150. {=================================}
  151. begin
  152.   If RamFreeInK <= SmallestAllowableRam then
  153.     begin
  154.       PrintMessage;
  155.       EXIT;
  156.     end;
  157.   HoldAttr := TextAttr;           { Grab the current video attribute }
  158.   GetDir(0,HoldDirect);           { Grab the current drive/path }
  159.   HoldMin := WindMin;
  160.   HoldMax := WindMax;             { And the current window }
  161.   TextAttr := Normal;
  162.   SwapScreenOut;
  163.   Window(1,1,80,25);
  164.   ClrScr;
  165.   SwapVectors;
  166.   Repeat
  167.     RunTheShell;
  168.   Until ProgramName = 'EXIT';
  169.   SwapVectors;                      { Restore all the original set up }
  170.   ChDir(HoldDirect);
  171.   TextAttr := HoldAttr;
  172.   Window(Lo(HoldMin),Hi(HoldMin),Lo(HoldMax),Hi(HoldMax));
  173.   ClrScr;
  174.   SwapScreenIn;
  175. end;
  176.  
  177. END.
  178.