Turbo Toolbox/Turbo_Toolbox.iso/1991/09_10/tricks/environ.pas

Pascal/Delphi Source File | 1991-06-06 | 6.1 KB | 219 lines

(* ------------------------------------------------------ *)
(*                     ENVIRON.PAS                        *)
(*             Manipulationen am Environment              *)
(*          (c) 1991 Norbert Klimpel & TOOLBOX            *)
(* ------------------------------------------------------ *)
UNIT Environ;

{$R-,S-,I-,F-,O-,A-,V-,B-,N-,E-,D-,L-}

INTERFACE

USES Dos;

VAR
  ComspecSeg    : WORD ABSOLUTE $0000:$00BA;
  MasterEnvSeg  : WORD;
  MasterEnvSize : WORD;


  FUNCTION  GetEnvSize     : WORD;
  FUNCTION  MasterEnvUsed  : WORD;
  FUNCTION  MasterEnvFree  : WORD;
  FUNCTION  MasterEnvCount : WORD;
  FUNCTION  MasterEnvStr(Index  : WORD)   : STRING;
  FUNCTION  GetMasterEnv(EnvVar : STRING) : STRING;
  FUNCTION  SetMasterEnv(EnvVar, NewStr : STRING) : BOOLEAN;
  PROCEDURE SaveMasterEnv;
  PROCEDURE RestoreMasterEnv;


IMPLEMENTATION

