697 lines
26 KiB
ObjectPascal
697 lines
26 KiB
ObjectPascal
{$A+,B+,E+,F+,I+,L-,N-,O+,R-,S+,V-}
|
|
unit archive2;
|
|
|
|
interface
|
|
|
|
uses
|
|
crt, dos,
|
|
|
|
{rcg11172000 no overlay under Linux.}
|
|
{overlay,}
|
|
|
|
myio,
|
|
archive1, file0, file1, file4, file9, file11,
|
|
execbat,
|
|
common;
|
|
|
|
procedure doarccommand(cc:char);
|
|
|
|
implementation
|
|
|
|
const
|
|
maxdoschrline=127;
|
|
|
|
procedure doarccommand(cc:char);
|
|
const maxfiles=100;
|
|
var fl:array[1..maxfiles] of astr;
|
|
fn,s,s1,s2,os1:astr;
|
|
atype,numfl,rn,pl,savflistopt:integer;
|
|
i,j,x:integer;
|
|
c:char;
|
|
abort,next,done,ok,ok1:boolean;
|
|
fnx:boolean; {* whether fn points to file out of Telegard .DIR list *}
|
|
fil1,fil2:boolean; {* whether listed/unlisted files in list *}
|
|
wenttosysop,delbad,savpause:boolean;
|
|
f,f1:ulfrec;
|
|
rfpts:real;
|
|
fi:file of byte;
|
|
v:verbrec;
|
|
dstr,nstr,estr:astr;
|
|
bb:byte;
|
|
c_files,c_oldsiz,c_newsiz,oldsiz,newsiz:longint;
|
|
|
|
function stripname(i:astr):astr;
|
|
var i1:astr; n:integer;
|
|
|
|
function nextn:integer;
|
|
var n:integer;
|
|
begin
|
|
n:=pos(':',i1);
|
|
if (n=0) then n:=pos('\',i1);
|
|
if (n=0) then n:=pos('/',i1);
|
|
nextn:=n;
|
|
end;
|
|
|
|
begin
|
|
i1:=i;
|
|
while nextn<>0 do i1:=copy(i1,nextn+1,80);
|
|
stripname:=i1;
|
|
end;
|
|
|
|
procedure addfl(fn:astr; b:boolean);
|
|
var pl,rn,oldnumfl:integer;
|
|
f:ulfrec;
|
|
s,dstr,nstr,estr:astr;
|
|
dirinfo:searchrec;
|
|
begin
|
|
if (not b) then begin
|
|
oldnumfl:=numfl;
|
|
recno(fn,pl,rn);
|
|
if (fn<>'') and (pos('.',fn)<>0) and (rn<>0) then
|
|
while (fn<>'') and (rn<>0) and (numfl<maxfiles) do begin
|
|
seek(ulff,rn); read(ulff,f);
|
|
inc(numfl);
|
|
fl[numfl]:=f.filename;
|
|
nrecno(fn,pl,rn);
|
|
end;
|
|
if (numfl=oldnumfl) then print('No matching files.');
|
|
if (numfl>=maxfiles) then print('File records filled.');
|
|
end else begin
|
|
oldnumfl:=numfl;
|
|
fsplit(fn,dstr,nstr,estr); s:=dstr;
|
|
{rcg11242000 DOSism.}
|
|
{while (copy(s,length(s),1)='\') do s:=copy(s,1,length(s)-1);}
|
|
while (copy(s,length(s),1)='/') do s:=copy(s,1,length(s)-1);
|
|
{$I-} chdir(s); {$I+}
|
|
if ioresult<>0 then print('Path not found.')
|
|
else begin
|
|
findfirst(fn,AnyFile-Directory-VolumeID,dirinfo);
|
|
while (doserror=0) and (numfl<maxfiles) do begin
|
|
inc(numfl);
|
|
fl[numfl]:=fexpand(dstr+dirinfo.name);
|
|
findnext(dirinfo);
|
|
end;
|
|
if (numfl>=maxfiles) then print('File records filled.');
|
|
if (numfl=oldnumfl) then print('No matching files.');
|
|
end;
|
|
chdir(start_dir);
|
|
end;
|
|
end;
|
|
|
|
procedure testfiles(b:integer; fn:astr; delbad:boolean; var abort,next:boolean);
|
|
var fi:file of byte;
|
|
f:ulfrec;
|
|
oldboard,pl,rn,atype:integer;
|
|
ok:boolean;
|
|
begin
|
|
oldboard:=fileboard;
|
|
if (fileboard<>b) then changefileboard(b);
|
|
if (fileboard=b) then begin
|
|
recno(fn,pl,rn); { loads in memuboard }
|
|
abort:=FALSE; next:=FALSE;
|
|
while (fn<>'') and (rn<>0) and (not abort) and (not hangup) do begin
|
|
seek(ulff,rn); read(ulff,f);
|
|
fn:=memuboard.dlpath+f.filename;
|
|
atype:=arctype(fn);
|
|
if (atype<>0) then begin
|
|
pbn(abort,next); nl;
|
|
star('Testing "'+sqoutsp(fn)+'"');
|
|
ok:=TRUE;
|
|
if (not exist(fn)) then begin
|
|
star('File "'+sqoutsp(fn)+'" doesn''t exist.');
|
|
ok:=FALSE;
|
|
end else begin
|
|
arcintegritytest(ok,atype,sqoutsp(fn));
|
|
if (not ok) then begin
|
|
star('File "'+sqoutsp(fn)+'" didn''t pass integrity test.');
|
|
if (delbad) then begin
|
|
deleteff(rn,pl,TRUE);
|
|
assign(fi,fn);
|
|
{$I-} erase(fi); {$I+}
|
|
if (ioresult<>0) then star('Error erasing "'+sqoutsp(fn)+'"!');
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
nrecno(fn,pl,rn);
|
|
wkey(abort,next);
|
|
end;
|
|
close(ulff);
|
|
end;
|
|
fileboard:=oldboard;
|
|
end;
|
|
|
|
procedure cmtfiles(b:integer; fn:astr; var abort,next:boolean);
|
|
var fi:file of byte;
|
|
f:ulfrec;
|
|
oldboard,pl,rn,atype:integer;
|
|
ok:boolean;
|
|
begin
|
|
oldboard:=fileboard;
|
|
if (fileboard<>b) then changefileboard(b);
|
|
if (fileboard=b) then begin
|
|
recno(fn,pl,rn); { loads in memuboard }
|
|
abort:=FALSE; next:=FALSE;
|
|
while (fn<>'') and (rn<>0) and (not abort) and (not hangup) do begin
|
|
seek(ulff,rn); read(ulff,f);
|
|
fn:=memuboard.dlpath+f.filename;
|
|
atype:=arctype(fn);
|
|
if (atype<>0) then begin
|
|
pbn(abort,next); nl;
|
|
star('Commenting "'+sqoutsp(fn)+'"');
|
|
ok:=TRUE;
|
|
if (not exist(fn)) then begin
|
|
star('File "'+sqoutsp(fn)+'" doesn''t exist.');
|
|
ok:=FALSE;
|
|
end
|
|
else arccomment(ok,atype,memuboard.cmttype,sqoutsp(fn));
|
|
end;
|
|
nrecno(fn,pl,rn);
|
|
wkey(abort,next);
|
|
end;
|
|
close(ulff);
|
|
end;
|
|
fileboard:=oldboard;
|
|
end;
|
|
|
|
procedure cvtfiles(b:integer; fn:astr; toa:integer;
|
|
var c_files,c_oldsiz,c_newsiz:longint;
|
|
var abort,next:boolean);
|
|
var fi:file of byte;
|
|
f:ulfrec;
|
|
s:astr;
|
|
oldboard,pl,rn,atype:integer;
|
|
ok:boolean;
|
|
begin
|
|
oldboard:=fileboard;
|
|
if (fileboard<>b) then changefileboard(b);
|
|
if (fileboard=b) then begin
|
|
recno(fn,pl,rn); { loads in memuboard }
|
|
abort:=FALSE; next:=FALSE;
|
|
while (fn<>'') and (rn<>0) and (not abort) and (not hangup) do begin
|
|
seek(ulff,rn); read(ulff,f);
|
|
fn:=memuboard.dlpath+f.filename;
|
|
atype:=arctype(fn);
|
|
if (atype<>0) and (atype<>toa) then begin
|
|
pbn(abort,next); nl;
|
|
star('Converting "'+sqoutsp(fn)+'"');
|
|
ok:=FALSE;
|
|
if (not exist(fn)) then
|
|
star('File "'+sqoutsp(fn)+'" doesn''t exist.')
|
|
else begin
|
|
ok:=TRUE;
|
|
s:=copy(fn,1,pos('.',fn))+systat.filearcinfo[toa].ext;
|
|
{rcg11242000 DOSism}
|
|
{conva(ok,atype,bb,systat.temppath+'1\',sqoutsp(fn),sqoutsp(s));}
|
|
conva(ok,atype,bb,systat.temppath+'1/',sqoutsp(fn),sqoutsp(s));
|
|
if (ok) then begin
|
|
assign(fi,sqoutsp(fn));
|
|
{$I-} reset(fi); {$I+}
|
|
ok:=(ioresult=0);
|
|
if (ok) then begin
|
|
oldsiz:=trunc(filesize(fi));
|
|
close(fi);
|
|
end else
|
|
star('Unable to access "'+sqoutsp(fn)+'"');
|
|
if (ok) then
|
|
if (not exist(sqoutsp(s))) then begin
|
|
star('Unable to access "'+sqoutsp(s)+'"');
|
|
sysoplog('Unable to access "'+sqoutsp(s)+'"');
|
|
ok:=FALSE;
|
|
end;
|
|
end;
|
|
if (ok) then begin
|
|
f.filename:=align(stripname(sqoutsp(s)));
|
|
seek(ulff,rn); write(ulff,f);
|
|
{$I-} erase(fi); {$I+}
|
|
if (ioresult<>0) then begin
|
|
star('Unable to erase "'+sqoutsp(fn)+'"');
|
|
sysoplog('Unable to erase "'+sqoutsp(fn)+'"');
|
|
end;
|
|
|
|
assign(fi,sqoutsp(s));
|
|
{$I-} reset(fi); {$I+}
|
|
ok:=(ioresult=0);
|
|
if (not ok) then begin
|
|
star('Unable to access "'+sqoutsp(s)+'"');
|
|
sysoplog('Unable to access "'+sqoutsp(s)+'"');
|
|
end else begin
|
|
newsiz:=trunc(filesize(fi));
|
|
f.blocks:=trunc((filesize(fi)+127.0)/128.0);
|
|
close(fi);
|
|
seek(ulff,rn); write(ulff,f);
|
|
end;
|
|
|
|
if (ok) then begin
|
|
inc(c_oldsiz,oldsiz);
|
|
inc(c_newsiz,newsiz);
|
|
inc(c_files);
|
|
star('Old total space took up : '+cstrl(oldsiz)+' bytes');
|
|
star('New total space taken up : '+cstrl(newsiz)+' bytes');
|
|
if (oldsiz-newsiz>0) then
|
|
star('Space saved : '+cstrl(oldsiz-newsiz)+' bytes')
|
|
else
|
|
star('Space wasted : '+cstrl(newsiz-oldsiz)+' bytes');
|
|
end;
|
|
end else begin
|
|
sysoplog('Unable to convert "'+sqoutsp(fn)+'"');
|
|
star('Unable to convert "'+sqoutsp(fn)+'"');
|
|
end;
|
|
end;
|
|
end;
|
|
nrecno(fn,pl,rn);
|
|
wkey(abort,next);
|
|
end;
|
|
close(ulff);
|
|
end;
|
|
fileboard:=oldboard;
|
|
end;
|
|
|
|
begin
|
|
savpause:=(pause in thisuser.ac);
|
|
if (savpause) then thisuser.ac:=thisuser.ac-[pause];
|
|
savflistopt:=thisuser.flistopt; thisuser.flistopt:=0;
|
|
numfl:=0;
|
|
fiscan(pl); { loads in memuboard }
|
|
case cc of
|
|
'A':begin
|
|
nl;
|
|
print('Add file(s) to archive (up to '+cstr(maxfiles)+') -');
|
|
nl;
|
|
print('Archive filename: ');
|
|
prt(':'); mpl(78); input(fn,78);
|
|
if (fn<>'') then begin
|
|
if (pos('.',fn)=0) and (memuboard.arctype<>0) then
|
|
fn:=fn+'.'+systat.filearcinfo[memuboard.arctype].ext;
|
|
fnx:=isul(fn);
|
|
if (not fnx) then fn:=memuboard.dlpath+fn;
|
|
fn:=fexpand(fn); atype:=arctype(fn);
|
|
if (atype=0) then begin
|
|
print('Archive format not supported.');
|
|
listarctypes;
|
|
end else begin
|
|
done:=FALSE; c:='A';
|
|
repeat
|
|
if (c='A') then
|
|
repeat
|
|
nl;
|
|
print('Add files to list - <CR> to end');
|
|
prt(cstr(numfl)+':'); mpl(70); input(s,70);
|
|
if s<>'' then begin
|
|
if pos('.',s)=0 then s:=s+'*.*';
|
|
addfl(s,isul(s));
|
|
end;
|
|
until (s='') or (numfl>=maxfiles) or (hangup);
|
|
nl;
|
|
prt('Add files to list (?=help) : '); onek(c,'QADLR?');
|
|
nl;
|
|
case c of
|
|
'?':begin
|
|
lcmds(19,3,'Add more to list','Do it!');
|
|
lcmds(19,3,'List files in list','Remove files from list');
|
|
lcmds(19,3,'Quit','');
|
|
end;
|
|
'D':begin
|
|
i:=0;
|
|
repeat
|
|
inc(i); j:=1;
|
|
s2:=sqoutsp(fl[i]);
|
|
if not isul(s2) then
|
|
s2:=memuboard.dlpath+s2;
|
|
s1:=arcmci(systat.filearcinfo[atype].arcline,fn,s2);
|
|
os1:=s1;
|
|
while (length(s1)<=maxdoschrline) and (i<numfl) do begin
|
|
inc(i); inc(j);
|
|
s2:=sqoutsp(fl[i]);
|
|
if (not isul(s2)) then
|
|
s2:=memuboard.dlpath+s2;
|
|
os1:=s1;
|
|
s1:=s1+' '+s2;
|
|
end;
|
|
if (length(s1)>maxdoschrline) then begin
|
|
dec(i); dec(j);
|
|
s1:=os1;
|
|
end;
|
|
ok:=TRUE;
|
|
star('Adding '+cstr(j)+' files to archive...');
|
|
shel1;
|
|
{rcg11242000 DOSism}
|
|
{
|
|
execbatch(ok,TRUE,'tgtemp1.bat','tgtemp1.$$$',
|
|
systat.temppath+'1\',s1,
|
|
systat.filearcinfo[atype].succlevel);
|
|
}
|
|
execbatch(ok,TRUE,'tgtemp1.bat','tgtemp1.$$$',
|
|
systat.temppath+'1/',s1,
|
|
systat.filearcinfo[atype].succlevel);
|
|
shel2;
|
|
if (not ok) then begin
|
|
star('Errors in adding files');
|
|
ok:=pynq('Continue anyway? ');
|
|
if (hangup) then ok:=FALSE;
|
|
end;
|
|
until (i>=numfl) or (not ok);
|
|
arccomment(ok,atype,memuboard.cmttype,fn);
|
|
nl;
|
|
if (not fnx) then begin
|
|
s2:=stripname(fn);
|
|
recno(s2,pl,rn);
|
|
if (rn<>0) then
|
|
sprint(#3#5+'NOTE: File already exists in listing!');
|
|
if pynq('Add archive to listing? ') then begin
|
|
assign(fi,fn);
|
|
{$I-} reset(fi); {$I+}
|
|
if ioresult=0 then begin
|
|
f.blocks:=trunc((filesize(fi)+127.0)/128.0);
|
|
close(fi);
|
|
end;
|
|
f.filename:=s2;
|
|
ok1:=TRUE;
|
|
if pynq('Use stats of file in directory? ') then begin
|
|
repeat
|
|
nl;
|
|
prt('Enter filename: '); mpl(12); input(s2,12);
|
|
recno(s2,pl,rn);
|
|
if rn=0 then print('File not found!');
|
|
if s2='' then print('Aborted!');
|
|
until (rn<>0) or (s2='') or (hangup);
|
|
if s2<>'' then begin
|
|
seek(ulff,rn); read(ulff,f1);
|
|
with f do begin
|
|
description:=f1.description;
|
|
vpointer:=f1.vpointer;
|
|
nacc:=f1.nacc;
|
|
ft:=f1.ft;
|
|
owner:=f1.owner;
|
|
stowner:=f1.stowner;
|
|
date:=f1.date;
|
|
daten:=f1.daten;
|
|
end;
|
|
f1.vpointer:=-1;
|
|
seek(ulff,rn); write(ulff,f1);
|
|
end else
|
|
ok1:=FALSE;
|
|
end else
|
|
ok1:=FALSE;
|
|
|
|
if (not ok1) then begin
|
|
wenttosysop:=FALSE;
|
|
dodescrs(f,v,pl,wenttosysop);
|
|
f.nacc:=0;
|
|
f.ft:=255;
|
|
f.owner:=usernum;
|
|
f.stowner:=allcaps(thisuser.name);
|
|
f.date:=date;
|
|
f.daten:=daynum(date);
|
|
end;
|
|
|
|
f.filestat:=[];
|
|
if (not fso) and (not systat.validateallfiles) then
|
|
f.filestat:=f.filestat+[notval];
|
|
|
|
if (not systat.fileptratio) then f.filepoints:=0
|
|
else begin
|
|
rfpts:=(f.blocks/8)/systat.fileptcompbasesize;
|
|
f.filepoints:=round(rfpts);
|
|
end;
|
|
|
|
if (rn=0) then newff(f,v) else writefv(rn,f,v);
|
|
end;
|
|
end;
|
|
if pynq('Delete original files? ') then
|
|
for i:=1 to numfl do begin
|
|
s2:=sqoutsp(fl[i]);
|
|
if not isul(fl[i]) then begin
|
|
recno(s2,pl,rn);
|
|
if rn<>0 then deleteff(rn,pl,TRUE);
|
|
s2:=memuboard.dlpath+s2;
|
|
end;
|
|
assign(fi,s2);
|
|
{$I-} erase(fi); {$I+}
|
|
if (ioresult<>0) then
|
|
print('"'+s2+'": Could not delete');
|
|
end;
|
|
if ok then done:=TRUE;
|
|
end;
|
|
'L':if (numfl=0) then print('No files in list!')
|
|
else begin
|
|
abort:=FALSE; next:=FALSE;
|
|
s:=''; j:=0;
|
|
i:=0;
|
|
repeat
|
|
inc(i);
|
|
if isul(fl[i]) then s:=s+#3#3 else s:=s+#3#1;
|
|
s:=s+align(stripname(fl[i]));
|
|
inc(j);
|
|
if j<5 then s:=s+' '
|
|
else begin
|
|
printacr(s,abort,next);
|
|
s:=''; j:=0;
|
|
end;
|
|
until (i=numfl) or (abort) or (hangup);
|
|
if (j in [1..4]) and (not abort) then
|
|
printacr(s,abort,next);
|
|
end;
|
|
'R':begin
|
|
prt('Remove filename: '); mpl(12); input(s,12);
|
|
i:=0;
|
|
repeat
|
|
inc(i);
|
|
if align(stripname(fl[i]))=align(s) then begin
|
|
s1:=sqoutsp(fl[i]); sprompt(#3#3+s1);
|
|
if pynq(' Remove it? ') then begin
|
|
for j:=i to numfl-1 do fl[j]:=fl[j+1];
|
|
dec(numfl); dec(i);
|
|
end;
|
|
end;
|
|
until (i>=numfl);
|
|
end;
|
|
'Q':done:=TRUE;
|
|
end;
|
|
until (done) or (hangup);
|
|
|
|
end;
|
|
end;
|
|
end;
|
|
'C':begin
|
|
nl;
|
|
print('Convert archive formats -');
|
|
nl;
|
|
print('Filespec:');
|
|
prt(':'); mpl(78); input(fn,78);
|
|
c_files:=0; c_oldsiz:=0; c_newsiz:=0;
|
|
if (fn<>'') then begin
|
|
nl;
|
|
abort:=FALSE; next:=FALSE;
|
|
repeat
|
|
prt('Archive type to use? (?=List) : '); input(s,3);
|
|
if (s='?') then begin nl; listarctypes; nl; end;
|
|
until (s<>'?');
|
|
if (value(s)<>0) then bb:=value(s)
|
|
else bb:=arctype(s+'FILENAME.'+s);
|
|
if (bb<>0) then begin
|
|
sysoplog('Conversion process began at '+date+' '+time+'.');
|
|
if (isul(fn)) then begin
|
|
fsplit(fn,dstr,nstr,estr); s:=dstr;
|
|
findfirst(fn,AnyFile-Directory-VolumeID,dirinfo);
|
|
abort:=FALSE; next:=FALSE;
|
|
while (doserror=0) and (not abort) and (not hangup) do begin
|
|
fn:=fexpand(sqoutsp(dstr+dirinfo.name));
|
|
atype:=arctype(fn);
|
|
if (atype<>0) and (atype<>bb) then begin
|
|
star('Converting "'+fn+'"');
|
|
ok:=TRUE;
|
|
s:=copy(fn,1,pos('.',s))+systat.filearcinfo[bb].ext;
|
|
{rcg11242000 DOSism.}
|
|
{conva(ok,atype,bb,systat.temppath+'1\',fn,s);}
|
|
conva(ok,atype,bb,systat.temppath+'1/',fn,s);
|
|
if (ok) then begin
|
|
assign(fi,sqoutsp(fn));
|
|
{$I-} reset(fi); {$I+}
|
|
ok:=(ioresult=0);
|
|
if (ok) then begin
|
|
oldsiz:=trunc(filesize(fi));
|
|
close(fi);
|
|
end else
|
|
star('Unable to access "'+sqoutsp(fn)+'"');
|
|
if (ok) then
|
|
if (not exist(sqoutsp(s))) then begin
|
|
star('Unable to access "'+sqoutsp(s)+'"');
|
|
sysoplog('Unable to access "'+sqoutsp(s)+'"');
|
|
ok:=FALSE;
|
|
end;
|
|
end;
|
|
if (ok) then begin
|
|
{$I-} erase(fi); {$I+}
|
|
if (ioresult<>0) then
|
|
star('Unable to erase "'+sqoutsp(fn)+'"');
|
|
|
|
assign(fi,sqoutsp(s));
|
|
{$I-} reset(fi); {$I+}
|
|
ok:=(ioresult=0);
|
|
if (ok) then begin
|
|
newsiz:=trunc(filesize(fi));
|
|
close(fi);
|
|
end else
|
|
star('Unable to access "'+sqoutsp(s)+'"');
|
|
|
|
if (ok) then begin
|
|
inc(c_oldsiz,oldsiz);
|
|
inc(c_newsiz,newsiz);
|
|
inc(c_files);
|
|
star('Old total space took up : '+cstrl(oldsiz)+' bytes');
|
|
star('New total space taken up : '+cstrl(newsiz)+' bytes');
|
|
if (oldsiz-newsiz>0) then
|
|
star('Space saved : '+cstrl(oldsiz-newsiz)+' bytes')
|
|
else
|
|
star('Space wasted : '+cstrl(newsiz-oldsiz)+' bytes');
|
|
end;
|
|
end else begin
|
|
sysoplog('Unable to convert "'+sqoutsp(fn)+'"');
|
|
star('Unable to convert "'+sqoutsp(fn)+'"');
|
|
end;
|
|
end;
|
|
findnext(dirinfo);
|
|
wkey(abort,next);
|
|
end;
|
|
{ if (abort) then sprint('@M'+#3#7+'Conversion aborted.');}
|
|
end else begin
|
|
ok1:=pynq('Search all directories? ');
|
|
nl;
|
|
if (ok1) then begin
|
|
i:=0; abort:=FALSE; next:=FALSE;
|
|
while (not abort) and (i<=maxulb) and (not hangup) do begin
|
|
if (fbaseac(i)) then
|
|
cvtfiles(i,fn,bb,c_files,c_oldsiz,c_newsiz,abort,next);
|
|
inc(i);
|
|
wkey(abort,next);
|
|
if (next) then abort:=FALSE;
|
|
end;
|
|
end else
|
|
cvtfiles(fileboard,fn,bb,c_files,c_oldsiz,c_newsiz,
|
|
abort,next);
|
|
reset(ulff);
|
|
end;
|
|
sysoplog('Conversion process ended at '+date+' '+time+'.');
|
|
nl;
|
|
nl;
|
|
star('Total archives converted : '+cstr(c_files));
|
|
star('Old total space took up : '+cstrl(c_oldsiz)+' bytes');
|
|
star('New total space taken up : '+cstrl(c_newsiz)+' bytes');
|
|
if (c_oldsiz-c_newsiz>0) then
|
|
star('Space saved : '+cstrl(c_oldsiz-c_newsiz)+' bytes')
|
|
else
|
|
star('Space wasted : '+cstrl(c_newsiz-c_oldsiz)+' bytes');
|
|
sysoplog('Converted '+cstr(c_files)+' archives; old size='+
|
|
cstrl(c_oldsiz)+' bytes, new size='+cstrl(c_newsiz)+' bytes');
|
|
end;
|
|
end;
|
|
end;
|
|
'M':begin
|
|
nl;
|
|
print('Comment field update -');
|
|
nl;
|
|
print('Filespec:');
|
|
prt(':'); mpl(78); input(fn,78);
|
|
if (fn<>'') then begin
|
|
nl;
|
|
abort:=FALSE; next:=FALSE;
|
|
if (isul(fn)) then begin
|
|
prt('Comment type to use? (1-3,0=None) [1] : ');
|
|
ini(bb);
|
|
if (badini) then bb:=1;
|
|
if (bb<0) or (bb>3) then bb:=1;
|
|
fsplit(fn,dstr,nstr,estr); s:=dstr;
|
|
findfirst(fn,AnyFile-Directory-VolumeID,dirinfo);
|
|
abort:=FALSE; next:=FALSE;
|
|
while (doserror=0) and (not abort) and (not hangup) do begin
|
|
fn:=fexpand(sqoutsp(dstr+dirinfo.name));
|
|
atype:=arctype(fn);
|
|
if (atype<>0) then begin
|
|
star('Commenting "'+fn+'"');
|
|
ok:=TRUE;
|
|
arccomment(ok,atype,bb,fn);
|
|
end;
|
|
findnext(dirinfo);
|
|
wkey(abort,next);
|
|
end;
|
|
{ if (abort) then sprint('@M'+#3#7+'Comment update aborted.');}
|
|
end else begin
|
|
ok1:=pynq('Search all directories? ');
|
|
nl;
|
|
if (ok1) then begin
|
|
i:=0; abort:=FALSE; next:=FALSE;
|
|
while (not abort) and (i<=maxulb) and (not hangup) do begin
|
|
if (fbaseac(i)) then cmtfiles(i,fn,abort,next);
|
|
inc(i);
|
|
wkey(abort,next);
|
|
if (next) then abort:=FALSE;
|
|
end;
|
|
end else
|
|
cmtfiles(fileboard,fn,abort,next);
|
|
reset(ulff);
|
|
end;
|
|
end;
|
|
end;
|
|
'T':begin
|
|
nl;
|
|
print('File integrity testing -');
|
|
nl;
|
|
print('Filespec:');
|
|
prt(':'); mpl(78); input(fn,78);
|
|
if (fn<>'') then begin
|
|
nl;
|
|
delbad:=pynq('Delete files that don''t pass the test? ');
|
|
nl;
|
|
abort:=FALSE; next:=FALSE;
|
|
if (isul(fn)) then begin
|
|
fsplit(fn,dstr,nstr,estr); s:=dstr;
|
|
findfirst(fn,AnyFile-Directory-VolumeID,dirinfo);
|
|
abort:=FALSE; next:=FALSE;
|
|
while (doserror=0) and (not abort) and (not hangup) do begin
|
|
fn:=fexpand(sqoutsp(dstr+dirinfo.name));
|
|
atype:=arctype(fn);
|
|
if (atype<>0) then begin
|
|
star('Testing "'+fn+'"');
|
|
ok:=TRUE;
|
|
arcintegritytest(ok,atype,fn);
|
|
if (not ok) then begin
|
|
star('File "'+fn+'" didn''t pass integrity test.');
|
|
if (delbad) then begin
|
|
assign(fi,fn);
|
|
{$I-} erase(fi); {$I+}
|
|
if (ioresult<>0) then star('Error erasing "'+fn+'"!');
|
|
end;
|
|
end;
|
|
end;
|
|
findnext(dirinfo);
|
|
wkey(abort,next);
|
|
end;
|
|
{ if (abort) then sprint('@M'+#3#7+'Integrity testing aborted.');}
|
|
end else begin
|
|
ok1:=pynq('Search all directories? ');
|
|
nl;
|
|
if (ok1) then begin
|
|
i:=0; abort:=FALSE; next:=FALSE;
|
|
while (not abort) and (i<=maxulb) and (not hangup) do begin
|
|
if (fbaseac(i)) then testfiles(i,fn,delbad,abort,next);
|
|
inc(i);
|
|
wkey(abort,next);
|
|
if (next) then abort:=FALSE;
|
|
end;
|
|
end else
|
|
testfiles(fileboard,fn,delbad,abort,next);
|
|
reset(ulff);
|
|
end;
|
|
end;
|
|
end;
|
|
'X':begin {* extract *}
|
|
end;
|
|
end;
|
|
close(ulff);
|
|
thisuser.flistopt:=savflistopt;
|
|
if (savpause) then thisuser.ac:=thisuser.ac+[pause];
|
|
end;
|
|
|
|
end.
|