[Back to DOS SWAG index]  [Back to Main SWAG index]  [Original]

{
> Who has PTENV.PAS

Here is how it works:
}
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 : $2C];
  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.

[Back to DOS SWAG index]  [Back to Main SWAG index]  [Original]