SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00005 EXECUTION ROUTINES 1 05-28-9313:45ALL SWAG SUPPORT TEAM EXECHILD.PAS IMPORT 35 U^á (* This unit lets you execute any child program and redirect theπ child program output to NUL / PRN / CON or file.π It's very simple to use (look at the EXAMPLE.PAS).π This source is completlly freeware but make sure to removeπ this remark if any changes are made I don't want anyone toπ spread his bugs with my source.π Of course any suggestions are welcome as well as questionsπ about the source.ππ Written by Schwartz Gabriel. 20/03/1993.π Anyone who has any question can leave me a message at π CompuServe to EliaShim address 100320,36π*)ππ{$A+,B-,D-,E-,F+,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+,Y+}ππUnit Redir;ππInterfaceππVarπ IOStatus : Integer;π RedirError : Integer;π ExecuteResult : Word;ππ{------------------------------------------------------------------------------}πprocedure Execute (ProgName, ComLine, Redir: String);π{------------------------------------------------------------------------------}ππImplementationππUses DOS;ππTypeπ PMCB = ^TMCB;π TMCB = recordπ Typ : Char;π Owner : Word;π Size : Word;π end;ππ PtrRec = recordπ Ofs, Seg : Word;π end;ππ THeader = recordπ Signature : Word;π PartPag : Word;π PageCnt : Word;π ReloCnt : Word;π HdrSize : Word;π MinMem : Word;π MaxMem : Word;π ReloSS : Word;π ExeSP : Word;π ChkSum : Word;π ExeIP : Word;π ReloCS : Word;π TablOff : Word;π OverNo : Word;π end;ππVarπ PrefSeg : Word;π MinBlockSize : Word;π MCB : PMCB;π FName : PathStr;π F : File;π MyBlockSize : Word;π Header : THeader;ππ{------------------------------------------------------------------------------}ππprocedure Execute (ProgName, ComLine, Redir: String);ππtypeπ PHandles = ^THandles;π THandles = Array [Byte] of Byte;ππ PWord = ^Word;ππvarπ RedirChanged : Boolean;π Handles : PHandles;π OldHandle : Byte;ππ {............................................................................}ππ function ChangeRedir : Boolean;ππ beginπ ChangeRedir:=False;π If Redir = '' then Exit;π Assign (F, Redir);π Rewrite (F);π RedirError:=IOResult;π If IOStatus <> 0 then Exit;π Handles:=Ptr (PrefixSeg, PWord (Ptr (PrefixSeg, $34))^);π OldHandle:=Handles^[1];π Handles^[1]:=Handles^[FileRec (F).Handle];π ChangeRedir:=True;π end;ππ {............................................................................}ππ procedure CompactHeap;ππ varπ Regs : Registers;ππ beginπ Regs.AH:=$4A;π Regs.ES:=PrefSeg;π Regs.BX:=MinBlockSize + (PtrRec (HeapPtr).Seg - PtrRec (HeapOrg).Seg);π MsDos (Regs);π end;ππ {............................................................................}ππ procedure DosExecute;ππ Beginπ SwapVectors;π Exec (ProgName, ComLine);π IOStatus:=DosError;π ExecuteResult:=DosExitCode;π SwapVectors;π End;ππ {............................................................................}ππ procedure ExpandHeap;ππ varπ Regs : Registers;ππ beginπ Regs.AH:=$4A;π Regs.ES:=PrefSeg;π Regs.BX:=MyBlockSize;π MsDos (Regs);π end;ππ {............................................................................}ππ procedure RestoreRedir;ππ beginπ If not RedirChanged then Exit;π Handles^[1]:=OldHandle;π Close (F);π end;ππ {............................................................................}ππBeginπ RedirError:=0;π RedirChanged:=ChangeRedir;π CompactHeap;π DosExecute;π Expandheap;π RestoreRedir;πEnd;ππ{------------------------------------------------------------------------------}ππBeginπ SetCBreak (False);π FName:=ParamStr (0);π Assign (F, FName);π Reset (F, 1);π IOStatus:=IOResult;π If IOStatus = 0 thenπ beginπ BlockRead (F, Header, SizeOf (Header));π IOStatus:=IOResult;π If IOStatus = 0 then MinBlockSize:=Header.PageCnt * 32 + Header.MinMem + 1π Else MinBlockSize:=$8000;π Close (F);π endπ Else MinBlockSize:=$8000;π PtrRec (MCB).Seg:=PrefixSeg - 1;π PtrRec (MCB).Ofs:=$0000;π MyBlockSize:=MCB^.Size;π PrefSeg:=PrefixSeg;πEnd.π 2 05-28-9313:45ALL SWAG SUPPORT TEAM EXECINFO.PAS IMPORT 3 U!ô {$M 4096,0,4096}ππUsesπ Dos, Prompt;ππbeginπ ChangeShellPrompt('Hi There');π SwapVectors;π Exec(GetEnv('COMSPEC'),'');π SwapVectors;πend. 3 05-28-9313:45ALL SWAG SUPPORT TEAM PROMPT.PAS IMPORT 23 Uö' {$A+,B-,F-,L-,N-,O-,R-,S-,V-}ππUnit prompt;ππ{ππAuthor: Trevor J Carlsenπ PO Box 568π Port Hedlandπ Western Australia 6721π 61-[0]-91-73-2026 (voice)π 61-[0]-91-73-2930 (data )π πReleased into the public domain.ππThis Unit will automatically create a predefined prompt when shelling to Dos.πif you wish to create your own custom prompt, all that is required is to giveπthe Variable NewPrompt another value and call the Procedure ChangeShellPrompt.ππ}ππInterfaceππUses Dos;ππVarπ NewPrompt : String;ππProcedure ChangeShellPrompt(Nprompt: String);ππImplementationππ Typeπ EnvArray = Array[0..32767] of Byte;π EnvPtr = ^EnvArray;π Varπ EnvSize, EnvLen, EnvPos: Word;π NewEnv, OldEnv : EnvPtr;π TempStr : String;π x : Word;ππ Procedure ChangeShellPrompt(Nprompt: String);ππ Function MainEnvSize: Word;π Varπ x : Word;π found : Boolean;π beginπ found := False; x := 0;π Repeatπ if (OldEnv^[x] = 0) and (OldEnv^[x+1] = 0) thenπ found := Trueπ elseπ inc(x);π Until found;π MainEnvSize := x - 1;π end; { MainEnvSize}ππ Procedure AddEnvStr(Var s; Var offset: Word; len: Word);π Var st : EnvArray Absolute s;π beginπ move(st[1],NewEnv^[offset],len);π inc(offset,len+1);π end;ππ beginπ OldEnv := ptr(MemW[PrefixSeg:$2C],0);π { this gets the actual starting segment of the current Program's env }ππ EnvSize := MemW[seg(OldEnv^)-1:3] shl 4;π { Find the size of the current environment }ππ if MaxAvail < (EnvSize+256) then beginπ Writeln('Insufficient memory');π halt;π end;ππ GetMem(NewEnv, EnvSize + $100);π if ofs(NewEnv^) <> 0 then beginπ inc(LongInt(NewEnv),$10000 + ($10000 * (LongInt(NewEnv) div 16)));π LongInt(NewEnv) := LongInt(NewEnv) and $ffff0000;π end;π FillChar(NewEnv^,EnvSize + $100,0);π { Allocate heap memory For the new environment adding enough to allow }π { alignment to a paraGraph boundary or a longer prompt than the default }π { and initialise to nuls }π EnvPos := 0;ππ AddEnvStr(Nprompt,EnvPos,length(Nprompt));π For x := 1 to EnvCount do beginπ TempStr := EnvStr(x);π if TempStr <> GetEnv('PROMPT') thenπ AddEnvStr(TempStr,EnvPos,length(TempStr));π end; { For }π inc(EnvPos);π { Transfer old env Strings except the prompt to new environment }ππ if lo(DosVersion) > 2 thenπ AddEnvStr(OldEnv^[MainEnvSize + 2],EnvPos,EnvSize-(MainEnvSize + 2));π { Add the rest of the environment }ππ MemW[PrefixSeg:$2C] := seg(NewEnv^);π { let the Program know where the new environment is }π end; { ChangeShellPrompt }ππend. { prompt }π π 4 08-17-9308:51ALL SWAG SUPPORT TEAM Demonstrates DOS Exec IMPORT 18 U {$M 8192,0,0}π{* This memory directive is used to makeπ certain there is enough memory leftπ to execute the DOS shell and anyπ other programs needed. *}ππProgram EXEC_Demo;ππ{*ππ EXEC.PASππ This program demonstrates the use ofπ Pascal's EXEC function to executeπ either an individual DOS command orπ to move into a DOS Shell.ππ You may enter any command you couldπ normally enter at a DOS prompt andπ it will execute. You may also hitπ RETURN without entering anything andπ you will enter into a DOS Shell, fromπ which you can exit by typing EXIT.ππ The program stops when you hit aπ 'Q', upper or lower case.π*}πππUses Crt, Dos;ππVarπ Command : String;ππ{**************************************}πProcedure Do_Exec; {*******************}ππ Varπ Ch : Char;ππ Beginπ If Command <> '' Thenπ Command := '/C' + Commandπ Elseπ Writeln('Type EXIT to return from the DOS Shell.');π {* The /C prefix is needed toπ execute any command other thanπ the complete DOS Shell. *}ππ SwapVectors;π Exec(GetEnv('COMSPEC'), Command);π {* GetEnv is used to read COMSPECπ from the DOS environment so theπ program knows the correct pathπ to COMMAND.COM. *}ππ SwapVectors;π Writeln;π Writeln('DOS Error = ',DosError);π If DosError <> 0 Thenπ Writeln('Could not execute COMMAND.COM');π {* We're assuming that the onlyπ reason DosError would be somethingπ other than 0 is if it couldn'tπ find the COMMAND.COM, but thereπ are other errors that can occur,π we just haven't provided for themπ here. *}ππ Writeln;π Writeln;π Writeln('Hit any key to continue...');π Ch := ReadKey;π End;πππFunction Get_Command : String;ππ Varπ Count : Integer;π Cmnd : String;ππ Beginπ Clrscr;π Write('Enter DOS Command (or Q to Quit): ');π Readln(Cmnd);π Get_Command := Cmndπ End;ππBeginπ Command := Get_Command;π While NOT ((Command = 'Q') OR (Command = 'q')) Doπ Beginπ Do_Exec;π Command := Get_Commandπ End;πEnd. 5 08-27-9321:37ALL KELD R. HANSEN Exec with Memory Shrink IMPORT 12 U (*πKELD R. HANSENππ> I need to *simulate* something like:π> {$M 16384,0,0} {reduce heap}π> Exec('c:\myprgm.exe',''); {run myprgm.exe}π> {$M 16384,110000,110000} {restore heap}ππEXECUTE shrinks your programs memory allocation to the smallest possible value,πthen runs the program and then expands it back up again. Works in TP 6.0 andπ7.0!π*)ππUSESπ DOS;ππTYPEπ STR127 = STRING[127];ππPROCEDURE ReallocateMemory(P : POINTER); ASSEMBLER;πASMπ MOV AX, PrefixSegπ MOV ES, AXπ MOV BX, WORD PTR P+2π CMP WORD PTR P,0π JE @OKπ INC BXππ @OK:π SUB BX, AXπ MOV AH, 4Ahπ INT 21hπ JC @Xπ LES DI, Pπ MOV WORD PTR HeapEnd,DIπ MOV WORD PTR HeapEnd+2,ESππ @X:πEND;ππFUNCTION EXECUTE(Name : PathStr ; Tail : STR127) : WORD; ASSEMBLER;πASMπ {$IFDEF CPU386}π DB 66hπ PUSH WORD PTR HeapEndπ DB 66hπ PUSH WORD PTR Nameπ DB 66hπ PUSH WORD PTR Tailπ DB 66hπ PUSH WORD PTR HeapPtrπ {$ELSE}π PUSH WORD PTR HeapEnd+2π PUSH WORD PTR HeapEndπ PUSH WORD PTR Name+2π PUSH WORD PTR Nameπ PUSH WORD PTR Tail+2π PUSH WORD PTR Tailπ PUSH WORD PTR HeapPtr+2π PUSH WORD PTR HeapPtrπ {$ENDIF}π CALL ReallocateMemoryπ CALL SwapVectorsπ CALL DOS.EXECπ CALL SwapVectorsπ CALL ReallocateMemoryπ MOV AX, DosErrorπ OR AX, AXπ JNZ @OUTπ MOV AH, 4Dhπ INT 21hππ @OUT:πEND;π
