home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / c / qk3lcl.pas < prev    next >
Pascal/Delphi Source File  |  2020-01-01  |  9KB  |  233 lines
  1. Unit Local ;
  2. Interface
  3.    Uses Dos,Crt,        (* Standard Turbo Pascal Units *)
  4.         KGlobals,Sysfunc ;
  5.    Procedure DisplayDir ( Var InString : String) ;
  6.    Procedure EraseFiles (     Myfiles : String) ;
  7.    Procedure RenameFile ( Var Instring : String) ;
  8.    Procedure DisplayFile(     Myfile : String) ;
  9.  
  10. Implementation
  11. (* ----------------------------------------------------------------- *)
  12. (*  DisplayDir - Displays the directory for the mask given in the    *)
  13. (*              input parameter string.                              *)
  14. (* ----------------------------------------------------------------- *)
  15. Procedure DisplayDir (Var InString : String) ;
  16. var
  17.     MyFiles,fileprefix,option : String ;
  18.     FileInfo : SearchRec ;
  19.     Drive : byte ;
  20.     Achar : char ;
  21.     column,row,fcount : integer ;
  22. label Getnext ;
  23.     Begin (* DisplayDir Procedure *)
  24.     MyFiles := GetToken(InString);
  25.     Option := GetToken(InString);
  26.     Clrscr;
  27.     row := 2;
  28.     Drive := DefaultDrive+1 ;
  29.     If  (Length(MyFiles) > 1) then
  30.     If MyFiles[2] in ['/','\',':'] then
  31.          Begin  (* get drive *)
  32.          MyFiles[1] := UpCase(MyFiles[1]);
  33.          If MyFiles[1] in ['A'..'Z'] then
  34.               drive := ord(MyFiles[1])-ord('@') ;
  35.          End ; (* get drive *)
  36.     If Pos('.',Myfiles) = 0 then Myfiles := Myfiles + '*.*' ;
  37.     fcount := 0 ;
  38.     FindFirst(myfiles,anyfile,FileInfo);
  39.     If DosError = 0 then
  40.          Begin (* found files *)
  41.          fcount := fcount + 1 ;
  42.          writeln(' directory ',myfiles);
  43.          If (option[2] = 'P') or (option[2] = 'p') then
  44.          With FileInfo Do
  45.               Begin (* Full Page Display *)
  46.               writeln (name:16,'  ',
  47.                       ((Time and $1E000000) shr 25)+80,'-',(* year *)
  48.                        (Time and $01E00000) shr 21:2,'-',    (* month*)
  49.                        (Time and $001F0000) shr 16:2,'  ',   (* day  *)
  50.                        (Time and $0000F800) shr 11:2,':',    (* hour *)
  51.                        (Time and $000007E0) shr  5:2,':',    (* min. *)
  52.                        (Time and $0000001F):2,' ',           (* sec. *)
  53.                        size:8);
  54. Getnext :     (* list rest of files *)
  55.               Findnext(Fileinfo) ;
  56.               If DosError = 0 then
  57.                    begin (* list next file *)
  58.                    fcount := fcount + 1 ;
  59.                    writeln (name:16,'  ',
  60.                       ((Time and $1E000000) shr 25)+80,'-',  (* year *)
  61.                        (Time and $01E00000) shr 21:2,'-',    (* month*)
  62.                        (Time and $001F0000) shr 16:2,'  ',   (* day  *)
  63.                        (Time and $0000F800) shr 11:2,':',    (* hour *)
  64.                        (Time and $000007E0) shr  5:2,':',    (* min. *)
  65.                        (Time and $0000001F):2,' ',           (* sec. *)
  66.                         size:8);
  67.                    if row < 23 then  row := row + 1
  68.                                else
  69.                         begin
  70.                         Repeat until Keypressed ; achar := readkey;
  71.                         row := 2 ;
  72.                         end ;
  73.                    goto Getnext ;
  74.                    end ; (* list next file *)
  75.               End   (* Full Page Display *)
  76.                                       else
  77.               Begin (* Names only display *)
  78.               write(fileinfo.name);
  79.               column := 21 ; row := 2;
  80.               Findnext(FileInfo) ;
  81.               While DosError = 0 do
  82.                    begin (* list rest of files *)
  83.                    fcount := fcount + 1 ;
  84.                    gotoxy(column,row);
  85.                    write (fileinfo.name);
  86.                    column := column + 20 ;
  87.                    if column > 61 then
  88.                         begin row := row + 1 ; column := 1 ;  end ;
  89.                    Findnext(FileInfo);
  90.                    end ; (* list rest of files *)
  91.               End ;  (* Names only display *)
  92.          End   (* found files *)
  93.                                      else
  94.          writeln(' no file -',Myfiles,'- found ');
  95.     writeln(' ');
  96.     writeln('  ',fcount:4,' files');
  97.     If row > 21 then  Repeat until Keypressed ;
  98.     Writeln('Disk Drive ',chr(drive+$40),': ',
  99.              DiskFree(drive):8,' Bytes Free ') ;
  100.     End ; (* DisplayDir Procedure *)
  101.  
  102. (* ----------------------------------------------------------------- *)
  103. (*  EraseFiles - Erases a file or files from the disk.               *)
  104. (*                                                                   *)
  105. (* ----------------------------------------------------------------- *)
  106. Procedure EraseFiles (Myfiles : String) ;
  107. var
  108.     FileInfo : SearchRec ;
  109.     tempfile : text ;
  110.     column,row : integer ;
  111. Begin (* EraseFile Procedure *)
  112. While length(myfiles)<1 do
  113.     Begin (* get file name *)
  114.     write(' enter name of file to be erased > ');
  115.     readln(myfiles);
  116.     End ;
  117. FindFirst(myfiles,anyfile,FileInfo) ;
  118.   If DosError = 0  then
  119.     Begin (* found files *)
  120.     Clrscr;
  121.     writeln(' Erasing file(s) ',myfiles);
  122.     assign(tempfile,Prefixof(MyFiles)+FileInfo.name) ;
  123.     Erase(tempfile);
  124.     write(FileInfo.name);
  125.     column := 21 ; row := 2;
  126.     FindNext(FileInfo);
  127.     While DosError = 0 do
  128.          begin (* list rest of files *)
  129.          gotoxy(column,row);
  130.          assign(tempfile,Prefixof(MyFiles)+FileInfo.name);
  131.          Erase(tempfile);
  132.          write (FileInfo.name);
  133.          column := column + 20 ;
  134.          if column > 61 then
  135.               begin row := row + 1 ; column := 1 ;  end ;
  136.          FindNext(FileInfo) ;
  137.          end ; (* list rest of files *)
  138.     writeln(' ');
  139.     writeln('The above file(s) have been erased. ');
  140.     End   (* found files *)
  141.                                 else
  142.     writeln(' no file found ');
  143. End;  (* EraseFile *)
  144.  
  145. (* ----------------------------------------------------------------- *)
  146. (*  RenameFile - Remame a file.                                      *)
  147. (*                                                                   *)
  148. (* ----------------------------------------------------------------- *)
  149. Procedure RenameFile (Var Instring : String) ;
  150. var
  151.     oldname,newname : String ;
  152.     FileInfo : SearchRec ;
  153.     tempfile : text ;
  154. label exit ;
  155. Begin (* RenameFile Procedure *)
  156. If length(Instring)<1 then
  157.     Begin (* get file name *)
  158.     write(' Enter old file name  > ');
  159.     readln(Instring);
  160.     End ; (* get file name *)
  161. If length(Instring)<1 then goto exit ;
  162. oldname := uppercase(GetToken(instring));
  163. newname := uppercase(GetToken(instring));
  164. If length(newname)<1 then
  165.     Begin (* get new file name *)
  166.     write(' Enter new file name  > ');
  167.     readln(Instring);
  168.     newname := uppercase(GetToken(instring));
  169.     End ; (* get new file name *)
  170. delete(newname,1,length(prefixof(newname)));
  171. FindFirst(oldname,anyfile,FileInfo);
  172.   If DosError = 0 then
  173.     Begin (* found File *)
  174.     assign(tempfile,prefixof(oldname)+FileInfo.name);
  175.     Rename(tempfile,prefixof(oldname)+newname);
  176.     writeln(' ');
  177.     writeln('File ',oldname, ' renamed to ',newname);
  178.     End   (* found File *)
  179.                   else
  180.     writeln(' No file  - ',oldname);
  181. exit:
  182. End;  (* RenameFile *)
  183.  
  184. (* ----------------------------------------------------------------- *)
  185. (*  DisplayFile - display a file.                                    *)
  186. (*                                                                   *)
  187. (* ----------------------------------------------------------------- *)
  188. Procedure DisplayFile (Myfile : String) ;
  189. var
  190.     tempfile : text ;
  191.     achar : char ;
  192.     aachar,bbchar : byte ;
  193.     row,column : byte ;
  194.     displaying : boolean ;
  195.  
  196. label exit ;
  197. Begin (* DisplayFile Procedure *)
  198. If length(Myfile)<1 then
  199.     Begin (* get file name *)
  200.     write(' Enter  file name  > ');
  201.     readln(Myfile);
  202.     End ; (* get file name *)
  203. If length(Myfile)<1 then goto exit ;
  204. Assign(tempfile,myfile);
  205. {$I-}  Reset(tempfile); {$I+}
  206. If IOResult = 0  then
  207.     Begin (* found File *)
  208.     Clrscr ;
  209.     Displaying := not eof(tempfile) ;
  210.     While Displaying do
  211.        begin (* Display file *)
  212.        Read(tempfile,achar);
  213.        Write(achar);
  214.        column := column + 1 ;
  215.        if achar = chr($0D) then column := 1 ;
  216.        if achar = chr($0A) then row := row + 1 ;
  217.        if column > 80 then begin column := 1 ; row := row +1 ; end ;
  218.        If Row >= 24 then  (* prompt for more *)
  219.               begin (* page full *)
  220.               row := 1 ;
  221.               While not keychar(aachar,bbchar) Do  ;
  222.               if aachar in [$03,$1B] then displaying := false  ;
  223.               end ; (* page full *)
  224.        Displaying := displaying and (not Eof(tempfile)) ;
  225.        end;  (* Display file *)
  226.     writeln(' ');
  227.     End   (* found File *)
  228.                              else
  229.     writeln(' No file  - ',Myfile);
  230. exit:
  231. End;  (* DisplayFile *)
  232.  
  233. End. (* Local Unit *)