home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / EXEC.ZIP / EXEC.PAS
Encoding:
Pascal/Delphi Source File  |  1985-04-29  |  6.8 KB  |  194 lines
  1. { EXEC.PAS version 1.1
  2.  
  3.   This file contains 2 functions for Turbo Pascal that allow you to run other
  4.   programs from within a Turbo program.  The first function, SubProcess,
  5.   actually calls up a different program using MS-DOS call 4BH, EXEC.  The
  6.   second function, GetComSpec, returns the path name of the command
  7.   interpreter, which is necessary to do certain operations.  There is also a
  8.   main program that allows you to test the functions.
  9.  
  10.   Version 1.1 works with DOS 2.0 and 2.1.  Version 1.0 only worked with DOS
  11.   3.0 due to a subtle bug in DOS 2.x.
  12.  
  13.     -  Bela Lubkin
  14.        Borland International Technical Support
  15.        CompuServe 71016,1573
  16. }
  17.  
  18. Type
  19.   Str66=String[66];
  20.   Str255=String[255];
  21.  
  22. Function SubProcess(CommandLine: Str255): Integer;
  23.   { Pass this function a string of the form
  24.       'D:\FULL\PATH\NAME\OF\FILE.TYP parameter1 parameter2 ...'
  25.  
  26.     For example,
  27.       'C:\SYSTEM\CHKDSK.COM'
  28.       'A:\WS.COM DOCUMENT.1'
  29.       'C:\DOS\LINK.EXE TEST;'
  30.       'C:\COMMAND.COM /C COPY *.* B:\BACKUP >FILESCOP.IED'
  31.  
  32.     The third example shows several things.  To do any of the following, you
  33.     must invoke the command processor and let it do the work: redirection;
  34.     piping; path searching; searching for the extension of a program (.COM,
  35.     .EXE, or .BAT); batch files; and internal DOS commands.  The name of the
  36.     command processor file is stored in the DOS environment.  The function
  37.     GetComSpec in this file returns the path name of the command processor.
  38.     Also note that you must use the /C parameter or COMMAND will not work
  39.     correctly.  You can also call COMMAND with no parameters.  This will allow
  40.     the user to use the DOS prompt to run anything (as long as there is enough
  41.     memory).  To get back to your program, he can type the command EXIT.
  42.  
  43.     Actual example:
  44.       I := SubProcess(GetComSpec+' /C COPY *.* B:\BACKUP >FILESCOP.IED');
  45.  
  46.     The value returned is the result returned by DOS after the EXEC call.  The
  47. è    most common values are:
  48.  
  49.        0: Success
  50.        1: Invalid function (should never happen with this routine)
  51.        2: File/path not found
  52.        8: Not enough memory to load program
  53.       10: Bad environment (greater than 32K)
  54.       11: Illegal .EXE file format
  55.  
  56.     If you get any other result, consult an MS-DOS Technical Reference manual.
  57.  
  58.     VERY IMPORTANT NOTE: you MUST use the Options menu of Turbo Pascal to
  59.     restrict the amount of free dynamic memory used by your program.  Only the
  60.     memory that is not used by the heap is available for use by other
  61.     programs. }
  62.  
  63.   Const
  64.     SSSave: Integer=0;
  65.     SPSave: Integer=0;
  66.  
  67.   Var
  68.     Regs: Record Case Integer Of
  69.             1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: Integer);
  70.             2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  71.           End;
  72.     FCB1,FCB2: Array [0..36] Of Byte;
  73.     PathName: Str66;
  74.     CommandTail: Str255;
  75.     ParmTable: Record
  76.                  EnvSeg: Integer;
  77.                  ComLin: ^Integer;
  78.                  FCB1Pr: ^Integer;
  79.                  FCB2Pr: ^Integer;
  80.                End;
  81.  
  82.   Begin
  83.     If Pos(' ',CommandLine)=0 Then
  84.      Begin
  85.       PathName := CommandLine+#0;
  86.       CommandTail := ^M;
  87.      End
  88.     Else
  89.      Begin
  90.       PathName := Copy(CommandLine,1,Pos(' ',CommandLine)-1)+#0;
  91.       CommandTail := Copy(CommandLine,Pos(' ',CommandLine),255)+^M;
  92.      End;
  93.     CommandTail[0] := Pred(CommandTail[0]);
  94.     With Regs Do
  95.      Begin
  96.       FillChar(FCB1,Sizeof(FCB1),0);
  97.       AX := $2901;
  98.       DS := Seg(CommandTail[1]);
  99.       SI := Ofs(CommandTail[1]);
  100.       ES := Seg(FCB1);
  101.       DI := Ofs(FCB1);
  102. è      MsDos(Regs); { Create FCB 1 }
  103.       FillChar(FCB2,Sizeof(FCB2),0);
  104.       AX := $2901;
  105.       ES := Seg(FCB2);
  106.       DI := Ofs(FCB2);
  107.       MsDos(Regs); { Create FCB 2 }
  108.       ES := CSeg;
  109.       BX := SSeg-CSeg+MemW[CSeg:MemW[CSeg:$0101]+$112];
  110.       AH := $4A;
  111.       MsDos(Regs); { Deallocate unused memory }
  112.       With ParmTable Do
  113.        Begin
  114.         EnvSeg := MemW[CSeg:$002C];
  115.         ComLin := Addr(CommandTail);
  116.         FCB1Pr := Addr(FCB1);
  117.         FCB2Pr := Addr(FCB2);
  118.        End;
  119.       InLine($8D/$96/ PathName+1 /  { <DX> := Ofs(PathName[1]); }
  120.              $8D/$9E/ ParmTable /   { <BX> := Ofs(ParmTable);   }
  121.              $B8/$00/$4B/           { <AX> := $4B00;            }
  122.              $1E/$55/               { Save <DS>, <BP>         }
  123.              $16/$1F/               { <DS> := Seg(PathName[1]); }
  124.              $16/$07/               { <ES> := Seg(ParmTable);   }
  125.              $2E/$8C/$16/ SSSave /  { Save <SS> in SSSave     }
  126.              $2E/$89/$26/ SPSave /  { Save <SP> in SPSave     }
  127.              $FA/                   { Disable interrupts      }
  128.              $CD/$21/               { Call MS-DOS             }
  129.              $FA/                   { Disable interrupts      }
  130.              $2E/$8B/$26/ SPSave /  { Restore <SP>            }
  131.              $2E/$8E/$16/ SSSave /  { Restore <SS>            }
  132.              $FB/                   { Enable interrupts       }
  133.              $9C/$8F/$86/ Regs+18 / { Flags := <CPU flags>      }
  134.              $89/$86/ Regs+0 /      { AX := <AX>;               }
  135.              $5D/$1F);              { Restore <BP>,<DS>       }
  136.       { The messing around with SS and SP is necessary because under DOS 2.x,
  137.         after returning from an EXEC call, ALL registers are destroyed except
  138.         CS and IP!  I wish I'd known that before I released this package the
  139.         first time... }
  140.       If (Flags And 1)<>0 Then SubProcess := AX
  141.       Else SubProcess := 0;
  142.      End;
  143.   End;
  144.  
  145. Function GetComSpec: Str66;
  146.   Type
  147.     Env=Array [0..32767] Of Char;
  148.   Var
  149.     EPtr: ^Env;
  150.     EStr: Str255;
  151.     Done: Boolean;
  152.     I: Integer;
  153.  
  154.   Begin
  155.     EPtr := Ptr(MemW[CSeg:$002C],0);
  156.     I := 0;
  157. è    Done := False;
  158.     EStr := '';
  159.     Repeat
  160.       If EPtr^[I]=#0 Then
  161.        Begin
  162.         If EPtr^[I+1]=#0 Then Done := True;
  163.         If Copy(EStr,1,8)='COMSPEC=' Then
  164.          Begin
  165.           GetComSpec := Copy(EStr,9,100);
  166.           Done := True;
  167.          End;
  168.         EStr := '';
  169.        End
  170.       Else EStr := EStr+EPtr^[I];
  171.       I := I+1;
  172.     Until Done;
  173.   End;
  174.  
  175. { Example program.  Set both mInimum and mAximum free dynamic memory to 100
  176.   and compile this to a .COM file.  Delete the next line to enable: }
  177. (*
  178.  
  179. Var Command: Str255;
  180.     I: Integer;
  181.  
  182. Begin
  183.   WriteLn('Enter a * to quit; put a * before a command to use COMMAND.COM.');
  184.   Repeat
  185.     Write('=->');
  186.     ReadLn(Command);
  187.     If Command='*' Then Halt;
  188.     If Command<>'' Then
  189.      Begin
  190.       If Command[1]='*' Then Command := GetComSpec+' /C '+Copy(Command,2,255);
  191.       I := SubProcess(Command);
  192.       If I<>0 Then WriteLn('Error - ',I);
  193.      End;
  194.   Until False;
  195. End.
  196. *)
  197.