🚀 go-pugleaf

P.S.  This isn't the code I mentioned, but I tried it, and exec'ing 
      COMMAND.COM to change to another directory, then opening a file
      and writing to it DOES cause the file to be created in the 
      changed-to directory, so see what you think.  (This is under
      MS-DOS 4.01). 
      
      (I _HOPE_ this isn't an inappropriate posting for this group!
       If so, my apologies!)


David Douglas
douglas@usceast.cs.scarolina.edu


{ File:  QWERTY.PAS (for lack of a better filename :-) }
program tryit;

{$I EXEC.PAS}

VAR F : TEXT;

BEGIN

  EXEC('C:\COMMAND.COM', '/C CD C:\');
  EXEC('C:\COMMAND.COM', '/C MD QWERTY.DIR');
  EXEC('C:\COMMAND.COM', '/C CD \QWERTY.DIR');
  ASSIGN(F,'QWERTY.OUT');
  REWRITE(F);
  WRITELN(F, 'This the output of QWERTY');
  CLOSE(F);

END.

{ File:  EXEC.PAS }


{----------------------------------------------------------------------------}
{                                                                            }
{     Exec                                                                   }
{                                                                            }
{   This subroutine, given a partial (or full) path-name to a file to be     }
{ executed (but NOT a .BAT file), and a commandline containing the           }
{ parameters to be passed to that program, tries to execute the given        }
{ file with the given parameters.  If an error occurs, an appropriate error  }
{ message is printed.                                                        }
{                                                                            }
{   To execute a particular batch file, specify COMMAND.COM as the program   }
{ to be executed, and '/C batch-file-name' as the commandline.  DON'T TRY    }
{ TO EXECUTE A BATCH FILE DIRECTLY -- THE COMPUTER WILL LOCK UP, AND YOU     }
{ WILL HAVE TO RESET THE COMPUTER!!!                                         }
{                                                                            }
{ ***NOTE*** : Compile to an executable file with a 'O C I 0' option and     }
{ a reasonable 'O C A' value of, for instance, 0800(from the Turbo Pascal    }
{ main menu).  Otherwise, there may not be enough memory available to load   }
{ and execute the requested program.                                         }
{                                                                            }
{                                                                            }
{----------------------------------------------------------------------------}

TYPE _EXECSTRING255_ = STRING[255];

PROCEDURE EXEC(FILENAME, COMMANDLINE : _EXECSTRING255_);

  CONST EOS  = #0;  { End-Of-String }
        BEEP = #7;

        ERROR_MSG : _EXECSTRING255_ =
                    'Error in execution of child process -- try again.';

        ERROR_MESSAGES : ARRAY[1..18] OF _EXECSTRING255_ =
        ( 'Invalid function number.',
          'File not found.',
          'Path not found.',
          'Too many open files (no handles available).',
          'Access denied.',
          'Invalid handle.',
          'Memory control blocks destroyed.',
          'Insufficient memory.',
          'Invalid memory block address.',
          'Invalid environment.',
          'Invalid format.',
          'Invalid access code.',
          'Invalid data.',
          '',            { not used }
          'Invalid drive specified.',
          'Attempted to remove the current directory.',
          'Not same device.',
          'No more files.'
        );

  TYPE ARRTYPE = ARRAY[1..256] OF CHAR;

       PARAMBLOCKTYPE  = RECORD
                           ENV,
                           CMDLINEOFS,
                           CMDLINESEG,
                           FCB1OFS,
                           FCB1SEG,
                           FCB2OFS,
                           FCB2SEG    : INTEGER;
                         END;

       REGISTERS = RECORD
         CASE BOOLEAN OF
           TRUE  : ( AL, AH, BL, BH, CL, CH, DL, DH : BYTE );
           FALSE : ( AX,     BX,     CX,     DX,
                     BP, SI, DI, DS, ES, FLAGS : INTEGER );
         END;

  VAR
      XERROR_MSG  : _EXECSTRING255_;
      ENVIRONMENT : INTEGER ABSOLUTE CSEG:$2C;
      ASCIIZSTR   : ARRTYPE;
      I,J         : INTEGER;

      FCB1,
      FCB2        : ARRAY[1..16] OF BYTE;
      ERRORCODE   : INTEGER;

      PARAMBLOCK  : PARAMBLOCKTYPE;
      R           : REGISTERS;


  BEGIN  { PROCEDURE EXEC }

{ Initialize the FULL error message }

    XERROR_MSG := BEEP + BEEP + BEEP + ERROR_MSG;

{ "Initialize" the two FCBs }

    FOR I := 1 TO 16 DO
      BEGIN
        FCB1[I] := 0;
        FCB2[I] := 0;
      END;

    FOR I := 2 TO 12 DO
      BEGIN
        FCB1[I] := 32;
        FCB2[I] := 32;
      END;

{ Load the ENV, CMDLINESEG, etc., fields of the PARAMBLOCK record with }
{ the appropriate values.                                              }

    WITH PARAMBLOCK DO
      BEGIN
        ENV        := ENVIRONMENT;
        CMDLINESEG := SEG(COMMANDLINE);
        CMDLINEOFS := OFS(COMMANDLINE);
        FCB1SEG    := SEG(FCB1);
        FCB1OFS    := OFS(FCB1);
        FCB2SEG    := SEG(FCB2);
        FCB2OFS    := OFS(FCB2);
      END;

{ Get the given filename-string into ASCIIZ format }

    J := 0;
    FOR I := 1 TO LENGTH(FILENAME) DO
      BEGIN
        J := J + 1;
        ASCIIZSTR[J] := FILENAME[I];
      END;
    J := J + 1;
    ASCIIZSTR[J] := EOS;

{ Initialize the proper register-fields in register-record R. }

    WITH R DO
      BEGIN
        DS := SEG(ASCIIZSTR);
        DX := OFS(ASCIIZSTR);
        ES := SEG(PARAMBLOCK);
        BX := OFS(PARAMBLOCK);
        AH := $4B;              { Execute-child-process service }
        AL := 0;                { Load and execute method       }
      END;

{ Invoke the proper service }

    MSDOS(R);

{ Check the result -- if the Carry bit of FLAGS is set, then an error }
{ occurred -- print the appropriate error message.  Error code is     }
{ found in AX register field.                                         }

    IF (R.FLAGS AND 1) = 1
      THEN BEGIN
             WRITELN(XERROR_MSG);
             WRITELN(ERROR_MESSAGES[R.AX]);
           END;

  END;  { PROCEDURE EXEC }


{----------------------------------------------------------------------------}
{                                                                            }
{     ReturnCode                                                             }
{                                                                            }
{   This subroutine attempts to retrieve the return-code returned by the     }
{ last program that executed.                                                }
{                                                                            }
{----------------------------------------------------------------------------}

FUNCTION RETURNCODE : INTEGER;

  TYPE

       REGISTERS = RECORD
         CASE BOOLEAN OF
           TRUE  : ( AL, AH, BL, BH, CL, CH, DL, DH : BYTE );
           FALSE : ( AX,     BX,     CX,     DX,
                     BP, SI, DI, DS, ES, FLAGS : INTEGER );
         END;

  VAR
      R : REGISTERS;

  BEGIN

  { Initialize the proper register-fields in R }

      R.AH := $4D;            { Fetch-exit-code service }

      MSDOS(R);

      RETURNCODE := R.AL;         { Return the right return-code }

  END; { FUNCTION RETURNCODE }