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 / ENTERPRS / CPM / UTILS / S / TPASPGM.ARC / RENAME.PAS < prev    next >
Pascal/Delphi Source File  |  1989-09-27  |  2KB  |  61 lines
  1. PROGRAM RENAME ;
  2. { To rename a file -- WPM, 3/5/84 }
  3. TYPE
  4.         FILENAME = STRING[14] ;
  5.  
  6. VAR
  7.         OLDNAME,NEWNAME : FILENAME ;
  8.         RFILE           : FILE ;
  9.         ANSWER          : CHAR ;
  10.         DONE            : BOOLEAN ;
  11.  
  12. FUNCTION FILE_EXISTS (FNAME : FILENAME) : BOOLEAN ;
  13.     VAR
  14.         FFILE : FILE ;
  15.     BEGIN
  16.         ASSIGN (FFILE,FNAME) ;
  17.         {$I-}
  18.         RESET (FFILE) ;
  19.         {$I+}
  20.         FILE_EXISTS := (IORESULT = 0)
  21.     END ;
  22.  
  23. BEGIN {RENAME}
  24.         DONE := FALSE ;
  25.         REPEAT
  26.                 WRITELN ;
  27.                 WRITELN ('Rename a file') ;
  28.                 WRITELN ;
  29.                 WRITE   ('Current file name? ') ;
  30.                 READLN  (OLDNAME) ;
  31.                 WRITE   ('New file name?     ') ;
  32.                 READLN  (NEWNAME) ;
  33.                 IF FILE_EXISTS (NEWNAME) THEN
  34.                         WRITELN ('CAN''T -- NEW FILE NAME ALREADY EXISTS')
  35.                 ELSE
  36.                     BEGIN
  37.                         ASSIGN (RFILE,OLDNAME) ;
  38.                         {$I-}
  39.                         RESET (RFILE) ;
  40.                         {$I+}
  41.                         IF IORESULT = 0 THEN
  42.                             BEGIN
  43.                                 RENAME (RFILE,NEWNAME) ;
  44.                                 WRITELN ('Done!')
  45.                             END
  46.                         ELSE
  47.                                 WRITELN ('CAN''T -- OLD FILE DOES NOT EXIST') ;
  48.                     END ;
  49.                 WRITE   ('Again? ') ;
  50.                 READLN  (ANSWER) ;
  51.                 IF NOT (ANSWER IN ['Y', 'y']) THEN
  52.                         DONE := TRUE
  53.         UNTIL DONE;
  54. END.
  55.  
  56.  
  57.  
  58.  
  59. name? ') ;
  60.                 READLN  (OLDNAME) ;
  61.                 WRITE   ('New file name?