home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TPTOOL5.ZIP / SUBPROC.INC < prev    next >
Encoding:
Text File  |  1987-03-28  |  4.9 KB  |  158 lines
  1.  
  2. const subproc_tag: string[90]
  3.    = #0'@(#)CURRENT_FILE LAST_UPDATE Subprocess library 1.0'#0;
  4. #log Subprocess library 1.0
  5.  
  6.  
  7. (* subproc.inc - run subprocesses from turbo pascal
  8.  
  9.   This file contains  a function for  Turbo Pascal  that allows you to
  10.   run other programs from within a Turbo program.  The function
  11.   SubProcess,  actually calls up a different program using MS-DOS call
  12.   4BH, EXEC.
  13.  
  14.  ----------------------------------------------------------------------*)
  15.  
  16.  
  17. (* Pass SubProcess a string of the form:
  18.   'D:\FULL\PATH\NAME\OF\FILE.TYP parameter1 parameter2 ...'            *)
  19.  
  20.  
  21. (* For example,
  22.     'C:\SYSTEM\CHKDSK.COM'
  23.     'A:\WS.COM DOCUMENT.1'
  24.     'C:\DOS\LINK.EXE TEST;'
  25.     'C:\COMMAND.COM /C COPY *.* B:\BACKUP >FILESCOP.IED'               *)
  26.  
  27.  
  28. (* VERY IMPORTANT NOTE:  you MUST use  the Options menu of Turbo Pascal
  29.   to  restrict  the amount  of  free   dynamic  memory   used by  your
  30.   program.  Only  the  memory  that is   not  used  by  the   heap  is
  31.   available for use by other programs.                                 *)
  32.  
  33. type
  34.    str66 =             string [66];
  35.    str255 =            string [255];
  36.  
  37. var
  38.    flagreg:            integer;
  39.    exitstat:           integer;
  40.    pathname:           str66;
  41.    commandtail:        str255;
  42.    parm_blk:           record
  43.          envseg:             integer;
  44.          comlin:             ^integer;
  45.          fcb1pr:             ^integer;
  46.          fcb2pr:             ^integer;
  47.    end;
  48.  
  49.  
  50. function subprocess (commandline:        str255): integer;
  51. var
  52.    regs:               regpack;
  53.    fcb1:               array [0..36] of byte;
  54.    fcb2:               array [0..36] of byte;
  55.    
  56. begin
  57.    flush(output);
  58.    
  59.    if pos (' ', commandline)= 0 then
  60.    begin
  61.       pathname := commandline + #0;
  62.       commandtail :=^m;
  63.    end                        { if }
  64.    
  65.    else
  66.    begin
  67.       pathname := copy (commandline, 1, pos (' ', commandline)- 1)+ #0;
  68.       commandtail := copy (commandline, pos (' ', commandline), 255)+^m;
  69.    end;                       { else }
  70.    
  71.  
  72.    commandtail[0]:= pred (commandtail [0]);
  73.    
  74.    with regs do
  75.    begin
  76.       fillchar(fcb1, sizeof (fcb1), 0);
  77.       ax := $2901;
  78.       ds := seg (commandtail [1]);
  79.       si := ofs (commandtail [1]);
  80.       es := seg (fcb1);
  81.       di := ofs (fcb1);
  82.       msdos(regs);               { Create FCB 1 }
  83.       
  84.       fillchar(fcb2, sizeof (fcb2), 0);
  85.       ax := $2901;
  86.       es := seg (fcb2);
  87.       di := ofs (fcb2);
  88.       msdos(regs);               { Create FCB 2 }
  89.       
  90.       es := cseg;
  91.       bx := sseg - cseg + memw [cseg : memw [cseg : $0101]+ $112];
  92.       ax := $4A00;
  93.       msdos(regs);               { Deallocate unused memory }
  94.  
  95.    end;                       {with}
  96.  
  97.  
  98.    with parm_blk do
  99.    begin
  100.       envseg := memw [cseg : $002C];
  101.       comlin := addr (commandtail);
  102.       fcb1pr := addr (fcb1);
  103.       fcb2pr := addr (fcb2);
  104.    end;                       { with }
  105.  
  106.  
  107.    inline($9C /               {pushf}
  108.     $2E / $89 / $2E / $80 / $00 /
  109.                               {MOV cs:80H,BP}
  110.     $2E / $89 / $26 / $82 / $00 /
  111.                               {MOV cs:82H,SP}
  112.     $2E / $8C / $1E / $84 / $00 /
  113.                               {MOV cs:84H,DS}
  114.     $2E / $8C / $16 / $86 / $00 /
  115.                               {MOV cs:86H,SS}
  116.     $1E / $07 /               {mov ES,DS}
  117.     $BA / pathname /          {mov dx,offset(filespec[0])}
  118.     $42 /                     {inc dx (to point to filespec[1])}
  119.     $BB / parm_blk /          {mov bx,offset(parm_block)}
  120.     $B8 / $00 / $4B /         {mov ax,4B00H}
  121.     $FB /                     {sti}
  122.     $cd / $21 /               {int 21 - call EXEC}
  123.     $FA /                     {cli: avoid interrupts while restoring stack}
  124.     $2E / $8B / $2E / $80 / $00 /
  125.                               {MOV BP,cs:80H}
  126.     $2E / $8B / $26 / $82 / $00 /
  127.                               {MOV SP,cs:82H}
  128.     $2E / $8E / $1E / $84 / $00 /
  129.                               {MOV DS,cs:84H}
  130.     $2E / $8E / $16 / $86 / $00 /
  131.                               {MOV SS,cs:86H}
  132.     $FB /                     {sti}
  133.     $9C /                     {pushf}
  134.     $58 /                     {pop ax}
  135.     $A3 / flagreg /           {mov [flagreg],ax}
  136.     $B8 / $00 / $4D /         {mov ax,4D00H}
  137.     $cd / $21 /               {int 21 - call WAIT (return exit code)}
  138.     $A3 / exitstat /          {mov [exitstat],ax}
  139.     $2E / $8B / $2E / $80 / $00 /
  140.                               {MOV BP,cs:80H}
  141.     $9D);                     {popf}
  142.    
  143.    writeln;
  144.    
  145.    if (flagreg and 1)<> 0 then
  146.    begin
  147.       subprocess := flagreg;
  148.       writeln(whoami, ':  Could not execute ', pathname);
  149.    end
  150.    else
  151.    begin
  152.       subprocess := exitstat and $FF;
  153.       
  154.       if exitstat <> 0 then
  155.          writeln(whoami, ':  Abnormal program exit, code=', exitstat, '.');
  156.    end;
  157. end;                       { SubProcess }
  158.