ted@imsvax.UUCP (02/16/87)
At least two people have requested a copy of a TP fork/exec routine. This
one is available on many BBS's and appears to have originated at Borland
and to have been fine-tuned at one or two other sites.
{ 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.