(*----------------------------------------------------------------------*) (* DosJump --- Jump to Dos *) (*----------------------------------------------------------------------*) OVERLAY PROCEDURE DosJump( Dos_String : AnyStr ); (*----------------------------------------------------------------------*) (* *) (* Procedure: DosJump; *) (* *) (* Purpose: Provides facility for jumping to DOS *) (* *) (* Calling Sequence: *) (* *) (* DosJump( Dos_String : AnyStr ); *) (* *) (* Dos_String --- DOS command to execute *) (* *) (* Calls: *) (* *) (* GetComSpec *) (* SubProcess *) (* *) (*----------------------------------------------------------------------*) VAR I: INTEGER; { EXEC.PAS version 1.3 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. Revision history ---------------- Version 1.3 works with MS-DOS 2.0 and up, TURBO PASCAL version 1.0 and up. Version 1.2 had a subtle but dangerous bug: I set a variable that was addressed relative to BP, using a destroyed BP! Version 1.1 didn't work with Turbo 2.0 because I used Turbo 3.0 features 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 } Type Str66=String[66]; Str255=String[255]; Function SubProcess(CommandLine: Str255): Integer; { Pass this function 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 third 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; and 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. } 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,FCB2: Array [0..36] Of Byte; PathName: Str66; CommandTail: Str255; ParmTable: Record EnvSeg: Integer; ComLin: ^Integer; FCB1Pr: ^Integer; FCB2Pr: ^Integer; End; I,RegsFlags: Integer; Begin (* Change cursor to block *) Regs.Ax := $0100; Regs.Cx := $0107; INTR( $10, Regs ); If Pos(' ',CommandLine)=0 Then Begin PathName:=CommandLine+#0; CommandTail:=^M; End Else Begin PathName:=Copy(CommandLine,1,Pos(' ',CommandLine)-1)+#0; CommandTail:=Copy(CommandLine,Pos(' ',CommandLine),255)+^M; End; 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; InLine($8D/$96/ PathName /$42/ { :=Ofs(PathName[1]); } $8D/$9E/ ParmTable / { :=Ofs(ParmTable); } $B8/$00/$4B/ { :=$4B00; } $1E/$55/ { Save , } $16/$1F/ { :=Seg(PathName[1]); } $16/$07/ { :=Seg(ParmTable); } $2E/$8C/$16/ SSSave / { Save in SSSave } $2E/$89/$26/ SPSave / { Save in SPSave } $FA/ { Disable interrupts } $CD/$21/ { Call MS-DOS } $FA/ { Disable interrupts } $2E/$8B/$26/ SPSave / { Restore } $2E/$8E/$16/ SSSave / { Restore } $FB/ { Enable interrupts } $5D/$1F/ { Restore , } $9C/$8F/$86/ RegsFlags / { Flags:= } $89/$86/ Regs ); { Regs.AX:=; } { 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 (RegsFlags And 1)<>0 Then SubProcess:=AX Else SubProcess:=0; End; (* Change cursor back to underline *) Regs.Ax := $0100; Regs.Cx := $0607; INTR( $10, Regs ); End; 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; EStr:=''; End Else EStr:=EStr+EPtr^[I]; I:=I+1; Until Done; End; BEGIN (* DosJump *) WRITELN; WRITELN('Jump to DOS: Enter EXIT to return to PibTerm'); (* Close capture file *) IF Capture_On THEN (*$I-*) CLOSE( Capture_File ); (*$I+*) I := Int24Result; (* Remove Int 24 error handler *) Int24OFF; IF LENGTH( Dos_String ) > 0 THEN I := SubProcess( GetComSpec + ' /C ' + Dos_String ) ELSE I := SubProcess( GetComSpec ); (* Restore Int24 Error handler *) Int24ON; WRITELN('Back to PibTerm, DOS return code is ',I); (* Reopen capture file for append *) IF Capture_On THEN BEGIN ASSIGN( Capture_File , Capture_File_Name ); (*$I-*) APPEND( Capture_File ); (*$I+*) IF Int24Result <> 0 THEN BEGIN WRITELN('Could not re-open capture file ', Capture_File_Name,' for append,'); WRITELN('Capture option TURNED OFF.'); Capture_On := FALSE; DELAY( Two_Second_Delay ); END; END; END (* DosJump *);