356 lines
11 KiB
ObjectPascal
356 lines
11 KiB
ObjectPascal
{$A+,B+,E+,F+,I+,L+,N-,O+,R-,S+,V-}
|
|
unit file9;
|
|
|
|
interface
|
|
|
|
uses
|
|
crt, dos,
|
|
|
|
{rcg11172000 no overlay under Linux.}
|
|
{overlay,}
|
|
|
|
myio,
|
|
file0, file1, file2,
|
|
common;
|
|
|
|
function info:astr;
|
|
procedure dir(cd,x:astr; expanded:boolean);
|
|
procedure dirf(expanded:boolean);
|
|
procedure deleteff(rn:integer; var pl:integer; killverbose:boolean);
|
|
procedure remove;
|
|
procedure setdirs;
|
|
procedure pointdate;
|
|
procedure yourfileinfo;
|
|
procedure listopts;
|
|
|
|
implementation
|
|
|
|
function align2(s:astr):astr;
|
|
begin
|
|
if pos('.',s)=0 then s:=mln(s,12)
|
|
else s:=mln(copy(s,1,pos('.',s)-1),8)+' '+mln(copy(s,pos('.',s)+1,3),3);
|
|
align2:=s;
|
|
end;
|
|
|
|
function info:astr;
|
|
var pm:char;
|
|
i:integer;
|
|
s:astr;
|
|
dt:datetime;
|
|
|
|
function ti(i:integer):astr;
|
|
var s:astr;
|
|
begin
|
|
ti:=tch(cstr(i));
|
|
end;
|
|
|
|
begin
|
|
s:=dirinfo.name;
|
|
if (dirinfo.attr and directory)=directory then s:=mln(s,13)+'<DIR> '
|
|
else s:=align2(s)+' '+mrn(cstrl(dirinfo.size),7);
|
|
unpacktime(dirinfo.time,dt);
|
|
with dt do begin
|
|
if hour<13 then pm:='a' else begin pm:='p'; hour:=hour-12; end;
|
|
{rcg11272000 Y2K-proofing.}
|
|
{
|
|
s:=s+' '+mrn(cstr(month),2)+'-'+ti(day)+'-'+ti(year-1900)+
|
|
' '+mrn(cstr(hour),2)+':'+ti(min)+pm;
|
|
}
|
|
s:=s+' '+mrn(cstr(month),2)+'-'+ti(day)+'-'+cstr(year)+
|
|
' '+mrn(cstr(hour),2)+':'+ti(min)+pm;
|
|
end;
|
|
info:=s;
|
|
end;
|
|
|
|
procedure dir(cd,x:astr; expanded:boolean);
|
|
var abort,next,nofiles:boolean;
|
|
s:astr;
|
|
onlin:integer;
|
|
dfs:longint;
|
|
numfiles:integer;
|
|
begin
|
|
{rcg11242000 DOSism.}
|
|
{if (copy(cd,length(cd),1)<>'\') then cd:=cd+'\';}
|
|
if (copy(cd,length(cd),1)<>'/') then cd:=cd+'/';
|
|
abort:=FALSE;
|
|
cd:=cd+x;
|
|
if (fso) then begin
|
|
printacr(#3#5+' Directory of '+#3#3+copy(cd,1,length(cd)),abort,next);
|
|
nl;
|
|
end;
|
|
s:=''; onlin:=0; numfiles:=0; nofiles:=TRUE;
|
|
ffile(cd);
|
|
while (found) and (not abort) do begin
|
|
if (not (dirinfo.attr and directory=directory)) or (fso) then
|
|
if (not (dirinfo.attr and volumeid=volumeid)) then
|
|
if ((not (dirinfo.attr and dos.hidden=dos.hidden)) or (usernum=1)) then
|
|
if ((dirinfo.attr and dos.hidden=dos.hidden) and
|
|
(not (dirinfo.attr and directory=directory))) or
|
|
(not (dirinfo.attr and dos.hidden=dos.hidden)) then begin
|
|
nofiles:=FALSE;
|
|
if (expanded) then printacr(info,abort,next)
|
|
else begin
|
|
inc(onlin);
|
|
s:=s+align2(dirinfo.name);
|
|
if onlin<>5 then s:=s+' ' else begin
|
|
printacr(s,abort,next);
|
|
s:=''; onlin:=0;
|
|
end;
|
|
end;
|
|
inc(numfiles);
|
|
end;
|
|
nfile;
|
|
end;
|
|
if (not found) and (onlin in [1..5]) then printacr(s,abort,next);
|
|
dfs:=freek(exdrv(cd));
|
|
if (nofiles) then s:=#3#3+'Files not found'
|
|
else s:=#3#3+mrn(cstr(numfiles)+#3#5+' File(s)',17);
|
|
printacr(s+#3#3+mrn(cstrl(dfs*1024),10)+#3#5+' bytes free',abort,next);
|
|
end;
|
|
|
|
procedure dirf(expanded:boolean);
|
|
var fspec:astr;
|
|
abort,next,all:boolean;
|
|
begin
|
|
nl;
|
|
print('Raw directory.');
|
|
gfn(fspec); abort:=FALSE; next:=FALSE;
|
|
nl;
|
|
loaduboard(fileboard);
|
|
dir(memuboard.dlpath,fspec,expanded);
|
|
end;
|
|
|
|
procedure deleteff(rn:integer; var pl:integer; killverbose:boolean);
|
|
var i:integer;
|
|
f:ulfrec;
|
|
v:verbrec;
|
|
begin
|
|
if (rn<=pl) and (rn>0) then begin
|
|
dec(pl);
|
|
seek(ulff,rn); read(ulff,f);
|
|
if (f.vpointer<>-1) and (killverbose) then begin
|
|
assign(verbf,systat.gfilepath+'verbose.dat');
|
|
reset(verbf);
|
|
seek(verbf,f.vpointer); read(verbf,v);
|
|
if (ioresult=0) then begin
|
|
v.descr[1]:='';
|
|
seek(verbf,f.vpointer); write(verbf,v);
|
|
end;
|
|
close(verbf);
|
|
end;
|
|
for i:=rn to pl do begin
|
|
seek(ulff,i+1); read(ulff,f);
|
|
seek(ulff,i); write(ulff,f);
|
|
end;
|
|
seek(ulff,0); f.blocks:=pl; write(ulff,f);
|
|
end;
|
|
end;
|
|
|
|
procedure remove;
|
|
var done,abort,next,subit:boolean;
|
|
c:char;
|
|
pl,rn:integer;
|
|
s,fn:astr;
|
|
ff:file;
|
|
f:ulfrec;
|
|
u:userrec;
|
|
begin
|
|
nl;
|
|
print('Remove files.');
|
|
gfn(fn); abort:=FALSE; next:=FALSE;
|
|
nl;
|
|
recno(fn,pl,rn);
|
|
if (baddlpath) then exit;
|
|
if (fn='') or (pos('.',fn)=0) or (rn=0) then
|
|
print('No matching files.')
|
|
else begin
|
|
lastcommandovr:=TRUE;
|
|
c:=#0;
|
|
while (fn<>'') and (rn<>0) and (not abort) and (not hangup) do begin
|
|
seek(ulff,rn); read(ulff,f);
|
|
reset(uf); seek(uf,f.owner); read(uf,u);
|
|
if (rn<>0) then begin
|
|
done:=FALSE;
|
|
repeat
|
|
if (c<>'?') then begin
|
|
nl;
|
|
fileinfo(f,FALSE,abort,next);
|
|
nl;
|
|
end;
|
|
if (next) then c:='N' else begin
|
|
prt('Remove files (?=help) : ');
|
|
if (f.owner<>usernum) and (not fso) then
|
|
onek(c,'QN?'^M)
|
|
else onek(c,'QDN?'^M);
|
|
end;
|
|
case c of
|
|
^M:c:=#0; {* do nothing *}
|
|
'?':begin
|
|
nl;
|
|
print('<CR>Redisplay entry');
|
|
if (f.owner<>usernum) and (not fso) then
|
|
lcmds(12,3,'Next file','Quit')
|
|
else begin
|
|
lcmds(12,3,'Delete file','Next file');
|
|
lcmds(12,3,'Quit','');
|
|
end;
|
|
nl;
|
|
end;
|
|
'D':if (f.owner<>usernum) and (not fso) then
|
|
sprint(#3#7+'You can''t delete this!!')
|
|
else begin
|
|
deleteff(rn,pl,TRUE);
|
|
dec(lrn);
|
|
s:='Removed "'+sqoutsp(f.filename)+'" from Dir#'+cstr(fileboard);
|
|
nl;
|
|
if (not exist(memuboard.dlpath+f.filename)) then
|
|
sprint(#3#5+'File does not exist!')
|
|
else
|
|
if (fso) then
|
|
if pynq('Erase file too? ') then begin
|
|
assign(ff,memuboard.dlpath+f.filename);
|
|
{$I-} erase(ff); {$I+}
|
|
if (ioresult=0) then s:=s+' [FILE DELETED]'
|
|
else
|
|
s:='Tried deleting "'+sqoutsp(f.filename)+'" from Dir#'+cstr(fileboard);
|
|
end;
|
|
|
|
subit:=(allcaps(f.stowner)=allcaps(u.name));
|
|
if (fso) then
|
|
if (not subit) then begin
|
|
print('Uploader name does not match user name!');
|
|
print('Cannot remove credit from user.');
|
|
end else
|
|
subit:=pynq('Remove from '+#3#5+caps(u.name)+' #'+
|
|
cstr(f.owner)+#3#7+'''s ratio? ');
|
|
|
|
if (subit) then begin
|
|
if (f.owner=usernum) then u:=thisuser;
|
|
with u do begin
|
|
uk:=uk-(f.blocks div 8);
|
|
dec(uploads);
|
|
if (uk<0) then uk:=0;
|
|
if (uploads<0) then uploads:=0;
|
|
end;
|
|
seek(uf,f.owner); write(uf,u);
|
|
if (f.owner=usernum) then thisuser:=u;
|
|
end;
|
|
sysoplog(s);
|
|
done:=TRUE;
|
|
end;
|
|
else
|
|
done:=TRUE;
|
|
end;
|
|
until ((done) or (hangup));
|
|
abort:=FALSE; next:=FALSE;
|
|
if (c='Q') then abort:=TRUE;
|
|
if (c<>'?') then nrecno(fn,pl,rn);
|
|
end;
|
|
end;
|
|
reset(uf); close(uf);
|
|
close(ulff);
|
|
end;
|
|
end;
|
|
|
|
procedure setdirs;
|
|
var s:astr;
|
|
i:integer;
|
|
done:boolean;
|
|
begin
|
|
nl;
|
|
if (novice in thisuser.ac) then begin fbaselist; nl; end;
|
|
done:=FALSE;
|
|
repeat
|
|
prt('Set NewScan file bases (Q=Quit,?=List,#=Toggle base) : '); input(s,3);
|
|
if (s='Q') then done:=TRUE;
|
|
if (s='?') then begin fbaselist; nl; end;
|
|
i:=ccuboards[0][value(s)];
|
|
if (fbaseac(i)) then { loads memuboard }
|
|
if (i>=0) and (i<=maxulb) and
|
|
(length(s)>0) and (s[1] in ['0'..'9']) then begin
|
|
nl;
|
|
sprompt(#3#5+memuboard.name+#3#3);
|
|
if (i in zscanr.fzscan) then begin
|
|
sprint(' will NOT be scanned.');
|
|
zscanr.fzscan:=zscanr.fzscan-[i];
|
|
end else begin
|
|
sprint(' WILL be scanned.');
|
|
zscanr.fzscan:=zscanr.fzscan+[i];
|
|
end;
|
|
nl;
|
|
end;
|
|
until (done) or (hangup);
|
|
lastcommandovr:=TRUE;
|
|
savezscanr;
|
|
end;
|
|
|
|
procedure pointdate;
|
|
var s:astr;
|
|
begin
|
|
nl;
|
|
print('Enter limiting date for new files -');
|
|
print('Date is currently set to '+newdate);
|
|
nl;
|
|
prt('(mm/dd/yy): '); input(s,8);
|
|
if (daynum(s)=0) then print('Illegal date.') else newdate:=s;
|
|
nl;
|
|
print('Current limiting date is '+newdate);
|
|
end;
|
|
|
|
procedure yourfileinfo;
|
|
begin
|
|
nl;
|
|
with thisuser do begin
|
|
sprint(#3#4+'Name.........: '+#3#5+nam);
|
|
sprint(#3#4+'SL...........: '+#3#5+cstr(thisuser.sl));
|
|
sprint(#3#4+'DSL..........: '+#3#5+cstr(thisuser.dsl));
|
|
sprint(#3#4+'File points..: '+#3#5+cstr(thisuser.filepoints));
|
|
sprompt(#3#4+'You DLed.....: '+#3#5+cstrl(thisuser.dk)+'k in '+cstr(thisuser.downloads)+' file');
|
|
if (thisuser.downloads<>1) then sprint('s') else nl;
|
|
sprompt(#3#4+'You ULed.....: '+#3#5+cstrl(thisuser.uk)+'k in '+cstr(thisuser.uploads)+' file');
|
|
if (thisuser.uploads<>1) then sprint('s') else nl;
|
|
sprint(#3#4+'File point status:');
|
|
if (fnofilepts in thisuser.ac) then
|
|
sprint(#3#3+' Special flag - No file point check!')
|
|
else
|
|
if (aacs(systat.nofilepts)) then
|
|
sprint(#3#3+' High security level - No file point check!')
|
|
else
|
|
sprint(#3#5+' Active according to setting on each file.');
|
|
if (not systat.fileptratio) then
|
|
sprint(#3#3+' Auto file point compensation inactive.')
|
|
else begin
|
|
sprint(#3#5+' File point compensation of '+cstr(systat.fileptcomp)+' to 1.');
|
|
sprint(#3#5+' Base compensation size of '+cstr(systat.fileptcompbasesize)+'k.');
|
|
end;
|
|
sprint(#3#4+'UL/DL ratio settings:');
|
|
if (not systat.uldlratio) then
|
|
sprint(#3#3+' Inactive.')
|
|
else
|
|
if (fnodlratio in thisuser.ac) then
|
|
sprint(#3#3+' Special flag - No ratio check!')
|
|
else
|
|
if (aacs(systat.nodlratio)) then
|
|
sprint(#3#3+' High security level - No ratio check!')
|
|
else begin
|
|
sprint(#3#5+' 1 upload for every '+cstr(systat.dlratio[thisuser.sl])+' downloads');
|
|
sprint(#3#5+' 1k upload for every '+cstr(systat.dlkratio[thisuser.sl])+' downloaded');
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure listopts;
|
|
var c:char;
|
|
begin
|
|
nl;
|
|
prt('List version: (1-3) ['+cstr(thisuser.flistopt)+'] : '); onek(c,'Q123 '^M);
|
|
if (c in ['1'..'3']) then thisuser.flistopt:=ord(c)-48;
|
|
if (thisuser.flistopt in [1,3]) then begin
|
|
dyny:=flistverb;
|
|
flistverb:=pynq('List verbose descriptions? ['+syn(flistverb)+'] : ');
|
|
end;
|
|
lastcommandovr:=TRUE;
|
|
end;
|
|
|
|
end.
|