home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9202 / pretty / prfiles.mod < prev    next >
Encoding:
Modula Implementation  |  1991-02-18  |  3.4 KB  |  153 lines
  1.  
  2. IMPLEMENTATION MODULE PRFILES;
  3.  
  4. FROM Storage IMPORT ALLOCATE,DEALLOCATE;
  5.  
  6. FROM FIO IMPORT ReadFirstEntry,ReadNextEntry,DirEntry,Attrib,FileAttr,
  7.                 PathTail;
  8.  
  9. FROM FIOR IMPORT AddExtension;
  10.  
  11. FROM Str IMPORT Caps,CharPos,Delete,Compare,Copy,Slice;
  12.  
  13. FROM Lib IMPORT ParamCount,ParamStr;
  14.  
  15. FROM IO IMPORT WrStr,WrLn,RdStr,RdKey;
  16.  
  17. TYPE DirList = POINTER TO ListEntry;
  18.      ListEntry = RECORD
  19.                    name : PathTail;
  20.                    next : DirList
  21.                  END;
  22.  
  23. VAR Directory : DirList;
  24.  
  25.   PROCEDURE KillDirectory (VAR dir : DirList);
  26.  
  27.   VAR help : DirList;
  28.  
  29.   BEGIN
  30.     WHILE dir # NIL DO
  31.       help := dir;
  32.       dir := dir^.next;
  33.       DISPOSE (help)
  34.     END
  35.   END KillDirectory;
  36.  
  37.   PROCEDURE GetEntry (VAR dir : DirList;
  38.                       VAR name : ARRAY OF CHAR);
  39.  
  40.   VAR help : DirList;
  41.  
  42.   BEGIN
  43.     Copy (name,dir^.name);
  44.     help := dir;
  45.     dir := dir^.next;
  46.     DISPOSE (help)
  47.   END GetEntry;
  48.  
  49.   PROCEDURE SearchFirst (VAR name : ARRAY OF CHAR) : BOOLEAN;
  50.  
  51.   VAR entry : DirEntry;
  52.       success : BOOLEAN;
  53.  
  54.     PROCEDURE InsertInList (VAR dir : DirList;
  55.                             name : PathTail);
  56.  
  57.     VAR last,help,w : DirList;
  58.  
  59.     BEGIN
  60.       help := dir;
  61.       WHILE (help # NIL) & (Compare (help^.name,name) = - 1) DO
  62.         last := help;
  63.         help := help^.next;
  64.       END;
  65.       NEW (w);
  66.       w^.name := name;
  67.       w^.next := help;
  68.       IF help = dir THEN
  69.         dir := w
  70.       ELSE
  71.         last^.next := w
  72.       END
  73.     END InsertInList;
  74.  
  75.   BEGIN
  76.     KillDirectory (Directory);
  77.     success := ReadFirstEntry (name,FileAttr {archive},entry);
  78.     WHILE success DO
  79.       InsertInList (Directory,entry.Name);
  80.       success := ReadNextEntry (entry);
  81.     END;
  82.     IF Directory # NIL THEN
  83.       GetEntry (Directory,name);
  84.       RETURN TRUE
  85.     ELSE
  86.       RETURN FALSE
  87.     END
  88.   END SearchFirst;
  89.  
  90.   PROCEDURE SearchNext (VAR name : ARRAY OF CHAR) : BOOLEAN;
  91.  
  92.   BEGIN
  93.     IF Directory = NIL THEN
  94.       RETURN FALSE
  95.     ELSE
  96.       GetEntry (Directory,name);
  97.       RETURN TRUE
  98.     END
  99.   END SearchNext;
  100.  
  101.   PROCEDURE GetExt (str : ARRAY OF CHAR;
  102.                     VAR ext : ExtStr);
  103.  
  104.   BEGIN
  105.     IF CharPos (str,'.') < MAX (CARDINAL) THEN
  106.       Slice (ext,str,CharPos (str,'.') + 1,3)
  107.     END;
  108.   END GetExt;
  109.  
  110.   PROCEDURE ReadFileNames (VAR source,dest : ARRAY OF CHAR);
  111.  
  112.   VAR wildcard,ende : BOOLEAN;
  113.  
  114.   BEGIN
  115.     IF ParamCount () > 0 THEN
  116.       ParamStr (source,1)
  117.     ELSE
  118.       WrLn;
  119.       WrStr ('Source      : ');
  120.       RdStr (source)
  121.     END;
  122.     Caps (source);
  123.     IF source [0] = 0C THEN
  124.       RETURN
  125.     END;
  126.     AddExtension (source,'MOD');
  127.     wildcard := (CharPos (source,'*') < MAX (CARDINAL)) OR (CharPos (source,
  128.              '?') < MAX (CARDINAL));
  129.     Comments := CharPos (source,'@') = MAX (CARDINAL);
  130.     IF NOT Comments THEN
  131.       Delete (source,CharPos (source,'@'),1)
  132.     END;
  133.     IF NOT wildcard THEN
  134.       IF ParamCount () > 1 THEN
  135.         ParamStr (dest,2)
  136.       ELSIF ParamCount () = 0 THEN
  137.         WrStr ('Destination : ');
  138.         RdStr (dest)
  139.       END;
  140.       Caps (dest);
  141.       IF (dest [0] = 0C) THEN
  142.         Copy (dest,source);
  143.       ELSIF (Compare (dest,'PRN') # 0) THEN
  144.         AddExtension (dest,'MOD')
  145.       END
  146.     ELSE
  147.       Copy (dest,source)
  148.     END
  149.   END ReadFileNames;
  150.  
  151. BEGIN
  152.   Directory := NIL;
  153. END PRFILES.