Contributor: SWAG SUPPORT TEAM
{
The following TP code assigns a new Environment to the COMMand.COM
which is invoked by TP's EXEC Function. In this Case, it is used
to produce a Dos PROMPT which is different from the one in the Master
Environment. Control is returned when the user Types Exit ...
}
{ Reduce Retained Memory }
{$M 2048,0,0}
Program NewEnv;
Uses
Dos;
Type
String128 = String[128];
Const
NewPrompt =
'PROMPT=$e[32mType Exit to Return to The Fitness Profiler$e[0m$_$_$p$g' + #0;
Var
EnvironNew,
EnvironOld,
offsetN,
offsetO,
SegBytes : Word;
TextBuff : String128;
Found,
Okay : Boolean;
Reg : Registers;
Function AllocateSeg( BytesNeeded : Word ) : Word;
begin
Reg.AH := 48ドル;
Reg.BX := BytesNeeded div 16;
MsDos( Reg );
if Reg.Flags and FCarry 0 then
AllocateSeg := 0
else
AllocateSeg := Reg.AX;
end {AllocateSeg};
Procedure DeAllocateSeg( AllocSeg : Word; Var okay : Boolean );
begin
Reg.ES := AllocSeg;
Reg.AH := 49ドル;
MsDos( Reg );
if Reg.Flags and FCarry 0 then
okay := False
else
okay := True;
end {DeAllocateSeg};
Function EnvReadLn( EnvSeg : Word; Var Envoffset : Word ) : String128;
Var
tempstr : String128;
loopc : Byte;
begin
loopc := 0;
Repeat
inC( loopc );
tempstr[loopc] := CHR(Mem[EnvSeg:Envoffset]);
inC( Envoffset );
Until tempstr[loopc] = #0;
tempstr[0] := CHR(loopc); {set str length}
EnvReadLn := tempstr
end {ReadEnvLn};
Procedure EnvWriteLn( EnvSeg : Word; Var Envoffset : Word;
AsciizStr : String );
Var
loopc : Byte;
begin
For loopc := 1 to Length( AsciizStr ) do
begin
Mem[EnvSeg:Envoffset] := orD(AsciizStr[loopc]);
inC( Envoffset )
end
end {EnvWriteLn};
begin {main}
WriteLn(#10,'NewEnv v0.0 Dec.25.91 Greg Vigneault');
SegBytes := 1024; { size of new environment (up to 32k)}
EnvironNew := AllocateSeg( SegBytes );
if EnvironNew = 0 then
begin { asked For too much memory? }
WriteLn('Can''t allocate memory segment Bytes.',#7);
Halt(1)
end;
EnvironOld := MemW[ PrefixSeg:002ドルc ]; { current environ }
{ copy orig env, but change the PROMPT command }
Found := False;
offsetO := 0;
offsetN := 0;
Repeat { copy one env Var at a time, old env to new env}
TextBuff := EnvReadLn( EnvironOld, offsetO );
if offsetO>= SegBytes then
begin { not enough space? }
WriteLn('not enough new Environment space',#7);
DeAllocateSeg( EnvironNew, okay );
Halt(2) { abort to Dos }
end;
{ check For the PROMPT command String }
if Pos('PROMPT=',TextBuff) = 1 then
begin { prompt command? }
TextBuff := NewPrompt; { set new prompt }
Found := True;
end;
{ now Write the Variable to new environ }
EnvWriteLn( EnvironNew, offsetN, TextBuff );
{ loop Until all Variables checked/copied }
Until Mem[EnvironOld:offsetO] = 0;
{ if no prompt command found, create one }
if not Found then
EnvWriteLn( EnvironNew, offsetN, NewPrompt );
Mem[EnvironNew:offsetN] := 0; { delimit new environ}
MemW[ PrefixSeg:2ドルc ] := EnvironNew; { activate new env }
WriteLn( #10, '....Type Exit to return to normal prompt...' );
SwapVectors;
Exec( GetEnv('COMSPEC'),'/S'); {shell to Dos w/ new prompt}
SwapVectors;
MemW[ PrefixSeg:2ドルc ] := EnvironOld; { restore original env}
DeAllocateSeg( EnvironNew, okay );
if not okay then
WriteLn( 'Could not release memory!',#7 );
end {NewEnv}.
(*******************************************************************)