home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
pub
/
queenskermit
/
local.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
2020-01-01
|
9KB
|
233 lines
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 *)