home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 10 / Fresh_Fish_10_2352.bin / new / dev / obero / oberon-a / source / amigautil / dosutil.mod < prev    next >
Text File  |  1995-06-29  |  3KB  |  141 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.9 $
  8.       $Author: fjc $
  9.         $Date: 1995/06/04 23:18:08 $
  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. <* STANDARD- *>
  18.  
  19. MODULE DosUtil;
  20.  
  21. IMPORT e := Exec, d := Dos, s := Sets;
  22.  
  23. CONST (* Returned by ObjectExists() *)
  24.  
  25.   no    *= 0;
  26.   file  *= 1;
  27.   dir   *= 2;
  28.   other *= 3;
  29.  
  30. VAR
  31.  
  32.   enableBreak *: BOOLEAN;
  33.  
  34. (*------------------------------------*)
  35. PROCEDURE ObjectExists * ( path : ARRAY OF CHAR ) : INTEGER;
  36.  
  37.   VAR
  38.     lock : d.FileLockPtr;
  39.     fib : d.FileInfoBlockPtr;
  40.     result : INTEGER;
  41.  
  42. <*$CopyArrays-*>
  43. BEGIN (* ObjectExists *)
  44.   result := no;
  45.   lock := d.Lock (path, d.sharedLock);
  46.   IF lock # NIL THEN
  47.     fib := d.AllocDosObjectTags (d.fib, NIL);
  48.     IF fib # NIL THEN
  49.       IF d.Examine (lock, fib^) THEN
  50.         IF fib.dirEntryType < 0 THEN result := file
  51.         ELSIF fib.dirEntryType > 0 THEN result := dir
  52.         ELSE result := other
  53.         END
  54.       END;
  55.       d.FreeDosObject (d.fib, fib)
  56.     END;
  57.     d.UnLock (lock)
  58.   END;
  59.   RETURN result
  60. END ObjectExists;
  61.  
  62. (*------------------------------------*)
  63. PROCEDURE FileExists * (path : ARRAY OF CHAR) : BOOLEAN;
  64.  
  65. <*$CopyArrays-*>
  66. BEGIN (* FileExists *)
  67.   RETURN (ObjectExists (path) = file)
  68. END FileExists;
  69.  
  70. (*------------------------------------*)
  71. PROCEDURE DirExists * (path : ARRAY OF CHAR) : BOOLEAN;
  72.  
  73. <*$CopyArrays-*>
  74. BEGIN (* DirExists *)
  75.   RETURN (ObjectExists (path) = dir)
  76. END DirExists;
  77.  
  78. (*------------------------------------*)
  79. (*
  80.   Searches for "file" in the current directory first, followed by the
  81.   directories listed in "paths".  If it is found the procedure returns TRUE
  82.   and the full pathname of the file is returned in "fullPath".  If not, the
  83.   procedure returns FALSE and fullPath is set to "".
  84. *)
  85.  
  86. PROCEDURE Search *
  87.   ( VAR paths    : ARRAY OF e.LSTRPTR;
  88.         file     : ARRAY OF CHAR;
  89.     VAR fullPath : ARRAY OF CHAR)
  90.   : BOOLEAN;
  91.  
  92.   VAR index : INTEGER; len : LONGINT; ch : CHAR;
  93.  
  94. <*$CopyArrays-*>
  95. BEGIN (* Search *)
  96.   fullPath [0] := 0X; index := 0;
  97.   LOOP
  98.     IF ~d.AddPart (fullPath, file, LEN (fullPath)) THEN
  99.       RETURN FALSE
  100.     END;
  101.     IF FileExists (fullPath) THEN RETURN TRUE END;
  102.     IF paths [index] = NIL THEN
  103.       fullPath [0] := 0X; RETURN FALSE
  104.     ELSE
  105.       COPY (paths [index]^, fullPath); INC (index)
  106.     END
  107.   END
  108. END Search;
  109.  
  110.  
  111. PROCEDURE CheckBreak* ( breaks : s.SET32 ) : BOOLEAN;
  112.  
  113.   VAR signals : s.SET32;
  114.  
  115. BEGIN (* CheckBreak *)
  116.   IF enableBreak THEN
  117.     signals := e.SetSignal ({}, {});
  118.     RETURN (signals * breaks) # {}
  119.   ELSE RETURN FALSE
  120.   END
  121. END CheckBreak;
  122.  
  123.  
  124. PROCEDURE HaltIfBreak * ( breaks : s.SET32 );
  125.  
  126.   VAR signals : s.SET32;
  127.  
  128. BEGIN (* HaltIfBreak *)
  129.   IF enableBreak THEN
  130.     signals := e.SetSignal ({}, {});
  131.     IF (signals * breaks) # {} THEN
  132.       enableBreak := FALSE;
  133.       IF d.PutStr ("\n***BREAK -- User aborted\n") = 0 THEN END;
  134.       HALT (d.warn)
  135.     END
  136.   END
  137. END HaltIfBreak;
  138.  
  139. BEGIN enableBreak := TRUE
  140. END DosUtil.
  141.