home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MADTRB13.ZIP / EXEC3.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-01-18  |  12.6 KB  |  321 lines
  1. { EXEC.PAS version 1.5
  2.   Copyright (C) 1986 by Bela Lubkin  (1/14/86)
  3.   Noncommercial use only EXCEPT with permission from Bela Lubkin; send
  4.   EasyPlex to ID 76703,3015 for permission.
  5.  
  6.   See "VERY IMPORTANT NOTES" below before using these functions.
  7.   REQUIRES Turbo Pascal version 3.0 (may work with later versions, when they
  8.   appear)
  9.  
  10.   Allows you to
  11.     o Call MS-DOS programs
  12.     o Get the return codes from those programs
  13.     o Get strings from the MS-DOS environment
  14.  
  15.   Calling information
  16.   -------------------
  17.     Function SubProcess(CommandLine: _Exec_Str255): Integer;
  18.         Calls an executable image (.COM or .EXE file) using MS-DOS function
  19.       4Bh, Exec.  The parameter CommandLine must contain both the name of the
  20.       program to run and the arguments to be passed to it, seperated by a
  21.       space.  Path searching and other amenities are not performed; the passed
  22.       in name must be specific enough to allow the file to be found, i.e.
  23.       'CHKDSK' will NOT work.  At least 'CHKDSK.COM' must be specified, and a
  24.       drive and path name will help even more.  For example,
  25.         'C:\SYSTEM\CHKDSK.COM'
  26.         'A:\WS.COM DOCUMENT.1'
  27.         'C:\DOS\LINK.EXE TEST;'
  28.         'D:\ASSEM\MASM.EXE PROG1 PROG1.OBJ NUL PROG1.MAP'
  29.         'C:\COMMAND.COM /C COPY *.* B:\BACKUP >FILESCOP.IED'
  30.         The last example uses COMMAND.COM to invoke a DOS internal command and
  31.       to perform redirection.  Only with the use of COMMAND.COM can the
  32.       following be done: redirection; piping; path searching; searching for
  33.       the extension of a program (.COM, .EXE, or .BAT); batch files; and
  34.       internal DOS commands.
  35.         Because the COMMAND-assisted Exec function is so useful, a seperate
  36.       function, SubProcessViaCOMMAND, is provided for that purpose.
  37.         The integer return value of SubProcess is the error value returned by
  38.       DOS on completion of the Exec call.  If it is nonzero, the call failed.
  39.       Here is a list of likely error values:
  40.          0: Success
  41.          2: File/path not found
  42.          3: Path not found
  43.          4: Too many files open (no handles left)
  44.          5: Access denied
  45.          8: Not enough memory to load program
  46.         10: Illegal environment (greater than 32K)
  47.         11: Illegal .EXE file format
  48.         32: Sharing violation
  49.         33: Lock violation
  50.       If you get any other result, consult an MS-DOS Technical Reference
  51.       manual.
  52.  
  53.     Function GetEnvStr(SearchString: _Exec_Str255): _Exec_Str255;
  54.         Gets a string from the MS-DOS environment.  The parameter SearchString
  55.       specifies the desired environment string.  The function result returns
  56.       the value of that string from the environment.  If the string is not
  57.       found, a null string is returned.  SearchString may have one special
  58.       value, '='.  This returns garbage under MS-DOS 2.x.  Under MS-DOS 3.x,
  59.       it returns the pathname under which the currently running program was
  60.       invoked.  Examples:
  61.         GetEnvStr('COMSPEC')   might = 'C:\COMMAND.COM'
  62.         GetEnvStr('PROMPT')    might = '$p $g'
  63.         GetEnvStr('REFLEX')    might = 'Herc'
  64.         GetEnvStr('=')         might = 'C:\TURBO\exectest.COM'
  65.       Only an exact match will succeed; case IS significant.  Do not include
  66.       an equal sign in the search string (GetEnvStr('COMSPEC=') will fail).
  67.         Note: if you are wondering why there is no SetEnvStr procedure, read
  68.       an MS-DOS Technical Reference manual.
  69.  
  70.     Function GetComSpec: _Exec_Str66;
  71.         This is a special case of GetEnvStr and simply returns the COMSPEC
  72.       environment string.  It is included for compatability with previous
  73.       EXEC.PAS versions.
  74.  
  75.     Function SubProcessViaCOMMAND(CommandLine: _Exec_Str255): Integer;
  76.         This is a special case of SubProcess.  The CommandLine is passed to
  77.       COMMAND.COM, which does all further processing.  Command lines invoked
  78.       via this procedure can do redirection and piping; undergo the normal DOS
  79.       PATH search; may be batch files; and may be internal DOS commands such
  80.       as COPY and RENAME.
  81.         Disadvantages of this approach are: a copy of COMMAND.COM must be
  82.       present (not always true on a floppy-based system); a slight time and
  83.       memory penalty is involved due to the loading of an extra copy of
  84.       COMMAND.COM (about 3K under DOS 3.1); the subprocess return code
  85.       (Errorlevel) is lost.  In most cases the benefits will outweight the
  86.       disadvantages.
  87.         The integer return code is the same as for SubProcess.
  88.         Note: you may be wondering why there is not
  89.  
  90.     Function Shell: Integer;
  91.         This is a special case of SubProcess.  It gives a DOS prompt to the
  92.       user.  Typing EXIT returns to the Turbo program.  The integer return
  93.       code is the same as for SubProcess.
  94.  
  95.     Function SubProcessReturnCode: Integer;
  96.         This function calls MS-DOS function 4Dh, Get Return Code of a
  97.       Sub-process.  The integer return value is the return code set by the
  98.       last subprocess you called.  Like Turbo's IOResult, SubProcessReturnCode
  99.       is only valid once after a SubProcess call, reverting to 0 on successive
  100.       calls.  The return code obtained after using SubProcessViaCOMMAND or
  101.       Shell is the code returned by COMMAND.COM, not by any other program, and
  102.       is not likely to be useful.
  103.         Note: Turbo programs can set the return code by using the Halt
  104.       procedure with a parameter, e.g. Halt(20);.  Other languages can call
  105.       DOS function 4Ch (Terminate) with the return code in AL.
  106.  
  107.   VERY IMPORTANT NOTES
  108.   --------------------
  109.   The Exec calls (SubProcess, SubProcessViaCOMMAND, Shell) will not work
  110.   unless you restrict Turbo's heap.  To do this, lower "mAximum dynamic free
  111.   memory" on the compiler Options menu to a reasonable value.  What is
  112.   reasonable depends on your program's use of the heap and the stack, and must
  113.   be determined by you.  If you use neither the heap nor recursion, as low as
  114.   400h (16K bytes) is probably more than enough.
  115.  
  116.   The Exec calls CANNOT be called from within the interactive Turbo compiler
  117.   system.  They can only be called from .COM or .CHN files running outside of
  118.   the Turbo environment.
  119.  
  120.   Revision history
  121.   ----------------
  122.   Version 1.5 1/14/86 fixes the memory freeing bug by removing support for
  123.               Turbo 2.0.  String types changed to minimize chances of
  124.               collision.  General environment support added.  Explicit calls
  125.               for Exec-via-COMMAND.COM and Exec-to-DOS-prompt added.  Support
  126.               for getting the subprocess return code added.  Major
  127.               documentation overhaul.  NOW REQUIRES TURBO 3.0!
  128.               (Thanks to Stu Fuller 76703,501 for pointing out how easy it
  129.               was to add full environment support).
  130.   Version 1.4 attempts to fix a bug in the freeing of memory before the
  131.               Exec call.
  132.   Version 1.3 works with MS-DOS 2.0 and up, TURBO PASCAL version 1.0 and up.
  133.   Version 1.2 had a subtle but dangerous bug: I set a variable that was
  134.               addressed relative to BP, using a destroyed BP!
  135.   Version 1.1 didn't work with Turbo 2.0 because I used Turbo 3.0 features
  136.   Version 1.0 only worked with DOS 3.0 due to a subtle bug in DOS 2.x
  137.  
  138.     -  Bela Lubkin
  139.        CompuServe 76703,3015
  140. }
  141.  
  142. Type
  143.   _Exec_Str66=String[66];
  144.   _Exec_Str255=String[255];
  145.  
  146. Function SubProcess(CommandLine: _Exec_Str255): Integer;
  147.   Const
  148.     SSSave: Integer=0;
  149.     SPSave: Integer=0;
  150.  
  151.   Var
  152.     Regs: Record Case Integer Of
  153.             1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: Integer);
  154.             2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  155.           End;
  156.     FCB1,FCB2: Array [0..36] Of Byte;
  157.     PathName: _Exec_Str66;
  158.     CommandTail: _Exec_Str255;
  159.     ParmTable: Record
  160.                  EnvSeg: Integer;
  161.                  ComLin: ^Integer;
  162.                  FCB1Pr: ^Integer;
  163.                  FCB2Pr: ^Integer;
  164.                End;
  165.     RegsFlags: Integer;
  166.  
  167.   Begin
  168.     If Pos(' ',CommandLine)=0 Then
  169.      Begin
  170.       PathName:=CommandLine+#0;
  171.       CommandTail:=^M;
  172.      End
  173.     Else
  174.      Begin
  175.       PathName:=Copy(CommandLine,1,Pred(Pos(' ',CommandLine)))+#0;
  176.       CommandTail:=Copy(CommandLine,Pos(' ',CommandLine),255)+^M;
  177.      End;
  178.     CommandTail[0]:=Pred(CommandTail[0]);
  179.     With Regs Do
  180.      Begin
  181.       FillChar(FCB1,Sizeof(FCB1),0);
  182.       AX:=$2901;
  183.       DS:=Seg(CommandTail[1]);
  184.       SI:=Ofs(CommandTail[1]);
  185.       ES:=Seg(FCB1);
  186.       DI:=Ofs(FCB1);
  187.       MsDos(Regs); { Create FCB 1 }
  188.       FillChar(FCB2,Sizeof(FCB2),0);
  189.       AX:=$2901;
  190.       ES:=Seg(FCB2);
  191.       DI:=Ofs(FCB2);
  192.       MsDos(Regs); { Create FCB 2 }
  193.       With ParmTable Do
  194.        Begin
  195.         EnvSeg:=MemW[CSeg:$002C];
  196.         ComLin:=Addr(CommandTail);
  197.         FCB1Pr:=Addr(FCB1);
  198.         FCB2Pr:=Addr(FCB2);
  199.        End;
  200.       InLine($8D/$96/ PathName /$42/  { <DX>:=Ofs(PathName[1]); }
  201.              $8D/$9E/ ParmTable /     { <BX>:=Ofs(ParmTable);   }
  202.              $B8/$00/$4B/             { <AX>:=$4B00;            }
  203.              $1E/$55/                 { Save <DS>, <BP>         }
  204.              $16/$1F/                 { <DS>:=Seg(PathName[1]); }
  205.              $16/$07/                 { <ES>:=Seg(ParmTable);   }
  206.              $2E/$8C/$16/ SSSave /    { Save <SS> in SSSave     }
  207.              $2E/$89/$26/ SPSave /    { Save <SP> in SPSave     }
  208.              $FA/                     { Disable interrupts      }
  209.              $CD/$21/                 { Call MS-DOS             }
  210.              $FA/                     { Disable interrupts      }
  211.              $2E/$8B/$26/ SPSave /    { Restore <SP>            }
  212.              $2E/$8E/$16/ SSSave /    { Restore <SS>            }
  213.              $FB/                     { Enable interrupts       }
  214.              $5D/$1F/                 { Restore <BP>,<DS>       }
  215.              $9C/$8F/$86/ RegsFlags / { Flags:=<CPU flags>      }
  216.              $89/$86/ Regs );         { Regs.AX:=<AX>;          }
  217.       { The messing around with SS and SP is necessary because under DOS 2.x,
  218.         after returning from an EXEC call, ALL registers are destroyed except
  219.         CS and IP!  I wish I'd known that before I released this package the
  220.         first time... }
  221.       If (RegsFlags And 1)<>0 Then SubProcess:=AX
  222.       Else SubProcess:=0;
  223.      End;
  224.   End;
  225.  
  226. Function GetEnvStr(SearchString: _Exec_Str255): _Exec_Str255;
  227.   Type
  228.     Env=Array [0..32767] Of Char;
  229.   Var
  230.     EPtr: ^Env;
  231.     EStr: _Exec_Str255;
  232.     Done: Boolean;
  233.     I: Integer;
  234.  
  235.   Begin
  236.     GetEnvStr:='';
  237.     If SearchString<>'' Then
  238.      Begin
  239.       EPtr:=Ptr(MemW[CSeg:$002C],0);
  240.       I:=0;
  241.       SearchString:=SearchString+'=';
  242.       Done:=False;
  243.       EStr:='';
  244.       Repeat
  245.         If EPtr^[I]=#0 Then
  246.          Begin
  247.           If EPtr^[Succ(I)]=#0 Then
  248.            Begin
  249.             Done:=True;
  250.             If SearchString='==' Then
  251.              Begin
  252.               EStr:='';
  253.               I:=I+4;
  254.               While EPtr^[I]<>#0 Do
  255.                Begin
  256.                 EStr:=EStr+EPtr^[I];
  257.                 I:=Succ(I);
  258.                End;
  259.               GetEnvStr:=EStr;
  260.              End;
  261.            End;
  262.           If Copy(EStr,1,Length(SearchString))=SearchString Then
  263.            Begin
  264.             GetEnvStr:=Copy(EStr,Succ(Length(SearchString)),255);
  265.             Done:=True;
  266.            End;
  267.           EStr:='';
  268.          End
  269.         Else EStr:=EStr+EPtr^[I];
  270.         I:=Succ(I);
  271.       Until Done;
  272.      End;
  273.   End;
  274.  
  275. Function GetComSpec: _Exec_Str66;
  276.   Begin
  277.     GetComSpec:=GetEnvStr('COMSPEC');
  278.   End;
  279.  
  280. Function SubProcessViaCOMMAND(CommandLine: _Exec_Str255): Integer;
  281.   Begin
  282.     SubProcessViaCOMMAND:=SubProcess(GetComSpec+' /C '+CommandLine);
  283.   End;
  284.  
  285. Function SubProcessReturnCode: Integer;
  286.   Var
  287.     Regs: Record Case Integer Of
  288.             1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: Integer);
  289.             2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  290.           End;
  291.   Begin
  292.     Regs.AH:=$4D;
  293.     MsDos(Regs);
  294.     SubProcessReturnCode:=Regs.AX;
  295.   End;
  296.  
  297. { Example program.  Set both mInimum and mAximum free dynamic memory to 100
  298.   and compile this to a .COM file.  Delete the next line to enable: }
  299. (*
  300.  
  301. Var Command: _Exec_Str255;
  302.     I: Integer;
  303.  
  304. Begin
  305.   WriteLn('Enter a * to quit; put a * before a command to use COMMAND.COM.');
  306.   Repeat
  307.     Write('=->');
  308.     ReadLn(Command);
  309.     If Command='*' Then Halt;
  310.     If Command<>'' Then
  311.      Begin
  312.       If Command[1]='*' Then
  313.         I:=SubProcessViaCOMMAND(Copy(Command,2,255))
  314.       Else I:=SubProcess(Command);
  315.       If I<>0 Then WriteLn('Error - ',I);
  316.       WriteLn('Return code = ',SubProcessReturnCode);
  317.      End;
  318.   Until False;
  319. End.
  320. *)
  321.