home *** CD-ROM | disk | FTP | other *** search
/ The Pier Shareware 6 / The_Pier_Shareware_Number_6_(The_Pier_Exchange)_(1995).iso / 010 / jump20.zip / SETENVIR.PAS < prev   
Pascal/Delphi Source File  |  1994-10-18  |  3KB  |  131 lines
  1. UNIT   SetEnvir;
  2.  
  3. INTERFACE
  4.  
  5.  
  6.    USES
  7.              DOS;
  8.  
  9.  
  10.    TYPE
  11.              EnvSize    = 0..16383;
  12.  
  13.  
  14.    PROCEDURE SetEnv( EnvVar,Value : STRING);
  15.  
  16.      {-----------------------------------------------------------------------
  17. { This procedure may be used to setup or change environment variables
  18. { in the environment of the resident copy of COMMAND.COM or 4DOS.COM
  19. {
  20. { Note that this will be the ACTIVE copy of the command interpreter, NOT
  21. { the primary copy!
  22. {
  23. { This unit is not tested under DR-DOS.
  24. {
  25. { Any call of SetEnv must be followed by checking ioresult. The procedure
  26. { may return error 8 (out of memory) on too less space in te environment.
  27. {-----------------------------------------------------------------------}
  28.  
  29.  
  30.  
  31.  
  32. IMPLEMENTATION
  33.  
  34.  
  35.  
  36.    PROCEDURE SetEnv( EnvVar, Value : STRING);
  37.  
  38.       VAR
  39.              Link,
  40.              PrevLink,
  41.              EnvirP   : word;
  42.  
  43.              Size,
  44.              Scan,
  45.              Where,
  46.              Dif      : integer;
  47.  
  48.              NewVar,
  49.              OldVar,
  50.              Test     : STRING;
  51.  
  52.  
  53.       FUNCTION  CheckSpace(Wanted : integer) : boolean;
  54.  
  55.       BEGIN
  56.          IF wanted+Scan > Size THEN
  57.             inoutres:=8;
  58.          CheckSpace := inoutres=0
  59.       END;
  60.  
  61.  
  62.    BEGIN
  63.       IF inoutres >0 THEN
  64.          Exit;
  65.       FOR Scan := 1 TO Length(EnvVar) DO
  66.          EnvVar[Scan] := UpCase(EnvVar[Scan]);
  67.       EnvVar := EnvVar + '=';
  68.       NewVar := EnvVar + Value + #0;
  69.       link := PrefixSeg;
  70.  
  71.       REPEAT
  72.          PrevLink := Link;
  73.          Link := memw [link : $16]
  74.       UNTIL Link = prevlink;
  75.  
  76.       EnvirP := memw [Link : $2C];
  77.       Size  := memw [Envirp-1 : $03] * 16;
  78.       Scan := 0;
  79.       Where := -1;
  80.       WHILE mem[EnvirP : Scan] <>0 DO
  81.  
  82.          BEGIN
  83.             move( mem[EnvirP : scan], Test[1], 255);
  84.             Test[0] := #255;
  85.             Test[0] := chr(pos(#0,Test));
  86.             IF pos(EnvVar, Test) =1 THEN
  87.  
  88.                BEGIN
  89.                   Where := Scan;
  90.                   OldVar := Test
  91.                END;
  92.  
  93.             Scan := Scan + Length(Test)
  94.          END;
  95.  
  96.       IF Where = -1 THEN
  97.  
  98.          BEGIN
  99.             Where := Scan;
  100.             NewVar := NewVar + #0#0#0;
  101.             IF NOT CheckSpace( Length(NewVar) ) THEN
  102.                Exit
  103.          END
  104.  
  105.       ELSE
  106.  
  107.          BEGIN
  108.             Dif := Length(NewVar) - Length(OldVar);
  109.             IF Dif >0 THEN
  110.  
  111.                BEGIN
  112.                   IF NOT CheckSpace(Dif) THEN
  113.                      Exit;
  114.                   move( mem[ EnvirP : Where ],
  115.                         mem[ EnvirP : Where + Dif ],
  116.                         Scan-Where+3)
  117.                END
  118.  
  119.             ELSE IF Dif <0 THEN
  120.                move( mem[ EnvirP : Where - Dif ],
  121.                      mem[ EnvirP : Where ],
  122.                      Size-Where+Dif)
  123.          END;
  124.  
  125.       move( NewVar[1], mem[EnvirP : Where], Length(NewVar) )
  126.    END;
  127.  
  128. END.
  129.  
  130. 
  131.