home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / MENU / TOADMENU.ARC / NEWEXEC.INC < prev    next >
Encoding:
Text File  |  1987-10-28  |  7.0 KB  |  206 lines
  1. (* from MARKET's Turbo archive, 9 Mar 87.  Toad Hall
  2.  EXEC.PAS version 1.2
  3.  
  4.  This file contains  2 functions for  Turbo Pascal  that allow you to
  5.  run other programs from within a Turbo program.  The first function,
  6.  subProcess,  actually calls up a different program using MS-DOS call
  7.  4BH, EXEC.  The second function,  GetComSpec,  returns the path name
  8.  of  the  command  interpreter,  which is  necessary  to  do  certain
  9.  operations. There is also a main program that allows you to test the
  10.  functions.
  11.  
  12. ----------------------------------------------------------------------
  13.  
  14.  Version 1.1  works with  DOS 2.0 and 2.1.  Version 1.0  only  worked
  15.  with DOS 3.0 due to a subtle bug in DOS 2.x.
  16.  
  17.  -  Bela Lubkin
  18.     Borland International Technical Support
  19.     CompuServe 71016,1573
  20.  
  21. ----------------------------------------------------------------------
  22.  
  23.  Version 1.2  corrects a compiling problem in the INLINE code area of
  24.  subProcess. The line:
  25.      INLINE ($8D/$96/ PathName+1 /
  26.  will always generate a   ") required"  at the  +  sign.  Apparently
  27.  Turbo  only  allows  displacements on  location  counter  references
  28.  within the INLINE code (i.e. not on variable identifiers).
  29.  
  30.  -  James Tuksal
  31.     Burroughs Corporation
  32.     14115 Farmington Rd.
  33.     Livonia, Michigan
  34.     48154
  35.  
  36. ----------------------------------------------------------------------
  37. *)
  38. TYPE
  39.  Str66  = STRING [66];
  40.  
  41. (*
  42.  Pass subProcess a string of the form:
  43.  'D:\FULL\PATH\NAME\OF\FILE.TYP parameter1 parameter2 ...'
  44.  
  45.  For example,
  46.    'C:\SYSTEM\CHKDSK.COM'
  47.    'A:\WS.COM DOCUMENT.1'
  48.    'C:\DOS\LINK.EXE TEST;'
  49.    'C:\COMMAND.COM /C COPY *.* B:\BACKUP >FILESCOP.IED'
  50.  
  51.  The  fourth  example  shows  several  things.   To  do  any  of  the
  52.  following,  you must invoke the  command processor and let it do the
  53.  work:
  54.  
  55.        redirection
  56.        piping
  57.        path searching
  58.        searching for the extension of a program (.COM, .EXE, or .BAT)
  59.        batch files;
  60.        internal DOS commands
  61.  
  62.  The  name  of the  command  processor  file  is  stored in  the  DOS
  63.  environment.  The function  GetComSpec in this file returns the path
  64.  name of the  command processor.  Also note that you must use the  /C
  65.  parameter or  COMMAND  will not  work correctly.  You can  also call
  66.  COMMAND with no parameters.  This will allow the user to use the DOS
  67.  prompt to run anything  (as long as there is enough memory).  To get
  68.  back to your program, he can type the command EXIT.
  69.  
  70.  Actual example:
  71.    i := subProcess (GetComSpec+' /C COPY *.* B:\BACKUP >FILESCOP.IED');
  72.  
  73.  The value  returned is  the result  returned by  DOS after  the EXEC
  74.  call.  The most common values are:
  75.  
  76.       0: Success
  77.       1: Invalid function (should never happen with this routine)
  78.       2: File/path not found
  79.       8: Not enough memory to load program
  80.      10: Bad environment (greater than 32K)
  81.      11: Illegal .EXE file format
  82.  
  83.  If you get any other result,  consult an  MS-DOS Technical Reference
  84.  manual.
  85.  
  86.  VERY IMPORTANT NOTE:  you MUST use  the Options menu of Turbo Pascal
  87.  to  restrict  the amount  of  free   dynamic  memory   used by  your
  88.  program.  Only  the  memory  that is   not  used  by  the   heap  is
  89.  available for use by other programs.
  90. *)
  91.  
  92.  FUNCTION subProcess (CommandLine : Str255): INTEGER;
  93.   CONST
  94.    ssSave: INTEGER = 0;
  95.    SPSave: INTEGER = 0;
  96.   VAR
  97.    FCB1        : ARRAY [0..36] OF BYTE;
  98.    FCB2        : ARRAY [0..36] OF BYTE;
  99.    PathName    : Str66;
  100.    CommandTail : Str255;
  101.    parmTable   : RECORD
  102.                   envseg : INTEGER;
  103.                   comlin : ^INTEGER;
  104.                   FCB1Pr : ^INTEGER;
  105.                   FCB2Pr : ^INTEGER;
  106.                  END;
  107.   BEGIN
  108.    IF POS (' ', CommandLine) = 0 THEN BEGIN
  109.      PathName := CommandLine + #0;
  110.      CommandTail := ^M;
  111.    END
  112.    ELSE BEGIN
  113.      PathName := COPY (CommandLine, 1, POS (' ', CommandLine)-1) + #0;
  114.      CommandTail := COPY (CommandLine, POS (' ', CommandLine), 255) + ^M;
  115.    END;
  116.    CommandTail [0] := PRED(CommandTail[0]);
  117.    WITH Regs Do BEGIN
  118.      FillChar (FCB1, SizeOf(FCB1), 0);
  119.      AX := $2901;
  120.      DS := Seg(CommandTail[1]);
  121.      SI := Ofs(CommandTail[1]);
  122.      ES := Seg(FCB1);
  123.      DI := Ofs(FCB1);
  124.      MSDOS (Regs);                      { Create FCB 1 }
  125.      FillChar (FCB2, SizeOf(FCB2), 0);
  126.      AX := $2901;
  127.      ES := Seg(FCB2);
  128.      DI := Ofs(FCB2);
  129.      MSDOS (Regs);                      { Create FCB 2 }
  130.      ES := CSeg;
  131.      BX := SSEG - CSEG + MEMW[CSEG:MEMW[CSEG:$0101] + $112];
  132.      AH := $4A;
  133.      MSDOS (Regs);                      { Deallocate unused memory }
  134.      WITH parmTable DO BEGIN
  135.        envseg := MEMW[CSEG:$002C];
  136.        comlin := ADDR(CommandTail);
  137.        FCB1Pr := ADDR(FCB1);
  138.        FCB2Pr := ADDR(FCB2);
  139.      END;
  140.      INLINE (
  141.    $BF/$01/$00/               {+MOV     DI,0001h }
  142.    $8D/$93/PathName/          {>LEA     DX,[BP+DI+DS:PathName] }
  143.    $8D/$9E/parmTable/         { LEA     BX,[BP+DS:parmTable]   }
  144.    $B8/$00/$4B/               { MOV     AX,4B00h }
  145.    $1E/                       { PUSH    DS }
  146.    $55/                       { PUSH    BP }
  147.    $16/                       { PUSH    SS }
  148.    $1F/                       { POP     DS }
  149.    $16/                       { PUSH    SS }
  150.    $07/                       { POP     ES }
  151.    $2E/$8C/$16/SSSave/        { MOV     CS:ssSave,SS }
  152.    $2E/$89/$26/SPSave/        { MOV     CS:SPSave,SP }
  153.    $FA/                       { CLI }
  154.    $CD/$21/                   { INT     21h }
  155.    $FA/                       { CLI }
  156.    $2E/$8B/$26/SPSave/        { MOV     SP,CS:SPSave }
  157.    $2E/$8E/$16/SSSave/        { MOV     SS,CS:ssSave }
  158.    $FB/                       { STI }
  159.    $9C/                       { PUSHF }
  160.    $BF/$12/$00/               {+MOV     DI,0012h }
  161.    $3E/$8F/$83/Regs/          {>POP     [BP+DI+DS:Regs] }
  162.    $3E/$89/$86/Regs/          { MOV     [BP+DS:Regs],AX }
  163.    $5D/                       { POP     BP }
  164.    $1F);                      { POP     DS }
  165.  
  166. { + Line added    to correct compile problem in 1.1 }
  167. { > Line modified to correct compile problem in 1.1 }
  168.  
  169. { The messing around with SS and SP is necessary because under DOS 2.x }
  170. { after  returning  from an  EXEC call,  ALL registers  are  destroyed }
  171. { except  CS and IP!  I wish I'd  known that  before I  released  this }
  172. { package the first time... }
  173.  
  174.      IF (Flags AND 1) <> 0 THEN subProcess := AX
  175.      ELSE subProcess := 0;
  176.     END;
  177.   END;  { of subProcess }
  178.  
  179.  
  180. FUNCTION GetComSpec : Str66;
  181.   TYPE
  182.     Env = ARRAY [0..32767] OF CHAR;
  183.   VAR
  184.     EPtr : ^Env;
  185.     EStr : Str255;
  186.     Done : BOOLEAN;
  187.     i    : INTEGER;
  188.   BEGIN
  189.     EPtr := PTR (MEMW [CSEG:$002C],0);
  190.     i := 0;
  191.     Done := FALSE;
  192.     EStr := '';
  193.     REPEAT
  194.       IF EPtr^[i] = #0 THEN BEGIN
  195.         IF EPtr^[SUCC(i)] = #0 THEN Done := TRUE;
  196.         IF COPY (EStr, 1, 8) = 'COMSPEC=' THEN BEGIN
  197.           GetComSpec := COPY (EStr, 9, 100);
  198.           Done := TRUE;
  199.         END;
  200.         EStr := '';
  201.       END
  202.       ELSE EStr := EStr + EPtr^[i];
  203.       i := SUCC(i);
  204.     UNTIL Done;
  205.   END;  { of GetComSpec }
  206.