Contributor: RUUD UPHOFF
{
From: RUUD UPHOFF Refer#: NONE
Subj: TPENV.PAS Conf: (1221) F-PASCAL
---------------------------------------------------------------------------
}
UNIT SetEnvir;
INTERFACE
USES
DOS;
TYPE
EnvSize = 0..16383;
PROCEDURE SetEnv( EnvVar,Value : STRING);
{-----------------------------------------------------------------------
{ This procedure may be used to setup or change environment variables
{ in the environment of the resident copy of COMMAND.COM or 4DOS.COM
{
{ Note that this will be the ACTIVE copy of the command interpreter, NOT
{ the primary copy!
{
{ This unit is not tested under DR-DOS.
{
{ Any call of SetEnv must be followed by checking ioresult. The procedure
{ may return error 8 (out of memory) on too less space in te environment.
{-----------------------------------------------------------------------}
IMPLEMENTATION
PROCEDURE SetEnv( EnvVar, Value : STRING);
VAR
Link,
PrevLink,
EnvirP : word;
Size,
Scan,
Where,
Dif : integer;
NewVar,
OldVar,
Test : STRING;
FUNCTION CheckSpace(Wanted : integer) : boolean;
BEGIN
IF wanted+Scan> Size THEN
inoutres:=8;
CheckSpace := inoutres=0
END;
BEGIN
IF inoutres>0 THEN
Exit;
FOR Scan := 1 TO Length(EnvVar) DO
EnvVar[Scan] := UpCase(EnvVar[Scan]);
EnvVar := EnvVar + '=';
NewVar := EnvVar + Value + #0;
link := PrefixSeg;
REPEAT
PrevLink := Link;
Link := memw [link : 16ドル]
UNTIL Link = prevlink;
EnvirP := memw [Link : 2ドルC];
Size := memw [Envirp-1 : 03ドル] * 16;
Scan := 0;
Where := -1;
WHILE mem[EnvirP : Scan] 0 DO
BEGIN
move( mem[EnvirP : scan], Test[1], 255);
Test[0] := #255;
Test[0] := chr(pos(#0,Test));
IF pos(EnvVar, Test) =1 THEN
BEGIN
Where := Scan;
OldVar := Test
END;
Scan := Scan + Length(Test)
END;
IF Where = -1 THEN
BEGIN
Where := Scan;
NewVar := NewVar + #0#0#0;
IF NOT CheckSpace( Length(NewVar) ) THEN
Exit
END
ELSE
BEGIN
Dif := Length(NewVar) - Length(OldVar);
IF Dif>0 THEN
BEGIN
IF NOT CheckSpace(Dif) THEN
Exit;
move( mem[ EnvirP : Where ],
mem[ EnvirP : Where + Dif ],
Scan-Where+3)
END
ELSE IF Dif <0 THEN
move( mem[ EnvirP : Where - Dif ],
mem[ EnvirP : Where ],
Size-Where+Dif)
END;
move( NewVar[1], mem[EnvirP : Where], Length(NewVar) )
END;
END.