pier@ur-tut.UUCP (Pierre Darmon) (12/17/85)
Here's pipdodos.pas:
(*$V-,R-*)
PROGRAM PibDoDos;
(*--------------------------------------------------------------------------*)
(* *)
(* Program: PibDoDos v1.1 *)
(* *)
(* Purpose: Demonstrate TURBORUN.COM, an assembler routine to *)
(* execute DOS commands. *)
(* *)
(* Author: Philip R. Burns *)
(* Version: 1.0 *)
(* Date: April, 1985 *)
(* *)
(* Author: Thomas P. Devitt *)
(* Version: 1.1 *)
(* Date: April 28, 1985 *)
(* Changes: {*} *)
(* *)
(* Credits: The external routine TURBORUN.COM was written by *)
(* John Cooper and John Falconer. *)
(* *)
(* TURBORUN should be available on the same BBS as you found *)
(* this program on. *)
(* *)
(* Remarks: This program demonstrates the external routine TURBORUN *)
(* which allows Turbo Pascal programs to execute DOS commands *)
(* or other programs dynamically. The environment string is *)
(* searched for COMSPEC= to obtain the current setting of *)
(* COMMAND.COM. Then a prompt is issued for a command to be *)
(* executed. The command is passed to DOS for execution, if *)
(* possible, and then control returns to this program. The *)
(* prompt for a new command is issued, and this continues *)
(* until the command 'END' (in all capital letters) is *)
(* entered. *)
(* *)
(* Note: Entering a null line invokes a secondary copy of *)
(* the DOS command processor. Enter an EXIT to get *)
(* back to this program. *)
(* *)
(* Glitches: DOS may freeze up if there is not enough memory to execute *)
(* the command, or if the command clobbers memory that does *)
(* not belong to it. In these cases, a re-boot is needed. *)
(* *)
(* Note: You should compile this to a .COM file, and set *)
(* the maximum heap size (A----) so that there is *)
(* enough memory for the program to be executed. *)
(* *)
(*--------------------------------------------------------------------------*)
(* *)
(* Send comments, suggestions, etc. to PHILIP BURNS on either of the *)
(* following two Chicago BBSs: *)
(* *)
(* Gene Plantz's BBS (312) 882 4227 *)
(* Ron Fox's BBS (312) 940 6496 *)
(* *)
(*--------------------------------------------------------------------------*)
CONST
NUL = #00 (* Terminator for DOS Ascii z-strings *);
TYPE
AnyStr = STRING[255];
Char_Array = ARRAY[1..1] OF CHAR;
Char_Ptr = ^Char_Array;
VAR
Command_Line: AnyStr (* Command to be executed *);
Return_Code: INTEGER (* DOS return code *);
ComSpec: AnyStr (* Comspec from DOS environment *);
{*}
(*--------------------------------------------------------------------------*)
(* RunExt is no longer the first item of user code. *)
(* *)
(* This function converts any string to upercase. *)
(*--------------------------------------------------------------------------*)
FUNCTION UpCaseStr(S : AnyStr): AnyStr;
var
i : integer;
begin
for i := 1 to length(S) do
S[i] := UpCase(S[i]);
UpCaseStr := S;
end;
{*}
(*--------------------------------------------------------------------------*)
(* RunExt --- invoke external assembler program to execute DOS command *)
(*--------------------------------------------------------------------------*)
PROCEDURE RunExt( VAR Ret_Code: INTEGER;
VAR Command_Line );
(*--------------------------------------------------------------------------*)
(* *)
(* Procedure: RunExt (EXTERNAL ASM) *)
(* *)
(* Purpose: Performs DOS execute on given command *)
(* *)
(* Calling Sequence: *)
(* *)
(* RunExt( VAR Ret_Code: INTEGER; VAR Command_Line ); *)
(* *)
(* Ret_Code --- return code from DOS. *)
(* Command_Line --- contains command to be executed. *)
(* If parameter passed is a string, then *)
(* be sure to specify 'Command_Line[1]' as *)
(* the actual argument. *)
(* *)
(* Remarks: *)
(* *)
(* This routine is an external assembler routine. *)
(* *)
(*--------------------------------------------------------------------------*)
EXTERNAL 'TURBORUN.COM';
(*--------------------------------------------------------------------------*)
(* Get_ComSpec --- Get location of Command.Com from environment *)
(*--------------------------------------------------------------------------*)
PROCEDURE Get_ComSpec( VAR ComSpec: AnyStr );
(*--------------------------------------------------------------------------*)
(* *)
(* Procedure: Get_ComSpec *)
(* *)
(* Purpose: Gets location of COMMAND.COM from DOS environment *)
(* *)
(* Calling Sequence: *)
(* *)
(* Get_Comspec( VAR ComSpec: AnyStr ); *)
(* *)
(* ComSpec --- Returned file specification for COMMAND.COM *)
(* in 'drive:\directory\COMMAND.COM' form. *)
(* *)
(* Calls: None *)
(* *)
(* Remarks: *)
(* *)
(* This routine assumes that the COMSPEC= parameter actually exists *)
(* in the environment (it should). *)
(* *)
(*--------------------------------------------------------------------------*)
CONST
ComSpec_String: String[7] = 'OMSPEC=';
VAR
Env_Ptr: Char_Ptr;
Env_Pos: INTEGER;
Env_Found: BOOLEAN;
Spec_Pos: INTEGER;
I: INTEGER;
BEGIN (* Get_ComSpec *)
(* Initialize ComSpec to null string *)
ComSpec := '';
(* Pick up starting address, offset of *)
(* DOS environment string. *)
Env_Ptr := PTR( MEMW[ CSEG: $2C] , 0 );
Env_Pos := 0;
(* Search for COMSPEC= in environment. *)
(* Following will be file definition of *)
(* COMMAND.COM. *)
REPEAT
(* Look for initial 'C' of 'COMSPEC=' *)
WHILE( Env_Ptr^[Env_Pos] <> 'C' ) DO
Env_Pos := Env_Pos + 1;
(* Flag indicating environment string *)
(* has been found -- assume TRUE to *)
(* start *)
Env_Found := TRUE;
I := 1;
(* Check characters after 'C'. Are they *)
(* 'OMSPEC=' ? *)
WHILE ( Env_Found AND ( I < 8 ) ) DO
IF Env_Ptr^[Env_Pos + I] = ComSpec_String[ I ] THEN
I := I + 1
ELSE
Env_Found := FALSE;
Spec_Pos := Env_Pos + I;
(* If 'OMSPEC=' found, then we found *)
(* the comspec. If not, keep going. *)
IF ( I = 8 ) THEN
Env_Found := TRUE
ELSE
BEGIN
WHILE ( Env_Ptr^[Spec_Pos] <> NUL ) DO
Spec_Pos := Spec_Pos + 1;
Env_Pos := Spec_Pos;
END;
UNTIL Env_Found;
(* Pick up the COMMAND.COM definition *)
(* following the COMSPEC=. *)
WHILE ( Env_Ptr^[Spec_Pos] <> NUL ) DO
BEGIN
ComSpec := ComSpec + Env_Ptr^[Spec_Pos];
Spec_Pos := Spec_Pos + 1;
END;
END (* Get_ComSpec *);
(*--------------------------------------------------------------------------*)
BEGIN (* PibDoDos -- Main Program *)
(* Obtain location of Command.Com *)
Get_ComSpec( ComSpec );
Writeln('Comspec = ',ComSpec);
(* Read commands until 'END' entered *)
REPEAT
WRITELN;
WRITE('Enter command or END to stop: ');
READLN( Command_Line );
{*} Command_Line := UpCaseStr(Command_Line); {*}
IF Command_Line <> 'END' THEN
BEGIN
(* Prefix comspec to command line *)
IF LENGTH( Command_Line ) > 0 THEN
Command_Line := ComSpec + ' /C ' + Command_Line + NUL
ELSE
Command_Line := ComSpec + NUL;
(* Execute the command *)
RunExt( Return_Code , Command_Line[1] );
END;
UNTIL ( Command_Line = 'END' );
END (* PibDoDos *).
-------
Pierre Darmon
University of Rochester
{allegra|decvax|seismo}!rochester!ur-tut!pier