CONST
  LastEnvPos  : WORD    = 0;
  EnvPosSaved : BOOLEAN = FALSE;
  EnvBuffer   : POINTER = NIL;


  FUNCTION UpString(Txt : STRING) : STRING;
  VAR
    i : BYTE;
  BEGIN
    FOR i := 1 TO Length(Txt) DO
      UpString[i] := UpCase(Txt[i]);
    UpString[0] := Txt[0];
  END;

  FUNCTION GetEnvSize : WORD;
    (* Größe des Programm-Environments in Byte *)
  VAR
    EnvSeg : WORD;
  BEGIN
    EnvSeg     := MemW[PREFIXSEG:$2C];
    GetEnvSize := MemW[EnvSeg-1:3]*16;
  END;

  FUNCTION MasterEnvUsed : WORD;
    (* Belegung des Master-Environments in Byte *)
  VAR
    EnvOfs : WORD;
  BEGIN
    EnvOfs := 0;
    WHILE MemW[MasterEnvSeg:EnvOfs] <> 0 DO INC(EnvOfs);
    MasterEnvUsed := EnvOfs;
  END;

  FUNCTION MasterEnvFree : WORD;
  BEGIN
    MasterEnvFree := MasterEnvSize-MasterEnvUsed-4;
  END;

  FUNCTION MasterEnvCount : WORD;
    (* Anzahl der Environmentvariablen *)
  VAR
    Count, EnvOfs : WORD;
  BEGIN
    Count := 0;
    FOR EnvOfs := 1 TO MasterEnvUsed DO
      IF MEM[MasterEnvSeg:EnvOfs] = 0 THEN INC(Count);
    MasterEnvCount := Count;
  END;

  FUNCTION MasterEnvStr(Index : WORD) : STRING;
   (* Variablenname und -inhalt an der Position Index *)
  VAR
    Count, EnvOfs : WORD;
    ch            : CHAR;
  BEGIN
    MasterEnvStr := '';
    IF Index > 0 THEN BEGIN
      IF EnvPosSaved THEN
        EnvOfs := LastEnvPos
      ELSE BEGIN
        EnvOfs := 0;  Count := 1;
        WHILE Index > Count DO BEGIN
          IF Mem[MasterEnvSeg:EnvOfs] = 0 THEN INC(Count);
          INC(EnvOfs);
        END;
      END;
      Count := 0;  ch := #0;
      REPEAT
        MasterEnvStr[Count] := ch;
        ch := Chr(Mem[MasterEnvSeg:EnvOfs]);
        INC(EnvOfs);  INC(Count);
      UNTIL ch = #0;
      LastEnvPos := EnvOfs;
      MasterEnvStr[0] := Chr(Pred(Count));
    END;
  END;

  FUNCTION GetMasterEnv(EnvVar : STRING) : STRING;
    (* Liefert den Inhalt der Variablen EnvVar *)
  VAR
    PosEqu        : BYTE;
    Count, EnvCnt : WORD;
    EnvStr        : STRING;
  BEGIN
    GetMasterEnv := '';
    Count        := 0;
    EnvCnt       := MasterEnvCount;
    EnvVar       := UpString(EnvVar);
    LastEnvPos   := 0;
    EnvPosSaved  := TRUE;
    REPEAT
      INC(Count);
      EnvStr := MasterEnvStr(Count);
      PosEqu := Pos('=', EnvStr);
    UNTIL (Count > EnvCnt) OR
          (Copy(EnvStr, 1, Pred(PosEqu)) = EnvVar);
    EnvPosSaved := FALSE;
    IF Count <= EnvCnt THEN BEGIN
      Delete(EnvStr, 1, PosEqu);
      GetMasterEnv := EnvStr;
    END;
  END;

  FUNCTION SetMasterEnv(EnvVar, NewStr : STRING) : BOOLEAN;
    (* Variablen ändern, löschen oder hinzufügen *)
  VAR
    OldStr      : STRING;
    EnvOfs, Len : WORD;
    EnvBuffer   : POINTER;
  BEGIN
    SetMasterEnv := TRUE;
    EnvOfs       := Succ(MasterEnvUsed);
    EnvVar       := UpString(EnvVar);
    OldStr       := GetMasterEnv(EnvVar);
    IF OldStr = '' THEN BEGIN
        (* ----- Neue Variable einfügen ----- *)
      IF NewStr <> '' THEN BEGIN
        NewStr := EnvVar + '=' + NewStr;
        IF (EnvOfs+Length(NewStr)+4) >
                                    MasterEnvSize THEN BEGIN
          SetMasterEnv := FALSE;
          Exit;
        END;
        Move(NewStr[1], Mem[MasterEnvSeg:EnvOfs],
             Length(NewStr));
        INC(EnvOfs, Length(NewStr));
      END;
    END ELSE BEGIN
        (* ----- Existierende Variable ändern ----- *)
      Len := EnvOfs-LastEnvPos;
      GetMem(EnvBuffer, Len);
      Move(Mem[MasterEnvSeg:LastEnvPos], EnvBuffer^, Len);
      EnvOfs := LastEnvPos-
                (Length(OldStr)+Length(EnvVar)+2);
      IF NewStr <> '' THEN BEGIN
          (* Bei NewStr = '' wird die Variable gelöscht *)
        NewStr := EnvVar + '=' + NewStr;
        IF (EnvOfs+Length(NewStr)+Len+4) >
                                    MasterEnvSize THEN BEGIN
          SetMasterEnv := FALSE;
          Dispose(EnvBuffer);
          Exit;
        END;
        Move(NewStr[1], Mem[MasterEnvSeg:EnvOfs],
             Length(NewStr));
        INC(EnvOfs, Length(NewStr));
        Mem[MasterEnvSeg:EnvOfs] := 0;
        INC(EnvOfs);
      END;
      Move(EnvBuffer^, Mem[MasterEnvSeg:EnvOfs], Len);
      Dispose(EnvBuffer);
      INC(EnvOfs, Len);
    END;
    MemW[MasterEnvSeg:EnvOfs] := 0; { Ende-Kennung }
      { Wer's genau machen will, ersetzt die obige Zeile }
      { durch:  MemL[MasterEnvSeg:EnvOfs] := $00010000;  }
      { Ist jedoch nicht unbedingt notwendig, da DOS     }
      { diesen Wert selbst nachträgt.                    }
  END;

  PROCEDURE SaveMasterEnv;
    (* bei vorübergehender Änderung vom Environment *)
  BEGIN
    IF EnvBuffer = NIL THEN BEGIN
      GetMem(EnvBuffer, MasterEnvSize);
      Move(Mem[MasterEnvSeg:0], EnvBuffer^, MasterEnvSize);
    END;
  END;

  PROCEDURE RestoreMasterEnv;
  BEGIN
    IF EnvBuffer <> NIL THEN BEGIN
      Move(EnvBuffer^, Mem[MasterEnvSeg:0], MasterEnvSize);
      Dispose(EnvBuffer);
      EnvBuffer := NIL;
    END;
  END;

BEGIN
  MasterEnvSeg  := MemW[ComspecSeg:$2C];
  MasterEnvSize := MemW[MasterEnvSeg-1:3]*16;
END.
(* ------------------------------------------------------ *)
(*              Ende von ENVIRON.PAS                      *)