home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ENVI.ZIP / PARSPATH.INC < prev    next >
Encoding:
Text File  |  1986-02-06  |  2.9 KB  |  112 lines
  1. {$I DOS.INC}
  2. {$I ENVIRONM.INC}
  3.  
  4. TYPE
  5.   FNameType = STRING[12];
  6.   PathPtr = ^PathRec;
  7.   PathRec = RECORD
  8.               PName : BigString;
  9.               Next : PathPtr;
  10.             END;
  11.  
  12. VAR
  13.   StartPR,
  14.   ThisPR,
  15.   NextPR : PathPtr;
  16.  
  17.   PROCEDURE MakePath(ThePath : BigString);
  18.     {BigString is declared in EVNIRONM.INC.}
  19.  
  20.     PROCEDURE ParsePath(PathStr : BigString);
  21.  
  22.     VAR
  23.       PosSemi,
  24.       PosSlash,
  25.       PosColon,
  26.       NextSlash,
  27.       LPS : Byte;
  28.       Done : Boolean;
  29.  
  30.       PROCEDURE IncSlash;
  31.       BEGIN
  32.         NextSlash := Pos('\', Copy(PathStr, PosSlash+1, LPS-PosSlash));
  33.         IF NextSlash = 0 THEN Done := True;
  34.         PosSlash := PosSlash+NextSlash;
  35.       END; {IncSlash}
  36.  
  37.  
  38.     BEGIN {ParsePath}
  39.       Done := False;
  40.       LPS := Length(PathStr);
  41.       IF PathStr[LPS] <> ';' THEN BEGIN
  42.         PathStr := PathStr+';';
  43.         LPS := LPS+1;
  44.       END; {if PathStr[LPS]<>';'}
  45.       IF PathStr[LPS-1] <> '\' THEN BEGIN
  46.         Insert('\', PathStr, LPS);
  47.         LPS := LPS+1;
  48.       END; {if PathStr[LPS - 1]<>'\'}
  49.       PosSemi := Pos(';', PathStr);
  50.       IF PosSemi <> LPS THEN BEGIN
  51.         ParsePath(Copy(PathStr, 1, PosSemi));
  52.         ParsePath(Copy(PathStr, PosSemi+1, LPS-PosSemi));
  53.       END {if PosSemi<>LPS}
  54.       ELSE BEGIN {PosSemi = LPS}
  55.         PosColon := Pos(':', PathStr);
  56.         PosSlash := Pos('\', PathStr);
  57.         IF PosColon IN [0, 2] THEN BEGIN
  58.           IF (PosColon = 2) AND (PosSlash = 3) THEN BEGIN
  59.             IncSlash;
  60.             Done := False;
  61.           END; {if (PosColon = 2) and (PosSlash = 3)}
  62.           REPEAT {until Done}
  63.             ThisPR^.PName := Copy(PathStr, 1, PosSlash);
  64.             New(ThisPR^.Next);
  65.             ThisPR := ThisPR^.Next;
  66.             ThisPR^.PName := '';
  67.             ThisPR^.Next := NIL;
  68.             IncSlash;
  69.           UNTIL Done;
  70.         END; {if PosColon in [0, 2]}
  71.       END; {else PosSemi = LPS}
  72.     END; {ParsePath}
  73.  
  74.   BEGIN {MakePath}
  75.     New(StartPR);
  76.     StartPR^.PName := '';
  77.     StartPR^.Next := NIL;
  78.     ThisPR := StartPR;
  79.     ParsePath(ThePath);
  80.   END; {MakePath}
  81.  
  82. VAR
  83.   FName : FNameType;
  84.   AFile : FILE;
  85.   WordOut,
  86.   WordIn : BigString;
  87.   Done : Boolean;
  88.   Result : Integer;
  89.  
  90. BEGIN {test ParsePath}
  91.   FName := ParamStr(1);
  92.   Done := False;
  93.   IF FoundInEnv('PATH', WordOut) THEN MakePath(WordOut);
  94.   ThisPR := StartPR;
  95.   REPEAT {until Done}
  96.     IF ThisPR^.PName = '' THEN Done := True;
  97.     IF NOT Done THEN BEGIN
  98.       Assign(AFile, ThisPR^.PName+FName);
  99.       {$I-} Reset(AFile); {$I+}
  100.       Result := IOResult;
  101.     END; {if not Done}
  102.     IF Result = 0 THEN WriteLn('Found ', FName, ' in ', ThisPR^.PName);
  103.     IF NOT Done THEN ThisPR := ThisPR^.Next;
  104.   UNTIL Done;
  105.   ThisPR := StartPr;
  106.   REPEAT {until NextPR = nil}
  107.     NextPR := ThisPR^.Next;
  108.     Dispose(ThisPR);
  109.     ThisPR := NextPR;
  110.   UNTIL NextPR = NIL;
  111. END.
  112.