home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / JSAGE / ZSUS / PROGPACK / RCPMKE18.LBR / TOUCH.MZD / TOUÃH.MOÄ
Text File  |  2000-06-30  |  2KB  |  68 lines
  1. MODULE TouchFiles;
  2.  
  3. (*    I decided to write TOUCH in Modula2, to gain practice
  4.     in the language.  Do not consider it 'polished'.
  5.             Ron Bardarson ZNC    *)
  6.  
  7.  
  8. FROM ComLine    IMPORT commandLine;
  9. FROM Strings    IMPORT Copy, Delete, Length, Pos;
  10. FROM SYSTEM    IMPORT ADR, CODE;
  11. FROM TEXTS    IMPORT output, ReadString, WriteInt;
  12.  
  13. EXCEPTION FileNotFound, Help;
  14.  
  15.  
  16. TYPE
  17.     FileName    = ARRAY[0..11] OF CHAR;
  18.     FCBptr         = POINTER TO FileName;
  19.  
  20. VAR
  21.     FCB        : FCBptr;
  22.     FileList    : ARRAY[0..128] OF CHAR;
  23.     FLAG        : INTEGER;
  24.     FNAME        : FileName;
  25.  
  26.     comma        : CARDINAL;
  27.     len        : CARDINAL;
  28.     period        : CARDINAL;
  29.  
  30.  
  31.  
  32. PROCEDURE Touch(FN:FCBptr): INTEGER;
  33.     CODE('TOUCHZ'); (* Retain all attribute bits except makebit *)
  34. END Touch;
  35.  
  36.  
  37. BEGIN;
  38.     ReadString(commandLine,FileList);
  39.     IF Length(FileList)=0 THEN RAISE Help; END;
  40.     IF FileList='//' THEN RAISE Help; END;
  41.  
  42.     LOOP
  43.       len:=Length(FileList);
  44.      IF len=0 THEN EXIT; END;
  45.       comma:=Pos(',',FileList);
  46.       Copy(FileList,0,comma,FNAME);
  47.       FCB:=ADR(FNAME);  FLAG:=Touch(FCB);
  48.       IF FLAG # 0  THEN RAISE FileNotFound; END;
  49.       Delete(FileList,0,comma+1);
  50.     END;
  51.  
  52.     WRITELN('Touch 1.0');
  53.  
  54. EXCEPTION |
  55. FileNotFound:
  56.     WRITELN('File not found error: ',FNAME);
  57. |
  58. Help:
  59.     WRITELN();
  60.     WRITELN('Touch:  TOUCH THISFILE.EXT,THATFILE.EXT,NOFILE');
  61.     WRITELN('  Use TOUCH as you would PROTECT, except that TOUCH');
  62.     WRITELN('  only clears the makebit and takes no options.');
  63.     WRITELN('  A utility to go with MAKE.RCP');
  64.     WRITELN();
  65.  
  66. END TouchFiles.
  67. Y[0..128] OF CHAR;
  68.     FLAG        : INTEGER;