Power-Programmierung/CD1.mdf/pascal/library/dos/pibsoft/menu/pibdodos.pas

Pascal/Delphi Source File | 1986-01-16 | 11.5 KB | 229 lines

(*$V-,R-*)
PROGRAM PibDoDos;

(*--------------------------------------------------------------------------*)
(*                                                                          *)
(*     Program:  PibDoDos                                                   *)
(*                                                                          *)
(*     Purpose:  Demonstrate TURBORUN.COM, an assembler routine to          *)
(*               execute DOS commands.                                      *)
(*                                                                          *)
(*     Author:   Philip R. Burns                                            *)
(*     Version:  1.0                                                        *)
(*     Date:     April, 1985                                                *)
(*                                                                          *)
(*     Credits:  The external routine TURBORUN.COM was written by           *)
(*               John Cooper and John Falconer.                             *)
(*                                                                          *)
(*               TURBORUN should be available on the same BBS as you found  *)
(*               this program on.                                           *)
(*                                                                          *)
(*     Remarks:  This program demonstrates the external routine TURBORUN    *)
(*               which allows Turbo Pascal programs to execute DOS commands *)
(*               or other programs dynamically.  The environment string is  *)
(*               searched for COMSPEC= to obtain the current setting of     *)
(*               COMMAND.COM.  Then a prompt is issued for a command to be  *)
(*               executed.  The command is passed to DOS for execution, if  *)
(*               possible, and then control returns to this program.  The   *)
(*               prompt for a new command is issued, and this continues     *)
(*               until the command 'END' (in all capital letters) is        *)
(*               entered.                                                   *)
(*                                                                          *)
(*               Note:  Entering a null line invokes a secondary copy of    *)
(*                      the DOS command processor.  Enter an EXIT to get    *)
(*                      back to this program.                               *)
(*                                                                          *)
(*     Glitches: DOS may freeze up if there is not enough memory to execute *)
(*               the command, or if the command clobbers memory that does   *)
(*               not belong to it.  In these cases, a re-boot is needed.    *)
(*                                                                          *)
(*               Note:  You should compile this to a .COM file, and set     *)
(*                      the maximum heap size (A----) so that there is      *)
(*                      enough memory for the program to be executed.       *)
(*                                                                          *)
(*--------------------------------------------------------------------------*)
(*                                                                          *)
(*     Send comments, suggestions, etc. to PHILIP BURNS on either of the    *)
(*     following two Chicago BBSs:                                          *)
(*                                                                          *)
(*       Gene Plantz's BBS [phone]                                   *)
(*       Ron Fox's BBS     [phone]                                   *)
(*                                                                          *)
(*--------------------------------------------------------------------------*)

CONST
   NUL = #00                       (* Terminator for DOS Ascii z-strings *);

TYPE
   AnyStr     = STRING[255];
   Char_Array = ARRAY[1..1] OF CHAR;
   Char_Ptr   = ^Char_Array;

VAR
   Command_Line: AnyStr            (* Command to be executed       *);
   Return_Code:  INTEGER           (* DOS return code              *);
   ComSpec:      AnyStr            (* Comspec from DOS environment *);

(*--------------------------------------------------------------------------*)
(*    RunExt --- invoke external assembler program to execute DOS command   *)
(*--------------------------------------------------------------------------*)

PROCEDURE RunExt( VAR Ret_Code: INTEGER;
                  VAR Command_Line );

(*--------------------------------------------------------------------------*)
(*                                                                          *)
(*     Procedure:  RunExt (EXTERNAL ASM)                                    *)
(*                                                                          *)
(*     Purpose:    Performs DOS execute on given command                    *)
(*                                                                          *)
(*     Calling Sequence:                                                    *)
(*                                                                          *)
(*        RunExt( VAR Ret_Code: INTEGER;  VAR Command_Line );               *)
(*                                                                          *)
(*           Ret_Code     --- return code from DOS.                         *)
(*           Command_Line --- contains command to be executed.              *)
(*                            If parameter passed is a string, then         *)
(*                            be sure to specify 'Command_Line[1]' as       *)
(*                            the actual argument.                          *)
(*                                                                          *)
(*     Remarks:                                                             *)
(*                                                                          *)
(*        This routine is an external assembler routine.                    *)
(*                                                                          *)
(*--------------------------------------------------------------------------*)

   EXTERNAL 'TURBORUN.COM';


(*--------------------------------------------------------------------------*)
(*        Get_ComSpec --- Get location of Command.Com from environment      *)
(*--------------------------------------------------------------------------*)

PROCEDURE Get_ComSpec( VAR ComSpec: AnyStr );

(*--------------------------------------------------------------------------*)
(*                                                                          *)
(*     Procedure:  Get_ComSpec                                              *)
(*                                                                          *)
(*     Purpose:    Gets location of COMMAND.COM from DOS environment        *)
(*                                                                          *)
(*     Calling Sequence:                                                    *)
(*                                                                          *)
(*        Get_Comspec( VAR ComSpec: AnyStr );                               *)
(*                                                                          *)
(*           ComSpec --- Returned file specification for COMMAND.COM        *)
(*                       in 'drive:\directory\COMMAND.COM' form.            *)
(*                                                                          *)
(*     Calls:  None                                                         *)
(*                                                                          *)
(*     Remarks:                                                             *)
(*                                                                          *)
(*        This routine assumes that the COMSPEC= parameter actually exists  *)
(*        in the environment (it should).                                   *)
(*                                                                          *)
(*--------------------------------------------------------------------------*)

CONST
   ComSpec_String: String[7] = 'OMSPEC=';

VAR
   Env_Ptr:     Char_Ptr;
   Env_Pos:     INTEGER;
   Env_Found:   BOOLEAN;
   Spec_Pos:    INTEGER;
   I:           INTEGER;

BEGIN (* Get_ComSpec *)
                                   (* Initialize ComSpec to null string *)
   ComSpec     := '';
                                   (* Pick up starting address, offset of *)
                                   (* DOS environment string.             *)

   Env_Ptr     := PTR( MEMW[ CSEG: $2C] , 0 );
   Env_Pos     := 0;
                                   (* Search for COMSPEC= in environment.  *)
                                   (* Following will be file definition of *)
                                   (* COMMAND.COM.                         *)
   REPEAT
                                   (* Look for initial 'C' of 'COMSPEC='   *)

      WHILE( Env_Ptr^[Env_Pos] <> 'C' ) DO
         Env_Pos := Env_Pos + 1;
                                   (* Flag indicating environment string   *)
                                   (* has been found -- assume TRUE to     *)
                                   (* start                                *)
      Env_Found := TRUE;

      I        := 1;
                                   (* Check characters after 'C'.  Are they *)
                                   (* 'OMSPEC=' ?                           *)

      WHILE ( Env_Found AND ( I < 8 ) ) DO
         IF Env_Ptr^[Env_Pos + I] = ComSpec_String[ I ] THEN
            I := I + 1
         ELSE
            Env_Found := FALSE;

      Spec_Pos := Env_Pos + I;
                                   (* If 'OMSPEC=' found, then we found  *)
                                   (* the comspec.  If not, keep going.  *)

      IF ( I = 8 ) THEN
         Env_Found := TRUE
      ELSE
         BEGIN
            WHILE ( Env_Ptr^[Spec_Pos] <> NUL ) DO
               Spec_Pos := Spec_Pos + 1;
            Env_Pos := Spec_Pos;
         END;

   UNTIL Env_Found;

                                   (* Pick up the COMMAND.COM definition  *)
                                   (* following the COMSPEC=.             *)

   WHILE ( Env_Ptr^[Spec_Pos] <> NUL ) DO
      BEGIN
         ComSpec  := ComSpec + Env_Ptr^[Spec_Pos];
         Spec_Pos := Spec_Pos + 1;
      END;

END   (* Get_ComSpec *);

(*--------------------------------------------------------------------------*)

BEGIN (* PibDoDos -- Main Program *)

                                   (* Obtain location of Command.Com *)
    Get_ComSpec( ComSpec );
    Writeln('Comspec = ',ComSpec);

                                   (* Read commands until 'END' entered *)
    REPEAT

       WRITELN;
       WRITE('Enter command or END to stop: ');

       READLN( Command_Line );

       IF Command_Line <> 'END' THEN
          BEGIN
                                   (* Prefix comspec to command line *)

             IF LENGTH( Command_Line ) > 0 THEN
                Command_Line := ComSpec + ' /C ' + Command_Line + NUL
             ELSE
                Command_Line := ComSpec + NUL;

                                   (* Execute the command *)

             RunExt( Return_Code , Command_Line[1] );

          END;

    UNTIL ( Command_Line = 'END' );

END   (* PibDoDos *).