Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/ENV1A.ZIP/ENV.PAS

Pascal/Delphi Source File | 1988-03-14 | 6.1 KB | 233 lines

{ * TP4 Unit: ENV.PAS / Author: David Bennett [74635,6171] / 1-12-88
  *
  * This Turbo Pascal unit will allow the user EASY access the the MS-DOS
  * environment variables. I am releasing this code to the public domain.
  * If this code helps you to write a program that makes you a million
  * dollars then more power to you!
  *
  * Take a look at the demo program ENVDEMO.PAS so you will understand
  * more fully how easy these routines are to use.
}

{ * Fixed EnvAssign so that it works with path strings of the form "C:\"
  * Lew Paper, 3/14/88
}

Unit Env;

INTERFACE

Uses
  Dos;

{ * Declare a variable of type EnvRecord in the begining of your program }

Const

  EnvMax = 20;  { Maximum paths in an environment string }

Type

  EnvStr    = String[255];
  EnvArray  = Array[1..EnvMax] of EnvStr;
  EnvRecord = Record
                Pos  : Byte;        { Sequential position of environment var }
                Name,               { Name of the environment variable       }
                Data : EnvStr;      { The data assigned to the variable      }
              End;

Function  EndEnv    : Boolean;
{ * Returns true if at end of environment area
}

Procedure FirstEnv(Var EnvBuf : EnvRecord);
{ * Returns the first environment variable in the variable EnvBuf.
  *
}

Procedure NextEnv(Var EnvBuf : EnvRecord);
{ * Returns the next sequential environment variable in the variable EnvBuf.
  * You should call FirstEnv before calling this procedure
}

Procedure GetEnvStr(Var EnvBuf : EnvRecord);
{ * Before calling load EnvBuf.Name with the environment variable that you
  * are looking for. After calling this procedure the EnvBuf record will
  * contain the correct EnvBuf.Pos and EnvBuf.Data for EnvBuf.Name
}

Procedure EnvParse(EnvData : EnvStr; Var EnvList : EnvArray);
{ * Parse an environment string into seperate paths
}

Procedure EnvAssign(Var FilVar : Text; EnvVar, FileName : EnvStr);
{ * Open a file first looking thru directorys set in an environment variable
}

IMPLEMENTATION

Var
  EnvOfs,
  EnvSeg,
  EnvPos  : Integer;

{ * Get the memory segment that contains the environment string
}
Procedure GetEnvSeg(Var EnvSeg : Integer);
Var
  Regs : Registers;
Begin
  Regs.AX := $6200;                { MS-DOS Function for getting PSP      }
  MsDos(Regs);                     { Call MS-DOS                          }
  EnvSeg := MemW[Regs.BX:$2C];     { The Environment starts at $2C of PSP }
End;

{ * Get a character from the environment
}
Procedure GetEnvC(Var EnvCh : Char);
Var
  By : Byte;
Begin
  By := Mem[EnvSeg:EnvOfs];
  EnvCh := Chr(By);
  Inc(EnvOfs);
End;

{ * Check for end of environment area
}
Function EndEnv : Boolean;
Begin
  If MemW[EnvSeg:EnvOfs] = $0000 Then EndEnv := True Else EndEnv := False;
End;

{ * Check for end of environment string
}
Function EndEnvStr : Boolean;
Begin
  If Mem[EnvSeg:EnvOfs] = $00 Then EndEnvStr := True Else EndEnvStr := False;
End;

{ * Get the next environment string from the environment area
}
Procedure NextEnv(Var EnvBuf : EnvRecord);
Var
  AfterEquals : Boolean;
  EnvCh       : Char;
Begin
  FillChar(EnvBuf,SizeOf(EnvBuf),0);
  Inc(EnvPos);
  EnvBuf.Pos := EnvPos;
  AfterEquals := False;
  If Not(EndEnv) Then
    Repeat
      GetEnvC(EnvCh);
      If (EnvCh = '=') Then AfterEquals := True
      Else
        If (EnvCh <> #00) Then Case AfterEquals Of
          False  : EnvBuf.Name := EnvBuf.Name + EnvCh;
          True   : EnvBuf.Data := EnvBuf.Data + EnvCh;
        End;
    Until (EndEnvStr)
  Else
    EnvBuf.Pos := 0;
End;

{ * Get the first environment string
}
Procedure FirstEnv(Var EnvBuf : EnvRecord);
Var
  AfterEqual : Boolean;
  EnvCh      : Char;
Begin
  GetEnvSeg(EnvSeg);
  EnvOfs := 0;
  EnvPos := 0;
  If Not(EndEnv) Then Begin
    NextEnv(EnvBuf);
  End;
End;

{ * Gets the environment string given EnvBuf.Name
}
Procedure GetEnvStr(Var EnvBuf : EnvRecord);
Var
  I       : Byte;
  EnvName : EnvStr;
Begin
  FillChar(EnvName,SizeOf(EnvName),0);
  For I := 1 To Length(EnvBuf.Name) Do
    EnvName := EnvName + UpCase(EnvBuf.Name[I]);
  FirstEnv(EnvBuf);
  While (EnvName <> EnvBuf.Name) and Not(EndEnv) Do NextEnv(EnvBuf);
  If (EnvName <> EnvBuf.Name) Then Begin
    EnvBuf.Pos  := 0;
    EnvBuf.Name := EnvName;
    EnvBuf.Data := #00;
  End;
End;

{ * Parse an environment string into seperate paths
}
Procedure EnvParse(EnvData : EnvStr; Var EnvList : EnvArray);
Var
  I,
  L : Integer;
Begin
  For I := 1 to EnvMax Do FillChar(EnvList[I],SizeOf(EnvList[I]),0);
  I := 1;
  For L := 1 to Length(EnvData) Do Begin
    If EnvData[L] <> ';' Then Begin
      If I <= EnvMax Then EnvList[I] := EnvList[I] + EnvData[L];
    End Else
      Inc(I);
  End;
End;

{ * Assign a file first looking in the current directory and then the
  * directories in the specified environment variable for an existing
  * file of the same name.
}
Procedure EnvAssign(Var FilVar : Text; EnvVar, FileName : EnvStr);
Var
  I        : Integer;
  EnvAry   : EnvArray;
  EnvBuf   : EnvRecord;
  FullName : String[66];
  GoodOpen : Boolean;
Begin
  GoodOpen := False;
  Assign(FilVar,FileName);
  {$I-} Reset(FilVar); {$I+}
  GoodOpen := (IOResult = 0);
  If (GoodOpen) Then Close(FilVar)
  Else Begin
    EnvBuf.Name := EnvVar;
    GetEnvStr(EnvBuf);
    If EnvBuf.Data > #00 Then Begin
      EnvParse(EnvBuf.Data,EnvAry);
      I := 1;                      {LP changed from "I := I;"}
      While (EnvAry[I] > #00) And Not(GoodOpen) Do Begin
        IF EnvAry[I][LENGTH(EnvAry[I])] = '\' THEN  {LP fix}
          FullName := EnvAry[I] + FileName          {LP fix}
        ELSE                                        {LP fix}
          FullName := EnvAry[I] + '\' + FileName;
        Assign(FilVar, FullName);
        {$I-} Reset(FilVar); {$I+}
        GoodOpen := (IOResult = 0);
        If GoodOpen Then Close(FilVar);
        Inc(I);
      End;
    End;
  End;
  If Not(GoodOpen) Then Assign(FilVar,FileName);
End;

End { IMPLEMENTAION } .

INITIALIZATION

Begin
  EnvOfs := 0;
  EnvPos := 0;
End { INITIALIZATION }.