home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / TPKERMIT / LOCAL.PAS < prev    next >
Pascal/Delphi Source File  |  1987-03-25  |  5KB  |  144 lines
  1. (* +FILE+ LOCAL.PASMSCPM *)
  2. (* ----------------------------------------------------------------- *)
  3. (*  DisplayDir - Displays the directory for the mask given in the    *)
  4. (*              input parameter string.                              *)
  5. (* ----------------------------------------------------------------- *)
  6. Procedure DisplayDir (Myfiles : Comstring) ;
  7. var
  8.   filename : comstring ;
  9.   column,row : integer ;
  10. Begin (* DisplayDir Procedure *)
  11. if (length(myfiles)<1) or (Myfiles[length(myfiles)] in ['\','/',':'])
  12.      then myfiles := myfiles + '*.*';
  13. Clrscr;
  14. If firstfile(myfiles,filename) then
  15.     Begin (* found files *)
  16.     writeln(' directory ',myfiles);
  17.     write(filename);
  18.     column := 21 ; row := 2;
  19.     while nextfile(myfiles,filename) do
  20.          begin (* list rest of files *)
  21.          gotoxy(column,row);
  22.          write (filename);
  23.          column := column + 20 ;
  24.          if column > 61 then
  25.               begin row := row + 1 ; column := 1 ;  end ;
  26.          end ; (* list rest of files *)
  27.     End   (* found files *)
  28.                                 else
  29.     writeln(' no file found ');
  30.  writeln(' ');
  31.  DisplayDiskStatus ;
  32.  End ; (* DisplayDir Procedure *)
  33.  
  34. (* ----------------------------------------------------------------- *)
  35. (*  EraseFiles - Erases a file or files from the disk.               *)
  36. (*                                                                   *)
  37. (* ----------------------------------------------------------------- *)
  38. Procedure EraseFiles (Myfiles : Comstring) ;
  39. var
  40.     tempname : comstring ;
  41.     tempfile : text ;
  42.     column,row : integer ;
  43. Begin (* EraseFile Procedure *)
  44. While length(myfiles)<1 do
  45.     Begin (* get file name *)
  46.     write(' enter name of file to be erased > ');
  47.     readln(myfiles);
  48.     End ;
  49. If firstfile(myfiles,tempname) then
  50.     Begin (* found files *)
  51.     Clrscr;
  52.     writeln(' Erasing file(s) ',myfiles);
  53.     assign(tempfile,prefixof(myfiles)+tempname);
  54.     erase(tempfile);
  55.     write(tempname);
  56.     column := 21 ; row := 2;
  57.     while nextfile(myfiles,tempname) do
  58.          begin (* list rest of files *)
  59.          gotoxy(column,row);
  60.          assign(tempfile,prefixof(myfiles)+tempname);
  61.          erase(tempfile);
  62.          write (tempname);
  63.          column := column + 20 ;
  64.          if column > 61 then
  65.               begin row := row + 1 ; column := 1 ;  end ;
  66.          end ; (* list rest of files *)
  67.     writeln(' ');
  68.     writeln('The above file(s) have been erased. ');
  69.     End   (* found files *)
  70.                                 else
  71.     writeln(' no file found ');
  72. End;  (* EraseFile *)
  73.  
  74. (* ----------------------------------------------------------------- *)
  75. (*  RenameFile - Remame a file.                                      *)
  76. (*                                                                   *)
  77. (* ----------------------------------------------------------------- *)
  78. Procedure RenameFile (Var Instring : Comstring) ;
  79. var
  80.     oldnames,oldname,newname : comstring ;
  81.     tempfile : text ;
  82. label exit ;
  83. Begin (* RenameFile Procedure *)
  84. If length(Instring)<1 then
  85.     Begin (* get file name *)
  86.     write(' Enter old file name  > ');
  87.     readln(Instring);
  88.     End ; (* get file name *)
  89. If length(Instring)<1 then goto exit ;
  90. oldnames := uppercase(GetToken(instring));
  91. newname := uppercase(GetToken(instring));
  92. If length(newname)<1 then
  93.     Begin (* get new file name *)
  94.     write(' Enter new file name  > ');
  95.     readln(Instring);
  96.     newname := uppercase(GetToken(instring));
  97.     End ; (* get new file name *)
  98. If firstfile(oldnames,oldname) then
  99.     Begin (* found File *)
  100.     assign(tempfile,prefixof(oldnames)+oldname);
  101.     Rename(tempfile,newname);
  102.     writeln(' ');
  103.     writeln('File ',oldname, ' renamed to ',newname);
  104.     End   (* found File *)
  105.                                 else
  106.     writeln(' No file  - ',oldname);
  107. exit:
  108. End;  (* RenameFile *)
  109.  
  110. (* ----------------------------------------------------------------- *)
  111. (*  DisplayFile - display a file.                                    *)
  112. (*                                                                   *)
  113. (* ----------------------------------------------------------------- *)
  114. Procedure DisplayFile (Myfile : Comstring) ;
  115. var
  116.     oldname,newname : comstring ;
  117.     tempfile : text ;
  118.     achar : char ;
  119. label exit ;
  120. Begin (* DisplayFile Procedure *)
  121. If length(Myfile)<1 then
  122.     Begin (* get file name *)
  123.     write(' Enter  file name  > ');
  124.     readln(Myfile);
  125.     End ; (* get file name *)
  126. If length(Myfile)<1 then goto exit ;
  127. Assign(tempfile,myfile);
  128. { $I- } Reset(tempfile); { $I+ }
  129. If IOResult = 0  then
  130.     Begin (* found File *)
  131.     Clrscr ;
  132.     While not eof(tempfile) do
  133.        begin (* Display file *)
  134.        Read(tempfile,achar);
  135.        Write(achar);
  136.        end;  (* Display file *)
  137.     writeln(' ');
  138.     End   (* found File *)
  139.                              else
  140.     writeln(' No file  - ',Myfile);
  141. exit:
  142. End;  (* DisplayFile *)
  143.  
  144.