home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD1.bin / useful / dev / obero / oberon-a / source / amigautil / dosutil.mod < prev    next >
Encoding:
Text File  |  1994-09-03  |  3.0 KB  |  114 lines
  1. (***************************************************************************
  2.  
  3.      $RCSfile: DosUtil.mod $
  4.   Description: Support for clients of dos.library
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 3.3 $
  8.       $Author: fjc $
  9.         $Date: 1994/09/03 16:08:43 $
  10.  
  11.   Copyright © 1994, Frank Copeland.
  12.   This file is part of the Oberon-A Library.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15. ***************************************************************************)
  16.  
  17. MODULE DosUtil;
  18.  
  19. (*
  20. ** $C= CaseChk       $I= IndexChk  $L+ LongAdr   $N= NilChk
  21. ** $P- PortableCode  $R= RangeChk  $S= StackChk  $T= TypeChk
  22. ** $V= OvflChk       $Z= ZeroVars
  23. *)
  24.  
  25. IMPORT Exec, Dos, Str := Strings;
  26.  
  27. CONST (* Returned by ObjectExists() *)
  28.  
  29.   no    *= 0;
  30.   file  *= 1;
  31.   dir   *= 2;
  32.   other *= 3;
  33.  
  34. (*------------------------------------*)
  35. PROCEDURE ObjectExists * ( path : ARRAY OF CHAR ) : INTEGER;
  36.  
  37.   VAR
  38.     lock : Dos.FileLockPtr;
  39.     fib : Dos.FileInfoBlockPtr;
  40.     result : INTEGER;
  41.     (* len : LONGINT; *)
  42.  
  43. (* $D- disable copying of open arrays *)
  44. BEGIN (* ObjectExists *)
  45.   result := no;
  46.   (* len := Str.Length (path); *)
  47.   (* IF path [len - 1] = "/" THEN path [len - 1] := 0X END; *)
  48.   lock := Dos.base.Lock (path, Dos.sharedLock);
  49.   IF lock # NIL THEN
  50.     fib := Dos.base.AllocDosObjectTags (Dos.fib, NIL);
  51.     IF fib # NIL THEN
  52.       IF Dos.base.Examine (lock, fib^) THEN
  53.         IF fib.dirEntryType < 0 THEN result := file
  54.         ELSIF fib.dirEntryType > 0 THEN result := dir
  55.         ELSE result := other
  56.         END
  57.       END;
  58.       Dos.base.FreeDosObject (Dos.fib, fib)
  59.     END;
  60.     Dos.base.UnLock (lock)
  61.   END;
  62.   RETURN result
  63. END ObjectExists;
  64.  
  65. (*------------------------------------*)
  66. PROCEDURE FileExists * (path : ARRAY OF CHAR) : BOOLEAN;
  67.  
  68. (* $D- disable copying of open arrays *)
  69. BEGIN (* FileExists *)
  70.   RETURN (ObjectExists (path) = file)
  71. END FileExists;
  72.  
  73. (*------------------------------------*)
  74. PROCEDURE DirExists * (path : ARRAY OF CHAR) : BOOLEAN;
  75.  
  76. (* $D- disable copying of open arrays *)
  77. BEGIN (* DirExists *)
  78.   RETURN (ObjectExists (path) = dir)
  79. END DirExists;
  80.  
  81. (*------------------------------------*)
  82. (*
  83.   Searches for "file" in the current directory first, followed by the
  84.   directories listed in "paths".  If it is found the procedure returns TRUE
  85.   and the full pathname of the file is returned in "fullPath".  If not, the
  86.   procedure returns FALSE and fullPath is set to "".
  87. *)
  88.  
  89. PROCEDURE Search *
  90.   ( VAR paths    : ARRAY OF Exec.STRPTR;
  91.         file     : ARRAY OF CHAR;
  92.     VAR fullPath : ARRAY OF CHAR)
  93.   : BOOLEAN;
  94.  
  95.   VAR index : INTEGER; len : LONGINT; ch : CHAR;
  96.  
  97. (* $D- disable copying of open arrays *)
  98. BEGIN (* Search *)
  99.   fullPath [0] := 0X; index := 0;
  100.   LOOP
  101.     IF ~Dos.base.AddPart (fullPath, file, LEN (fullPath)) THEN
  102.       RETURN FALSE
  103.     END;
  104.     IF FileExists (fullPath) THEN RETURN TRUE END;
  105.     IF paths [index] = NIL THEN
  106.       fullPath [0] := 0X; RETURN FALSE
  107.     ELSE
  108.       COPY (paths [index]^, fullPath); INC (index)
  109.     END
  110.   END
  111. END Search;
  112.  
  113. END DosUtil.
  114.