{$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;

s:=s+' '+mrn(cstr(month),2)+'-'+ti(day)+'-'+ti(year-1900)+

' '+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.