home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MADTRB15.ZIP / DOSRUN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-01-22  |  7.5 KB  |  234 lines
  1. (*$V-,R-*)
  2. PROGRAM DosRun; {This is the PibDoDos.pas program altered to include a menu
  3.                 procedure and with most of the long blocks of comments
  4.                 removed, in order to better see the code.  I have found that
  5.                 this system works quite well, but does hang for one interation
  6.                 when the child program ends other than normally.  I have not
  7.                 implemented any checking of the error code returned by the
  8.                 external program TURBORUN.COM, which this program demonstrates.
  9.                 Stephen C. McGough, for the Turbo Pascal SIG, Madison IBM PC
  10.                 User Group.}
  11.  
  12.  
  13. {$I MENUMOD.INC}    {This is a set of routines which I took from the file }
  14.                     {"TURBUTIL.PAS"; it supplies a highlighted menu, which
  15.                     returns an integer representing the selection.  The use
  16.                     of the menu system is described below. -SCM}
  17.  
  18.  
  19. CONST
  20.    NUL = #00                       (* Terminator for DOS Ascii z-strings *);
  21.  
  22. TYPE
  23.    AnyStr     = STRING[255];
  24.    Char_Array = ARRAY[1..1] OF CHAR;
  25.    Char_Ptr   = ^Char_Array;
  26.  
  27. VAR
  28.    Command_Line: AnyStr            (* Command to be executed       *);
  29.    Return_Code:  INTEGER           (* DOS return code              *);
  30.    ComSpec:      AnyStr            (* Comspec from DOS environment *);
  31.  
  32.  
  33. FUNCTION UpCaseStr(S : AnyStr): AnyStr;
  34. var
  35.    i  : integer;
  36. begin
  37.    for i := 1 to length(S) do
  38.       S[i] := UpCase(S[i]);
  39.    UpCaseStr := S;
  40. end;
  41.  
  42.  
  43. {########################################################################}
  44.  
  45. PROCEDURE RunExt( VAR Ret_Code: INTEGER;
  46.                   VAR Command_Line );
  47.  
  48.    EXTERNAL 'TURBORUN.COM';   {This is the program which makes it all work.}
  49.  
  50. {########################################################################}
  51.  
  52.  
  53. PROCEDURE Get_ComSpec( VAR ComSpec: AnyStr ); {This procedure is probably not
  54.                                               necessary, if you have not
  55.                                               altered the location of the
  56.                                               COMMAND.COM file.}
  57.  
  58. CONST
  59.    ComSpec_String: String[7] = 'OMSPEC=';
  60.  
  61. VAR
  62.    Env_Ptr:     Char_Ptr;
  63.    Env_Pos:     INTEGER;
  64.    Env_Found:   BOOLEAN;
  65.    Spec_Pos:    INTEGER;
  66.    I:           INTEGER;
  67.  
  68. BEGIN (* Get_ComSpec *)
  69.                                    (* Initialize ComSpec to null string *)
  70.    ComSpec     := '';
  71.                                    (* Pick up starting address, offset of *)
  72.                                    (* DOS environment string.             *)
  73.  
  74.    Env_Ptr     := PTR( MEMW[ CSEG: $2C] , 0 );
  75.    Env_Pos     := 0;
  76.                                    (* Search for COMSPEC= in environment.  *)
  77.                                    (* Following will be file definition of *)
  78.                                    (* COMMAND.COM.                         *)
  79.    REPEAT
  80.                                    (* Look for initial 'C' of 'COMSPEC='   *)
  81.  
  82.       WHILE( Env_Ptr^[Env_Pos] <> 'C' ) DO
  83.          Env_Pos := Env_Pos + 1;
  84.                                    (* Flag indicating environment string   *)
  85.                                    (* has been found -- assume TRUE to     *)
  86.                                    (* start                                *)
  87.       Env_Found := TRUE;
  88.  
  89.       I        := 1;
  90.                                    (* Check characters after 'C'.  Are they *)
  91.                                    (* 'OMSPEC=' ?                           *)
  92.  
  93.       WHILE ( Env_Found AND ( I < 8 ) ) DO
  94.          IF Env_Ptr^[Env_Pos + I] = ComSpec_String[ I ] THEN
  95.             I := I + 1
  96.          ELSE
  97.             Env_Found := FALSE;
  98.  
  99.       Spec_Pos := Env_Pos + I;
  100.                                    (* If 'OMSPEC=' found, then we found  *)
  101.                                    (* the comspec.  If not, keep going.  *)
  102.  
  103.       IF ( I = 8 ) THEN
  104.          Env_Found := TRUE
  105.       ELSE
  106.          BEGIN
  107.             WHILE ( Env_Ptr^[Spec_Pos] <> NUL ) DO
  108.                Spec_Pos := Spec_Pos + 1;
  109.             Env_Pos := Spec_Pos;
  110.          END;
  111.  
  112.    UNTIL Env_Found;
  113.  
  114.                                    (* Pick up the COMMAND.COM definition  *)
  115.                                    (* following the COMSPEC=.             *)
  116.  
  117.    WHILE ( Env_Ptr^[Spec_Pos] <> NUL ) DO
  118.       BEGIN
  119.          ComSpec  := ComSpec + Env_Ptr^[Spec_Pos];
  120.          Spec_Pos := Spec_Pos + 1;
  121.       END;
  122.  
  123. END   (* Get_ComSpec *);
  124.  
  125.  
  126.  
  127. Procedure DoCommand;
  128. BEGIN
  129.  
  130. {*}    Command_Line := UpCaseStr(Command_Line);      {*}
  131.  
  132.                                    (* Prefix comspec to command line *)
  133.  
  134.              IF LENGTH( Command_Line ) > 0 THEN
  135.                 Command_Line := ComSpec + ' /C ' + Command_Line + NUL
  136.              ELSE
  137.                 Command_Line := ComSpec + NUL;
  138.  
  139.                                    (* Execute the command *)
  140.  
  141.              RunExt( Return_Code , Command_Line[1] );
  142.  
  143.  
  144. End; {of DoCommand}
  145.  
  146.  
  147.  
  148. {  * * * * *  DEMO  OF  THE   PROGRAM  * * * * * }
  149.  
  150. Var
  151.   MenuList1 : Menu_Selections;
  152.   MenuChoice: integer;
  153.   Count     : integer;
  154.  
  155. BEGIN
  156. ClrScr;
  157. Get_ComSpec(comspec);
  158.  
  159.  
  160.             {Using the MenuModule:  Define up to 15 prompts in array MenuList.
  161.              The last prompt must be the null string.  These prompts will be
  162.              passed to the function "Menu" below}
  163.  
  164. MenuList1[1] := ' Run REFLEX ';
  165. MenuList1[2] := ' Run MICROSOFT WORD ';
  166. MenuList1[3] := ' Run INPUT PREPROSSER ';
  167. MenuList1[4] := ' DOS Gateway ';
  168. MenuList1[5] := ' END ';
  169. MenuList1[6] := '';
  170.  
  171. Command_Line := '';
  172.  REPEAT
  173.  IF COMMAND_LINE <> 'END' THEN
  174.  Begin
  175.      Window(1,1,80,25);
  176.      ClrScr;
  177.      Window(14,1,64,25);
  178.  
  179.             {The function "Menu" returns an integer corresponding to the
  180.              subscript of the prompt selected from array "MenuList1".  The
  181.              parameters passed to "Menu" are:
  182.  
  183.                     the name of the array of prompts
  184.                     the X location of the menu; if 0 then it will be centered
  185.                     the Y location of the menu
  186.                     the menu's title string in single quotes
  187.                     the X location of the title;if 0 then it will be centered
  188.                     the Y location of the title
  189.                     the default selection (integer)
  190.              }
  191.  
  192.      Menuchoice := Menu(MenuList1,0,10,'PLEASE MAKE YOUR CHOICE FROM THIS MENU',0,4,1);
  193.      case MenuChoice of
  194.  
  195.           1:Begin
  196.                  Command_Line := 'cd \reflex';
  197.                  DoCommand;
  198.                  Command_Line := 'reflex.com';
  199.                  DoCommand;
  200.             end;
  201.           2:begin
  202.                  ClrScr;
  203.                  Command_Line := 'cd \';
  204.                  DoCommand;
  205.                  Command_line := 'word.bat';
  206.                  DoCommand;
  207.                  ClrScr;
  208.             end;
  209.           3:begin
  210.                  ClrScr;
  211.                  Command_Line := 'cd \turbo\workarea';
  212.                  DoCommand;
  213.                  Command_Line := 'main.com';
  214.                  DoCommand;
  215.                  ClrScr;
  216.             end;
  217.           4:begin
  218.                  ClrScr;
  219.                  for count := 1 to 5 do
  220.                     Writeln('* * * TO RETURN TO THE MENU TYPE "EXIT" * * *');
  221.                  Command_Line := '';
  222.                  DoCommand;
  223.                  ClrScr;
  224.             end;
  225.           5:begin
  226.                  ClrScr;
  227.                  Command_Line := 'END';
  228.             end;
  229.      end;
  230.  END;
  231.  UNTIL (COMMAND_LINE = 'END');
  232. END   (*DosRun*).
  233.  
  234.