home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MADTRB8.ZIP / OPENFILE.INC < prev    next >
Encoding:
Text File  |  1985-02-23  |  2.9 KB  |  78 lines
  1. (***************************************************
  2. | Source: openfile
  3. | Purpose: open a text file for reading or writing
  4. | Date: 7/14/84
  5. | Author: Jim Ulrick / Berkely, CA / (415)526-0474
  6. | Source: FOGHORN November 1984, page 49.
  7. ***************************************************
  8. | Call this procedure using the following command line:
  9. |      openfile('R',filename,filvar,fileopen) to read file
  10. |      openfile('W',filename,filvar,fileopen) to write file
  11. | Early in the program, place an include directive for
  12. | this procedure,($I openfile).
  13. |
  14. | Procedure asks for the name of a disk file to open for reading
  15. | or writing and checks to see if the filename entered
  16. | already exists.  If a file for reading exists it opens it, otherwise
  17. | it gives an error message and prompts for another name.  If
  18. | a file for writing exists, it asks whether to overwrite the existing file.
  19. | The user can either overwrite the file, try another filename,
  20. | or quit. When a file for writing is opened, it is rewritten.  The
  21. | boolean variable 'fileopen' is passed back to the calling
  22. | procedure and indicates whether a file was successfully opened.
  23. *****************************************************)
  24.  
  25. PROCEDURE openfile(filetype: char; var filename: str14;
  26.      var filvar: text; var fileopen: boolean);
  27.      {reading(filetype='R') - writing(filetype='W'}
  28.  
  29. var
  30.    choice:     char;
  31.    exists:     boolean;
  32.  
  33. BEGIN
  34.    fileopen:=false;
  35.    repeat
  36.      gotoxy(6,22); clreol;
  37.      if filetype='R' then write ('Enter name of disk file to read: ')
  38.      else                 write ('Enter name of disk file to write: ');
  39.      readln(FileName);
  40.      if filename ='' then choice:='Q' {terminate without opening a file}
  41.      else begin
  42.       choice := ' ';
  43.       assign(filvar,FileName);
  44.       {toggle compiler IO error handling and attempt to reset
  45.       file, if the file can be reset then it must exist}
  46.       {$I-}  reset(filvar)  {$I+};
  47.       exists:=(IOResult = 0); {IOResult is a standard function}
  48.       case filetype of
  49.       'R': if not exists then begin
  50.         gotoxy(6,23);clreol;
  51.         writeln('Cannot open input file ',filename);
  52.         end
  53.         else
  54.          fileopen:=true;
  55.       'W': if exists then begin
  56.         gotoxy(6,22);clreol;
  57.         write('File exists, do you want to replace? (Y/N/Quit):');
  58.         repeat
  59.          read(kbd,choice);
  60.          choice:=upcase(choice);
  61.         until choice in ['Y','N','Q',^M];
  62.         {^M is carriage return and is used as a default for Quit}
  63.           if choice='Y' then begin
  64.         fileopen:=true;
  65.         rewrite(filvar);
  66.       end
  67.     end
  68.     else begin
  69.       fileopen:=true;
  70.       rewrite(filvar);
  71.      end;
  72.     end; {case}
  73.    end; {if}
  74.   until fileopen or (choice in ['Q',^M]);
  75.   gotoxy(6,22);clreol;
  76.   gotoxy(6,23);clreol;
  77. END; {openfile}
  78.