Unit Local ; Interface Uses Dos,Crt, (* Standard Turbo Pascal Units *) KGlobals,Sysfunc ; Procedure DisplayDir ( Var InString : String) ; Procedure EraseFiles ( Myfiles : String) ; Procedure RenameFile ( Var Instring : String) ; Procedure DisplayFile( Myfile : String) ; Implementation (* ----------------------------------------------------------------- *) (* DisplayDir - Displays the directory for the mask given in the *) (* input parameter string. *) (* ----------------------------------------------------------------- *) Procedure DisplayDir (Var InString : String) ; var MyFiles,fileprefix,option : String ; FileInfo : SearchRec ; Drive : byte ; Achar : char ; column,row,fcount : integer ; label Getnext ; Begin (* DisplayDir Procedure *) MyFiles := GetToken(InString); Option := GetToken(InString); Clrscr; row := 2; Drive := DefaultDrive+1 ; If (Length(MyFiles) > 1) then If MyFiles[2] in ['/','\',':'] then Begin (* get drive *) MyFiles[1] := UpCase(MyFiles[1]); If MyFiles[1] in ['A'..'Z'] then drive := ord(MyFiles[1])-ord('@') ; End ; (* get drive *) If Pos('.',Myfiles) = 0 then Myfiles := Myfiles + '*.*' ; fcount := 0 ; FindFirst(myfiles,anyfile,FileInfo); If DosError = 0 then Begin (* found files *) fcount := fcount + 1 ; writeln(' directory ',myfiles); If (option[2] = 'P') or (option[2] = 'p') then With FileInfo Do Begin (* Full Page Display *) writeln (name:16,' ', ((Time and $1E000000) shr 25)+80,'-',(* year *) (Time and $01E00000) shr 21:2,'-', (* month*) (Time and $001F0000) shr 16:2,' ', (* day *) (Time and $0000F800) shr 11:2,':', (* hour *) (Time and $000007E0) shr 5:2,':', (* min. *) (Time and $0000001F):2,' ', (* sec. *) size:8); Getnext : (* list rest of files *) Findnext(Fileinfo) ; If DosError = 0 then begin (* list next file *) fcount := fcount + 1 ; writeln (name:16,' ', ((Time and $1E000000) shr 25)+80,'-', (* year *) (Time and $01E00000) shr 21:2,'-', (* month*) (Time and $001F0000) shr 16:2,' ', (* day *) (Time and $0000F800) shr 11:2,':', (* hour *) (Time and $000007E0) shr 5:2,':', (* min. *) (Time and $0000001F):2,' ', (* sec. *) size:8); if row < 23 then row := row + 1 else begin Repeat until Keypressed ; achar := readkey; row := 2 ; end ; goto Getnext ; end ; (* list next file *) End (* Full Page Display *) else Begin (* Names only display *) write(fileinfo.name); column := 21 ; row := 2; Findnext(FileInfo) ; While DosError = 0 do begin (* list rest of files *) fcount := fcount + 1 ; gotoxy(column,row); write (fileinfo.name); column := column + 20 ; if column > 61 then begin row := row + 1 ; column := 1 ; end ; Findnext(FileInfo); end ; (* list rest of files *) End ; (* Names only display *) End (* found files *) else writeln(' no file -',Myfiles,'- found '); writeln(' '); writeln(' ',fcount:4,' files'); If row > 21 then Repeat until Keypressed ; Writeln('Disk Drive ',chr(drive+$40),': ', DiskFree(drive):8,' Bytes Free ') ; End ; (* DisplayDir Procedure *) (* ----------------------------------------------------------------- *) (* EraseFiles - Erases a file or files from the disk. *) (* *) (* ----------------------------------------------------------------- *) Procedure EraseFiles (Myfiles : String) ; var FileInfo : SearchRec ; tempfile : text ; column,row : integer ; Begin (* EraseFile Procedure *) While length(myfiles)<1 do Begin (* get file name *) write(' enter name of file to be erased > '); readln(myfiles); End ; FindFirst(myfiles,anyfile,FileInfo) ; If DosError = 0 then Begin (* found files *) Clrscr; writeln(' Erasing file(s) ',myfiles); assign(tempfile,Prefixof(MyFiles)+FileInfo.name) ; Erase(tempfile); write(FileInfo.name); column := 21 ; row := 2; FindNext(FileInfo); While DosError = 0 do begin (* list rest of files *) gotoxy(column,row); assign(tempfile,Prefixof(MyFiles)+FileInfo.name); Erase(tempfile); write (FileInfo.name); column := column + 20 ; if column > 61 then begin row := row + 1 ; column := 1 ; end ; FindNext(FileInfo) ; end ; (* list rest of files *) writeln(' '); writeln('The above file(s) have been erased. '); End (* found files *) else writeln(' no file found '); End; (* EraseFile *) (* ----------------------------------------------------------------- *) (* RenameFile - Remame a file. *) (* *) (* ----------------------------------------------------------------- *) Procedure RenameFile (Var Instring : String) ; var oldname,newname : String ; FileInfo : SearchRec ; tempfile : text ; label exit ; Begin (* RenameFile Procedure *) If length(Instring)<1 then Begin (* get file name *) write(' Enter old file name > '); readln(Instring); End ; (* get file name *) If length(Instring)<1 then goto exit ; oldname := uppercase(GetToken(instring)); newname := uppercase(GetToken(instring)); If length(newname)<1 then Begin (* get new file name *) write(' Enter new file name > '); readln(Instring); newname := uppercase(GetToken(instring)); End ; (* get new file name *) delete(newname,1,length(prefixof(newname))); FindFirst(oldname,anyfile,FileInfo); If DosError = 0 then Begin (* found File *) assign(tempfile,prefixof(oldname)+FileInfo.name); Rename(tempfile,prefixof(oldname)+newname); writeln(' '); writeln('File ',oldname, ' renamed to ',newname); End (* found File *) else writeln(' No file - ',oldname); exit: End; (* RenameFile *) (* ----------------------------------------------------------------- *) (* DisplayFile - display a file. *) (* *) (* ----------------------------------------------------------------- *) Procedure DisplayFile (Myfile : String) ; var tempfile : text ; achar : char ; aachar,bbchar : byte ; row,column : byte ; displaying : boolean ; label exit ; Begin (* DisplayFile Procedure *) If length(Myfile)<1 then Begin (* get file name *) write(' Enter file name > '); readln(Myfile); End ; (* get file name *) If length(Myfile)<1 then goto exit ; Assign(tempfile,myfile); {$I-} Reset(tempfile); {$I+} If IOResult = 0 then Begin (* found File *) Clrscr ; Displaying := not eof(tempfile) ; While Displaying do begin (* Display file *) Read(tempfile,achar); Write(achar); column := column + 1 ; if achar = chr($0D) then column := 1 ; if achar = chr($0A) then row := row + 1 ; if column > 80 then begin column := 1 ; row := row +1 ; end ; If Row >= 24 then (* prompt for more *) begin (* page full *) row := 1 ; While not keychar(aachar,bbchar) Do ; if aachar in [$03,$1B] then displaying := false ; end ; (* page full *) Displaying := displaying and (not Eof(tempfile)) ; end; (* Display file *) writeln(' '); End (* found File *) else writeln(' No file - ',Myfile); exit: End; (* DisplayFile *) End. (* Local Unit *)