Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/TP002.ZIP/NEWEXEC.PQS/newexec.pas

Pascal/Delphi Source File | 1985-11-21 | 10.8 KB | 245 lines

{ EXEC.PAS version 1.2                                                 }

{ This file contains  2 functions for  Turbo Pascal  that allow you to }
{ run other programs from within a Turbo program.  The first function, }
{ SubProcess,  actually calls up a different program using MS-DOS call }
{ 4BH, EXEC.  The second function,  GetComSpec,  returns the path name }
{ of  the  command  interpreter,  which is  necessary  to  do  certain }
{ operations. There is also a main program that allows you to test the }
{ functions.                                                           }

{----------------------------------------------------------------------}

{ Version 1.1  works with  DOS 2.0 and 2.1.  Version 1.0  only  worked }
{ with DOS 3.0 due to a subtle bug in DOS 2.x.                         }

{ -  Bela Lubkin                                                       }
{    Borland International Technical Support                           }
{    CompuServe 71016,1573                                             }

{----------------------------------------------------------------------}

{ Version 1.2  corrects a compiling problem in the INLINE code area of }
{ SubProcess. The line:                                                }
{     INLINE ($8D/$96/ PathName+1 /                                    }
{ will always grenerate a   ") required"  at the  +  sign.  Apparently }
{ Turbo  only  allows  displacements on  location  counter  references }
{ within the INLINE code (i.e. not on variable identifiers).           }

{ -  James Tuksal                                                      }
{    Burroughs Corporation                                             }
{    14115 Farmington Rd.                                              }
{    Livonia, Michigan                                                 }
{    48154                                                             }

{----------------------------------------------------------------------}

TYPE
 Str66  = STRING [66];
 Str255 = STRING [255];


{ Pass SubProcess a string of the form:                                }
{ 'D:\FULL\PATH\NAME\OF\FILE.TYP parameter1 parameter2 ...'            }

{ For example,                                                         }
{   'C:\SYSTEM\CHKDSK.COM'                                             }
{   'A:\WS.COM DOCUMENT.1'                                             }
{   'C:\DOS\LINK.EXE TEST;'                                            }
{   'C:\COMMAND.COM /C COPY *.* B:\BACKUP >FILESCOP.IED'               }

{ The  fourth  example  shows  several  things.   To  do  any  of  the }
{ following,  you must invoke the  command processor and let it do the }
{ work:                                                                }

{       redirection                                                    }
{       piping                                                         }
{       path searching                                                 }
{       searching for the extension of a program (.COM, .EXE, or .BAT) }
{       batch files;                                                   }
{       internal DOS commands                                          }

{ The  name  of the  command  processor  file  is  stored in  the  DOS }
{ environment.  The function  GetComSpec in this file returns the path }
{ name of the  command processor.  Also note that you must use the  /C }
{ parameter or  COMMAND  will not  work correctly.  You can  also call }
{ COMMAND with no parameters.  This will allow the user to use the DOS }
{ prompt to run anything  (as long as there is enough memory).  To get }
{ back to your program, he can type the command EXIT.                  }

{ Actual example:                                                      }
{   I:=SubProcess (GetComSpec+' /C COPY *.* B:\BACKUP >FILESCOP.IED'); }

{ The value  returned is  the result  returned by  DOS after  the EXEC }
{ call.  The most common values are:                                   }

{      0: Success                                                      }
{      1: Invalid function (should never happen with this routine)     }
{      2: File/path not found                                          }
{      8: Not enough memory to load program                            }
{     10: Bad environment (greater than 32K)                           }
{     11: Illegal .EXE file format                                     }

{ If you get any other result,  consult an  MS-DOS Technical Reference }
{ manual.                                                              }

{ VERY IMPORTANT NOTE:  you MUST use  the Options menu of Turbo Pascal }
{ to  restrict  the amount  of  free   dynamic  memory   used by  your }
{ program.  Only  the  memory  that is   not  used  by  the   heap  is }
{ available for use by other programs.                                 }

 FUNCTION SubProcess (CommandLine : Str255): INTEGER;
  CONST
   SSSave: INTEGER=0;
   SPSave: INTEGER=0;
  VAR
   Regs        : RECORD CASE INTEGER OF
                  1: (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : INTEGER);
                  2: (AL, AH, BL, BH, CL, CH, DL, DH            : BYTE);
                 END;
   FCB1        : ARRAY [0..36] OF BYTE;
   FCB2        : ARRAY [0..36] OF BYTE;
   PathName    : Str66;
   CommandTail : Str255;
   ParmTable   : RECORD
                  EnvSeg : INTEGER;
                  ComLin : ^INTEGER;
                  FCB1Pr : ^INTEGER;
                  FCB2Pr : ^INTEGER;
                 END;
  BEGIN
   IF POS (' ', CommandLine)=0 THEN
    BEGIN
     PathName:=CommandLine+#0;
     CommandTail:=^M;
    END                                 { if                           }
   ELSE
    BEGIN
     PathName:=COPY (CommandLine, 1, POS (' ', CommandLine)-1)+#0;
     CommandTail:=COPY (CommandLine, POS (' ', CommandLine), 255)+^M;
    END;                                { else                         }
   CommandTail [0]:=PRED (CommandTail [0]);
   WITH Regs Do
    BEGIN
     FILLCHAR (FCB1, SIZEOF (FCB1), 0);
     AX:=$2901;
     DS:=SEG (CommandTail [1]);
     SI:=OFS (CommandTail [1]);
     ES:=SEG (FCB1);
     DI:=OFS (FCB1);
     MSDOS (Regs);                      { Create FCB 1                 }
     FILLCHAR (FCB2, SIZEOF (FCB2), 0);
     AX:=$2901;
     ES:=SEG (FCB2);
     DI:=OFS (FCB2);
     MSDOS (Regs);                      { Create FCB 2                 }
     ES:=CSeg;
     BX:=SSEG-CSEG+MEMW [CSEG:MEMW [CSEG:$0101]+$112];
     AH:=$4A;
     MSDOS (Regs);                      { Deallocate unused memory     }
     WITH ParmTable DO
      BEGIN
       EnvSeg:=MEMW [CSEG:$002C];
       ComLin:=ADDR (CommandTail);
       FCB1Pr:=ADDR (FCB1);
       FCB2Pr:=ADDR (FCB2);
      END;                              { with                         }
     INLINE ($BF/$01/$00/               {+MOV     DI,0001h               }
             $8D/$93/PathName/          {>LEA     DX,[BP+DI+DS:PathName] }
             $8D/$9E/ParmTable/         { LEA     BX,[BP+DS:ParmTable]   }
             $B8/$00/$4B/               { MOV     AX,4B00h               }
             $1E/                       { PUSH    DS                     }
             $55/                       { PUSH    BP                     }
             $16/                       { PUSH    SS                     }
             $1F/                       { POP     DS                     }
             $16/                       { PUSH    SS                     }
             $07/                       { POP     ES                     }
             $2E/$8C/$16/SSSave/        { MOV     CS:SSSave,SS           }
             $2E/$89/$26/SPSave/        { MOV     CS:SPSave,SP           }
             $FA/                       { CLI                            }
             $CD/$21/                   { INT     21h                    }
             $FA/                       { CLI                            }
             $2E/$8B/$26/SPSave/        { MOV     SP,CS:SPSave           }
             $2E/$8E/$16/SSSave/        { MOV     SS,CS:SSSave           }
             $FB/                       { STI                            }
             $9C/                       { PUSHF                          }
             $BF/$12/$00/               {+MOV     DI,0012h               }
             $3E/$8F/$83/Regs/          {>POP     [BP+DI+DS:Regs]        }
             $3E/$89/$86/Regs/          { MOV     [BP+DS:Regs],AX        }
             $5D/                       { POP     BP                     }
             $1F);                      { POP     DS                     }

{ + Line added    to correct compile problem in 1.1                    }
{ > Line modified to correct compile problem in 1.1                    }

{ The messing around with SS and SP is necessary because under DOS 2.x }
{ after  returning  from an  EXEC call,  ALL registers  are  destroyed }
{ except  CS and IP!  I wish I'd  known that  before I  released  this }
{ package the first time...                                            }

     IF (Flags AND 1)<>0 THEN
      SubProcess:=AX
     ELSE
      SubProcess:=0;
    END;                                { with                         }
  END;                                  { SubProcess                   }

 FUNCTION GetComSpec : Str66;
  TYPE
   Env=ARRAY [0..32767] OF CHAR;
  VAR
   EPtr : ^Env;
   EStr : Str255;
   Done : BOOLEAN;
   I    : INTEGER;
  BEGIN
   EPtr:=PTR (MEMW [CSEG:$002C],0);
   I:=0;
   Done:=FALSE;
   EStr:='';
   REPEAT
    IF EPtr^[I]=#0 THEN
     BEGIN
      IF EPtr^ [I+1]=#0 THEN
       Done:=TRUE;
      IF COPY (EStr, 1, 8)='COMSPEC=' THEN
       BEGIN
        GetComSpec:=COPY (EStr, 9, 100);
        Done:=TRUE;
       END;                             { if                           }
      EStr:='';
     END                                { if                           }
    ELSE
     EStr:=EStr+EPtr^[I];
    I:=I+1;
   UNTIL Done;
  END;                                  { GetComSpec                   }

{ Example program.  Set both  mInimum and mAximum  free dynamic memory }
{ to 100 and compile  this to a .COM  file.  Delete the  next  line to }
{ enable:                                                              }
{

 VAR
  Command : Str255;
  I       : INTEGER;

 BEGIN
  WRITELN ('Enter a * to quit; put a * before a command to use COMMAND.COM.');
  REPEAT
   WRITE  ('=->');
   READLN (Command);
   IF Command='*' THEN
    HALT;
   IF Command<>'' THEN
    BEGIN
     IF Command [1]='*' THEN
      Command:=GetComSpec+' /C '+COPY (Command, 2, 255);
     I:=SubProcess (Command);
     IF I<>0 THEN
      WRITELN ('Error - ',I);
    END;
  UNTIL FALSE;
 END.
}