1038 lines
30 KiB
ObjectPascal
1038 lines
30 KiB
ObjectPascal
{$A+,B+,E+,F+,I+,L+,N-,O+,R-,S+,V-}
|
||
unit file1;
|
||
|
||
interface
|
||
|
||
uses
|
||
crt, dos,
|
||
|
||
{rcg11172000 no overlay under Linux.}
|
||
{overlay,}
|
||
|
||
myio, common;
|
||
|
||
procedure dodl(fpneed:integer);
|
||
procedure doul(pts:integer);
|
||
procedure showuserfileinfo;
|
||
function okdl(f:ulfrec):boolean;
|
||
procedure dlx(f1:ulfrec; rn:integer; var abort:boolean);
|
||
procedure dl(fn:astr);
|
||
procedure dodescrs(var f:ulfrec; var v:verbrec; var pl:integer; var tosysop:boolean);
|
||
procedure writefv(rn:integer; f:ulfrec; v:verbrec);
|
||
procedure newff(f:ulfrec; v:verbrec);
|
||
procedure doffstuff(var f:ulfrec; fn:astr; var gotpts:integer);
|
||
procedure arcstuff(var ok,convt:boolean; var blks:integer; var convtime:real;
|
||
itest:boolean; fpath:astr; var fn,descr:astr);
|
||
procedure idl;
|
||
procedure iul;
|
||
|
||
procedure fbaselist;
|
||
procedure unlisted_download(s:astr);
|
||
procedure do_unlisted_download;
|
||
function nfvpointer:longint;
|
||
|
||
implementation
|
||
|
||
uses
|
||
file0, file4, file8, file14,
|
||
mail2,
|
||
archive1;
|
||
|
||
var
|
||
locbatup:boolean;
|
||
|
||
procedure dodl(fpneed:integer);
|
||
begin
|
||
nl;
|
||
nl;
|
||
if (not aacs(systat.nofilepts)) or
|
||
(not (fnofilepts in thisuser.ac)) then begin
|
||
if (fpneed>0) then dec(thisuser.filepoints,fpneed);
|
||
if (thisuser.filepoints<0) then thisuser.filepoints:=0;
|
||
sprint(#3#5+'Enjoy the file, '+thisuser.name+'!');
|
||
if (fpneed<>0) then
|
||
sprint(#3#5+'Your file points have been deducted to '+cstr(thisuser.filepoints)+'.');
|
||
end;
|
||
end;
|
||
|
||
procedure doul(pts:integer);
|
||
begin
|
||
if (not aacs(systat.ulvalreq)) then begin
|
||
sprint(#3#5+'Thanks for the upload, '+thisuser.name+'!');
|
||
if (systat.uldlratio) then
|
||
sprint(#3#5+'You will receive file credit as soon as the SysOp validates the file!')
|
||
else
|
||
sprint(#3#5+'You will receive file points as soon as the SysOp validates the file!');
|
||
end else
|
||
if ((not systat.uldlratio) and (not systat.fileptratio) and (pts=0)) then begin
|
||
sprint(#3#5+'Thanks for the upload, '+thisuser.name+'!');
|
||
sprint(#3#5+'You will receive file points as soon as the Sysop validates the file!');
|
||
end else
|
||
inc(thisuser.filepoints,pts);
|
||
end;
|
||
|
||
procedure showuserfileinfo;
|
||
begin
|
||
with thisuser do
|
||
commandline('U/L: '+cstr(uploads)+'/'+cstr(trunc(uk))+
|
||
'k <20> D/L: '+cstr(downloads)+'/'+cstr(trunc(dk))+'k');
|
||
end;
|
||
|
||
function okdl(f:ulfrec):boolean;
|
||
var s:astr;
|
||
b:boolean;
|
||
|
||
procedure nope(s:astr);
|
||
begin
|
||
if (b) then sprint(s);
|
||
b:=FALSE;
|
||
end;
|
||
|
||
begin
|
||
b:=TRUE;
|
||
if (isrequest in f.filestat) then begin
|
||
printf('reqfile');
|
||
if (nofile) then begin
|
||
nl;
|
||
sprint(#3#5+'You must Request this file -- Ask '+
|
||
systat.sysopname+' for it.');
|
||
nl;
|
||
end;
|
||
dyny:=TRUE;
|
||
if (pynq('Request this file now? [Y] : ')) then begin
|
||
s:=sqoutsp(f.filename);
|
||
irt:='File Request of "'+s+'" from file base #'+cstr(ccuboards[1][fileboard]);
|
||
imail(1);
|
||
end;
|
||
b:=FALSE;
|
||
end;
|
||
if ((resumelater in f.filestat) and (not fso)) then
|
||
nope('You can''t do anything with RESUME-LATER files.');
|
||
if ((notval in f.filestat) and (not aacs(systat.dlunval))) then
|
||
nope('You can''t do anything with UNVALIDATED files.');
|
||
if (thisuser.filepoints<f.filepoints) and (f.filepoints>0) and
|
||
(not aacs(systat.nofilepts)) and
|
||
(not (fnofilepts in thisuser.ac)) and
|
||
(not (fbnoratio in memuboard.fbstat)) then
|
||
nope(fstring.nofilepts);
|
||
if (nsl<rte*f.blocks) then
|
||
nope('Not enough time to download.');
|
||
if (not exist(memuboard.dlpath+f.filename)) then begin
|
||
nope('File isn''t really there!');
|
||
sysoplog('File missing in file list: '+sqoutsp(memuboard.dlpath+f.filename));
|
||
end;
|
||
okdl:=b;
|
||
end;
|
||
|
||
procedure dlx(f1:ulfrec; rn:integer; var abort:boolean);
|
||
var u:userrec;
|
||
tooktime,xferstart,xferend:datetimerec;
|
||
i,ii,tt,bar,s:astr;
|
||
rl,tooktime1:real;
|
||
cps,lng:longint;
|
||
inte,pl,z:integer;
|
||
c:char;
|
||
next,ps,ok,tl:boolean;
|
||
begin
|
||
abort:=FALSE; next:=FALSE;
|
||
nl;
|
||
fileinfo(f1,FALSE,abort,next);
|
||
|
||
ps:=TRUE;
|
||
abort:=FALSE;
|
||
if (not okdl(f1)) then ps:=TRUE
|
||
else begin
|
||
ps:=FALSE;
|
||
showuserfileinfo;
|
||
|
||
getdatetime(xferstart);
|
||
send1(memuboard.dlpath+f1.filename,ok,abort);
|
||
getdatetime(xferend);
|
||
timediff(tooktime,xferstart,xferend);
|
||
|
||
if (not (-lastprot in [10,11,12])) then
|
||
if (not abort) then
|
||
if (not ok) then begin
|
||
star('Download unsuccessful.');
|
||
sysoplog(#3#3+'Tried download "'+sqoutsp(f1.filename)+
|
||
'" from '+memuboard.name);
|
||
ps:=TRUE;
|
||
end else begin
|
||
if (not (fbnoratio in memuboard.fbstat)) then begin
|
||
inc(thisuser.downloads);
|
||
thisuser.dk:=thisuser.dk+(f1.blocks div 8);
|
||
end;
|
||
inc(systat.todayzlog.downloads);
|
||
inc(systat.todayzlog.dk,(f1.blocks div 8));
|
||
|
||
if (not incom) then nl;
|
||
|
||
lng:=f1.blocks; lng:=lng*128;
|
||
star('1 file successfully sent - Took: '+longtim(tooktime));
|
||
s:= 'Total: '+cstrl(lng)+' bytes';
|
||
if (fbnoratio in memuboard.fbstat) then s:=s+#3#5+' <No-Ratio>';
|
||
star(s);
|
||
|
||
s:=#3#3+'Download "'+sqoutsp(f1.filename)+'" from '+memuboard.name;
|
||
|
||
tooktime1:=dt2r(tooktime);
|
||
if (tooktime1>=1.0) then begin
|
||
cps:=f1.blocks; cps:=cps*128;
|
||
cps:=trunc(cps/tooktime1);
|
||
end else
|
||
cps:=0;
|
||
|
||
s:=s+#3#3+' ('+cstr(f1.blocks div 8)+'k, '+ctim(dt2r(tooktime))+
|
||
', '+cstr(cps)+' cps)';
|
||
sysoplog(s);
|
||
if (not (fbnoratio in memuboard.fbstat)) and
|
||
(f1.filepoints>0) then dodl(f1.filepoints);
|
||
showuserfileinfo;
|
||
|
||
if (rn<>-1) then begin
|
||
inc(f1.nacc);
|
||
seek(ulff,rn); write(ulff,f1);
|
||
end;
|
||
end;
|
||
end;
|
||
if (ps) then begin
|
||
nl;
|
||
sprompt(#3#5+'Continue with <CR> or [Q]uit :'+#3#3);
|
||
onek(c,'Q '^M);
|
||
abort:=(c='Q');
|
||
end;
|
||
end;
|
||
|
||
procedure dl(fn:astr);
|
||
var pl,rn:integer;
|
||
f:ulfrec;
|
||
abort:boolean;
|
||
begin
|
||
abort:=FALSE;
|
||
recno(fn,pl,rn);
|
||
if (baddlpath) then exit;
|
||
if (rn=0) then print('File not found.')
|
||
else
|
||
while (rn<>0) and (not abort) and (not hangup) do begin
|
||
reset(ulff);
|
||
seek(ulff,rn); read(ulff,f);
|
||
nl;
|
||
dlx(f,rn,abort);
|
||
nrecno(fn,pl,rn);
|
||
end;
|
||
reset(uf); close(uf);
|
||
close(ulff);
|
||
end;
|
||
|
||
procedure idl;
|
||
var s:astr; down:boolean;
|
||
begin
|
||
down:=TRUE;
|
||
if (not intime(timer,systat.dllowtime,systat.dlhitime)) then down:=FALSE;
|
||
if (spd='300') then
|
||
if (not intime(timer,systat.b300dllowtime,systat.b300dlhitime)) then
|
||
down:=FALSE;
|
||
if (not down) then printf('dlhours')
|
||
else begin
|
||
nl;
|
||
sprint(fstring.downloadline);
|
||
nl;
|
||
prt('Filename: '); mpl(12); input(s,12);
|
||
if (s<>'') then dl(s);
|
||
end;
|
||
end;
|
||
|
||
procedure dodescrs(var f:ulfrec; {* file record *}
|
||
var v:verbrec; {* verbose description record *}
|
||
var pl:integer; {* # files in dir *}
|
||
var tosysop:boolean); {* whether to-SysOp *}
|
||
var i,maxlen:integer;
|
||
isgif:boolean;
|
||
begin
|
||
if ((tosysop) and (systat.tosysopdir<>255) and
|
||
(systat.tosysopdir>=0) and (systat.tosysopdir<=maxulb)) then begin
|
||
nl;
|
||
print('Enter a single "\" in front of the description if it');
|
||
print('is for the SysOp ONLY.');
|
||
end else
|
||
tosysop:=FALSE;
|
||
nl;
|
||
|
||
loaduboard(fileboard);
|
||
isgif:=isgifext(f.filename);
|
||
maxlen:=54;
|
||
if ((fbusegifspecs in memuboard.fbstat) and (isgif)) then dec(maxlen,14);
|
||
|
||
print('Please enter a one line description ('+cstr(maxlen)+' chrs max)');
|
||
repeat
|
||
prt(':');
|
||
mpl(maxlen); inputl(f.description,maxlen);
|
||
if (((f.description[1]='\') or (rvalidate in thisuser.ac))
|
||
and (tosysop)) then begin
|
||
fileboard:=systat.tosysopdir;
|
||
close(ulff);
|
||
fiscan(pl);
|
||
tosysop:=TRUE;
|
||
end else
|
||
tosysop:=FALSE;
|
||
if (f.description[1]='\') then f.description:=copy(f.description,2,80);
|
||
nl;
|
||
until ((f.description<>'') or (fso) or (hangup));
|
||
v.descr[1]:='';
|
||
dyny:=FALSE;
|
||
if (pynq('Leave a verbose description? ')) then begin
|
||
nl;
|
||
print('You may use up to four lines of 50 characters each.');
|
||
print('Enter a blank line to end.');
|
||
nl;
|
||
i:=1;
|
||
repeat
|
||
prt(cstr(i)+':');
|
||
mpl(50);
|
||
inputl(v.descr[i],50);
|
||
if (v.descr[i]='') then i:=4;
|
||
inc(i);
|
||
until ((i=5) or (hangup));
|
||
if (v.descr[1]<>'') then f.vpointer:=nfvpointer
|
||
else begin
|
||
nl; sprint(#3#7+'No verbose description saved.');
|
||
end;
|
||
end;
|
||
if (v.descr[1]='') then f.vpointer:=-1;
|
||
end;
|
||
|
||
procedure writefv(rn:integer; f:ulfrec; v:verbrec);
|
||
var vfo:boolean;
|
||
begin
|
||
seek(ulff,rn);
|
||
write(ulff,f);
|
||
|
||
if (v.descr[1]<>#1#1#0#1#1) and (f.vpointer<>-1) then begin
|
||
vfo:=(filerec(verbf).mode<>fmclosed);
|
||
if (not vfo) then reset(verbf);
|
||
seek(verbf,f.vpointer); write(verbf,v);
|
||
if (not vfo) then close(verbf);
|
||
end;
|
||
end;
|
||
|
||
procedure newff(f:ulfrec; v:verbrec); {* ulff needs to be open before calling *}
|
||
var i,pl:integer;
|
||
fo:boolean;
|
||
f1:ulfrec;
|
||
begin
|
||
seek(ulff,0); read(ulff,f1); pl:=f1.blocks;
|
||
|
||
for i:=pl downto 1 do begin
|
||
seek(ulff,i); read(ulff,f1);
|
||
seek(ulff,i+1); write(ulff,f1);
|
||
end;
|
||
writefv(1,f,v);
|
||
|
||
inc(pl); f1.blocks:=pl;
|
||
seek(ulff,0); write(ulff,f1);
|
||
end;
|
||
|
||
procedure doffstuff(var f:ulfrec; fn:astr; var gotpts:integer);
|
||
var rfpts:real;
|
||
begin
|
||
f.filename:=align(fn);
|
||
f.owner:=usernum;
|
||
f.stowner:=allcaps(thisuser.name);
|
||
f.date:=date;
|
||
f.daten:=daynum(date);
|
||
f.nacc:=0;
|
||
|
||
if (not systat.fileptratio) then begin
|
||
f.filepoints:=0;
|
||
gotpts:=0;
|
||
end else begin
|
||
rfpts:=(f.blocks/8)/systat.fileptcompbasesize;
|
||
f.filepoints:=round(rfpts);
|
||
gotpts:=round(rfpts*systat.fileptcomp);
|
||
if (gotpts<1) then gotpts:=1;
|
||
end;
|
||
|
||
f.filestat:=[];
|
||
if (not fso) and (not systat.validateallfiles) then
|
||
f.filestat:=f.filestat+[notval];
|
||
f.ft:=255; {* ft; *}
|
||
end;
|
||
|
||
procedure arcstuff(var ok,convt:boolean; { if ok - if converted }
|
||
var blks:integer; { # blocks }
|
||
var convtime:real; { convert time }
|
||
itest:boolean; { whether to test integrity }
|
||
fpath:astr; { filepath }
|
||
var fn:astr; { filename }
|
||
var descr:astr); { description }
|
||
var fi:file of byte;
|
||
convtook,convstart,convend:datetimerec;
|
||
oldnam,newnam,s,sig:astr;
|
||
sttime:real;
|
||
x,y,c:word;
|
||
oldarc,newarc:integer;
|
||
begin
|
||
{* oldarc: current archive format, 0 if none
|
||
* newarc: desired archive format, 0 if none
|
||
* oldnam: current filename
|
||
* newnam: desired archive format filename
|
||
*}
|
||
|
||
convtime:=0.0;
|
||
ok:=TRUE;
|
||
|
||
assign(fi,fpath+fn);
|
||
{$I-} reset(fi); {$I+}
|
||
if (ioresult<>0) then blks:=0
|
||
else begin
|
||
blks:=trunc((filesize(fi)+127.0)/128.0);
|
||
close(fi);
|
||
end;
|
||
|
||
newarc:=memuboard.arctype;
|
||
oldarc:=1;
|
||
oldnam:=sqoutsp(fpath+fn);
|
||
while (systat.filearcinfo[oldarc].ext<>'') and
|
||
(systat.filearcinfo[oldarc].ext<>copy(fn,length(fn)-2,3)) and
|
||
(oldarc<maxarcs+1) do
|
||
inc(oldarc);
|
||
if (oldarc=maxarcs+1) or
|
||
(systat.filearcinfo[oldarc].ext='') then oldarc:=0;
|
||
if (not systat.filearcinfo[oldarc].active) then oldarc:=0;
|
||
if (not systat.filearcinfo[newarc].active) then newarc:=0;
|
||
if (newarc=0) then newarc:=oldarc;
|
||
|
||
{* if both archive formats supported ... *}
|
||
if ((oldarc<>0) and (newarc<>0)) then begin
|
||
{* archive extension supported *}
|
||
newnam:=fn;
|
||
if (pos('.',newnam)<>0) then newnam:=copy(newnam,1,pos('.',newnam)-1);
|
||
newnam:=sqoutsp(fpath+newnam+'.'+systat.filearcinfo[newarc].ext);
|
||
{* if integrity tests supported ... *}
|
||
if ((itest) and (systat.filearcinfo[oldarc].testline<>'')) then begin
|
||
star('Testing file integrity ...');
|
||
arcintegritytest(ok,oldarc,oldnam);
|
||
if (not ok) then begin
|
||
sysoplog(#3#8'>>>>'#3#5+' "'+oldnam+'" on #'+cstr(fileboard)+
|
||
': Errors in integrity test');
|
||
star('Errors in integrity test! File not passed.');
|
||
end else
|
||
star('No errors in testing, file passed.');
|
||
end;
|
||
|
||
{* if conversion required ... *}
|
||
if ((ok) and (oldarc<>newarc) and (newarc<>0)) then begin
|
||
convt:=incom; {* don't convert if local and non-file-SysOp *}
|
||
s:=systat.filearcinfo[newarc].ext;
|
||
if (fso) then begin
|
||
dyny:=TRUE;
|
||
convt:=pynq('Convert archive to .'+s+' format? [Yes] : ');
|
||
end;
|
||
if (convt) then begin
|
||
nl;
|
||
|
||
getdatetime(convstart);
|
||
conva(ok,oldarc,newarc,'tgtemp5.$$$',oldnam,newnam);
|
||
getdatetime(convend);
|
||
timediff(convtook,convstart,convend);
|
||
convtime:=dt2r(convtook);
|
||
|
||
if (ok) then begin
|
||
assign(fi,fpath+fn);
|
||
rewrite(fi); close(fi); erase(fi);
|
||
assign(fi,newnam);
|
||
{$I-} reset(fi); {$I+}
|
||
if (ioresult<>0) then ok:=FALSE
|
||
else begin
|
||
blks:=trunc((filesize(fi)+127.0)/128.0);
|
||
close(fi);
|
||
if (blks=0) then ok:=FALSE;
|
||
end;
|
||
fn:=align(stripname(newnam));
|
||
star('No errors in conversion, file passed.');
|
||
end else begin
|
||
assign(fi,newnam);
|
||
rewrite(fi); close(fi); erase(fi);
|
||
sysoplog(#3#8+'>>>>'#3#5+' "'+oldnam+'" on #'+
|
||
cstr(fileboard)+': Conversion unsuccessful');
|
||
star('Errors in conversion! Original format retained.');
|
||
newarc:=oldarc;
|
||
end;
|
||
ok:=TRUE;
|
||
end else
|
||
newarc:=oldarc;
|
||
end;
|
||
|
||
{* if comment fields supported/desired ... *}
|
||
if (ok) and (systat.filearcinfo[newarc].cmtline<>'') then begin
|
||
s:=sqoutsp(fpath+fn);
|
||
arccomment(ok,newarc,memuboard.cmttype,s);
|
||
ok:=TRUE;
|
||
end;
|
||
end;
|
||
fn:=sqoutsp(fn);
|
||
|
||
if ((isgifext(fn)) and (fbusegifspecs in memuboard.fbstat)) then begin
|
||
getgifspecs(memuboard.dlpath+fn,sig,x,y,c);
|
||
s:='('+cstrl(x)+'x'+cstrl(y)+','+cstr(c)+'c) ';
|
||
descr:=s+descr;
|
||
if (length(descr)>60) then descr:=copy(descr,1,60);
|
||
end;
|
||
end;
|
||
|
||
function searchfordups(completefn:astr):boolean;
|
||
var wildfn,nearfn,s:astr;
|
||
i:integer;
|
||
fcompleteacc,fcompletenoacc,fnearacc,fnearnoacc,
|
||
hadacc,b1,b2:boolean;
|
||
|
||
procedure searchb(b:integer; fn:astr; var hadacc,fcl,fnr:boolean);
|
||
var f:ulfrec;
|
||
oldboard,pl,rn:integer;
|
||
begin
|
||
oldboard:=fileboard;
|
||
hadacc:=fbaseac(b); { loads in memuboard }
|
||
fileboard:=b;
|
||
|
||
recno(fn,pl,rn);
|
||
if (badfpath) then exit;
|
||
while (rn<=pl) and (rn<>0) do begin
|
||
seek(ulff,rn); read(ulff,f);
|
||
if (align(f.filename)=align(completefn)) then fcl:=TRUE
|
||
else begin
|
||
nearfn:=align(f.filename);
|
||
fnr:=TRUE;
|
||
end;
|
||
nrecno(fn,pl,rn);
|
||
end;
|
||
close(ulff);
|
||
fileboard:=oldboard;
|
||
fiscan(pl);
|
||
end;
|
||
|
||
begin
|
||
nl;
|
||
sprompt(#3#5+'Searching for duplicate files ... ');
|
||
|
||
searchfordups:=TRUE;
|
||
|
||
wildfn:=copy(align(completefn),1,9)+'???';
|
||
fcompleteacc:=FALSE; fcompletenoacc:=FALSE;
|
||
fnearacc:=FALSE; fnearnoacc:=FALSE;
|
||
b1:=FALSE; b2:=FALSE;
|
||
|
||
i:=0;
|
||
while (i<=maxulb) do begin
|
||
searchb(i,wildfn,hadacc,b1,b2); { fbaseac loads in memuboard ... }
|
||
loaduboard(i);
|
||
if (b1) then begin
|
||
s:='User tried upload "'+sqoutsp(completefn)+'" to #'+cstr(fileboard)+
|
||
'; existed in #'+cstr(i);
|
||
if (not hadacc) then s:=s+' - no access to';
|
||
sysoplog(s);
|
||
nl; nl;
|
||
if (hadacc) then
|
||
sprint(#3#5+'File "'+sqoutsp(completefn)+'" already exists in "'+
|
||
memuboard.name+#3#5+' #'+cstr(i)+'".')
|
||
else
|
||
sprint(#3#5+'File "'+sqoutsp(completefn)+
|
||
'" cannot be accepted by the system at this time.');
|
||
sprint(#3#7+'Illegal filename.');
|
||
exit;
|
||
end;
|
||
if (b2) then begin
|
||
s:='User entered upload filename "'+sqoutsp(completefn)+'" in #'+
|
||
cstr(fileboard)+'; was warned that "'+sqoutsp(nearfn)+
|
||
'" existed in #'+cstr(i)+'.';
|
||
if (not hadacc) then s:=s+' - no access to';
|
||
sysoplog(s);
|
||
nl; nl;
|
||
if (hadacc) then
|
||
sprint(#3#5+'Warning: file "'+sqoutsp(nearfn)+'" exists in "'+
|
||
memuboard.name+#3#5+' #'+cstr(i)+'".')
|
||
else
|
||
sprint(#3#5+'Warning: file "'+sqoutsp(nearfn)+
|
||
'" exists in a private SysOp directory.');
|
||
searchfordups:=not pynq('Upload anyway? [No] : ');
|
||
exit;
|
||
end;
|
||
inc(i);
|
||
end;
|
||
|
||
sprint('none found.'); nl;
|
||
searchfordups:=FALSE;
|
||
end;
|
||
|
||
procedure ul(var abort:boolean; fn:astr; var addbatch:boolean);
|
||
var baf:text;
|
||
fi:file of byte;
|
||
f,f1:ulfrec;
|
||
wind:windowrec;
|
||
v:verbrec;
|
||
s:astr;
|
||
xferstart,xferend,tooktime,ulrefundgot1,convtime1:datetimerec;
|
||
ulrefundgot,convtime,rfpts,tooktime1:real;
|
||
cps,lng,origblocks:longint;
|
||
x,rn,pl,cc,oldboard,np,sx,sy,gotpts:integer;
|
||
c:char;
|
||
uls,ok,kabort,convt,aexists,resumefile,wenttosysop,offline:boolean;
|
||
begin
|
||
oldboard:=fileboard;
|
||
fiscan(pl);
|
||
if (badulpath) then exit;
|
||
|
||
uls:=incom; ok:=TRUE; fn:=align(fn); rn:=0;
|
||
if (fn[1]=' ') or (fn[10]=' ') then ok:=FALSE;
|
||
for x:=1 to length(fn) do
|
||
ok:=(pos(fn[x],'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ. -@#$%^&()_')<>0);
|
||
np:=0;
|
||
for x:=1 to length(fn) do if (fn[x]='.') then inc(np);
|
||
if (np<>1) then ok:=FALSE;
|
||
if (not ok) then begin
|
||
print('Illegal filename.');
|
||
exit;
|
||
end;
|
||
|
||
{* aexists: if file already EXISTS in dir
|
||
rn: rec-num of file if already EXISTS in file listing
|
||
resumefile: if user is going to RESUME THE UPLOAD
|
||
uls: whether file is to be actually UPLOADED
|
||
offline: if uploaded a file to be offline automatically..
|
||
*}
|
||
|
||
resumefile:=FALSE; uls:=TRUE; offline:=FALSE; abort:=FALSE;
|
||
aexists:=exist(memuboard.ulpath+fn);
|
||
|
||
recno(fn,pl,rn);
|
||
if (badulpath) then exit;
|
||
nl;
|
||
if (rn<>0) then begin
|
||
seek(ulff,rn); read(ulff,f);
|
||
resumefile:=(resumelater in f.filestat);
|
||
if (resumefile) then begin
|
||
print('This is a resume-later file.');
|
||
resumefile:=((f.owner=usernum) or (fso));
|
||
if (resumefile) then begin
|
||
if (not incom) then begin
|
||
print('Cannot be resumed locally.');
|
||
exit;
|
||
end;
|
||
dyny:=TRUE;
|
||
resumefile:=pynq('Resume upload of "'+sqoutsp(fn)+'" ? ');
|
||
if (not resumefile) then exit;
|
||
end else begin
|
||
print(#3#7+'You are not the uploader of this file.');
|
||
exit;
|
||
end;
|
||
end;
|
||
end;
|
||
if ((not aexists) and (not incom)) then begin
|
||
uls:=FALSE;
|
||
offline:=TRUE;
|
||
print('This file does not exist in the files directory.');
|
||
if not pynq('Do you want to create an Offline file entry? ') then exit;
|
||
end;
|
||
if (not resumefile) then begin
|
||
if (((aexists) or (rn<>0)) and (not fso)) then begin
|
||
print('File already exists.');
|
||
exit;
|
||
end;
|
||
if (pl>=memuboard.maxfiles) then begin
|
||
star('This directory is full.');
|
||
exit;
|
||
end;
|
||
if (not aexists) and (not offline) and
|
||
(freek(exdrv(memuboard.ulpath))<=systat.minspaceforupload)
|
||
then begin
|
||
nl; star('Insufficient disk space.');
|
||
c:=chr(exdrv(memuboard.ulpath)+64);
|
||
if c='@' then
|
||
sysoplog(#3#8+'>>>>'+#3#3+' Main BBS drive full! Insufficient space to upload a file!')
|
||
else sysoplog(#3#8+'>>>>'+#3#3+' '+c+': drive full! Insufficient space to upload a file!');
|
||
exit;
|
||
end;
|
||
if (aexists) then begin
|
||
uls:=FALSE;
|
||
print('Am using "'+sqoutsp(memuboard.ulpath+fn)+'"');
|
||
if (rn<>0) then sprint(#3#5+'NOTE: File already exists in listing!');
|
||
dyny:=(rn=0);
|
||
if (locbatup) then begin
|
||
sprompt(#3#7+'[Q]uit or Upload this? (Y/N) ['+
|
||
syn(dyny)+'] : '+#3#3);
|
||
onekcr:=FALSE; onekda:=FALSE;
|
||
onek(c,'QYN'^M);
|
||
if (rn<>0) then ok:=(c='Y') else ok:=(c in ['Y',^M]);
|
||
abort:=(c='Q');
|
||
if (abort) then print('Quit') else
|
||
if (not ok) then print('No') else print('Yes');
|
||
end else
|
||
ok:=pynq('Upload this? (Y/N) ['+syn(dyny)+'] : ');
|
||
rn:=0;
|
||
end;
|
||
|
||
if ((systat.searchdup) and (ok) and (not abort) and (incom)) then
|
||
if (searchfordups(fn)) then exit;
|
||
|
||
if (uls) then begin
|
||
dyny:=TRUE;
|
||
ok:=pynq('Upload "'+sqoutsp(fn)+'" ? ');
|
||
end;
|
||
if ((ok) and (uls) and (not resumefile)) then begin
|
||
assign(fi,memuboard.ulpath+fn);
|
||
{$I-} rewrite(fi); {$I+}
|
||
if ioresult<>0 then begin
|
||
{$I-} close(fi); {$I+}
|
||
cc:=ioresult;
|
||
ok:=FALSE;
|
||
end else begin
|
||
close(fi);
|
||
erase(fi);
|
||
end;
|
||
if (not ok) then begin
|
||
print('Unable to upload that filename.');
|
||
exit;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
if (not ok) then exit;
|
||
wenttosysop:=TRUE;
|
||
if (not resumefile) then begin
|
||
f.filename:=align(fn);
|
||
dodescrs(f,v,pl,wenttosysop);
|
||
end;
|
||
ok:=TRUE;
|
||
if (uls) then begin
|
||
showuserfileinfo;
|
||
|
||
getdatetime(xferstart);
|
||
receive1(memuboard.ulpath+fn,resumefile,ok,kabort,addbatch);
|
||
|
||
if (addbatch) then begin
|
||
inc(numubatchfiles);
|
||
ubatch[numubatchfiles].fn:=sqoutsp(fn);
|
||
with ubatch[numubatchfiles] do begin
|
||
section:=fileboard;
|
||
description:=f.description;
|
||
if (v.descr[1]<>'') then begin
|
||
inc(hiubatchv);
|
||
new(ubatchv[hiubatchv]); {* define dynamic memory *}
|
||
ubatchv[hiubatchv]^:=v;
|
||
vr:=hiubatchv;
|
||
end else
|
||
vr:=0;
|
||
end;
|
||
nl;
|
||
if (numubatchfiles<>1) then s:='s' else s:='';
|
||
s:=cstr(numubatchfiles)+' file'+s+' now in upload batch queue.';
|
||
star(s);
|
||
star('Hit <CR> alone to stop adding to queue.');
|
||
nl;
|
||
fileboard:=oldboard;
|
||
exit;
|
||
end else begin
|
||
getdatetime(xferend);
|
||
timediff(tooktime,xferstart,xferend);
|
||
end;
|
||
|
||
if (kabort) then begin
|
||
fileboard:=oldboard;
|
||
exit;
|
||
end;
|
||
|
||
ulrefundgot:=(dt2r(tooktime))*(systat.ulrefund/100.0);
|
||
freetime:=freetime+ulrefundgot;
|
||
star('Gave time refund of '+ctim(ulrefundgot));
|
||
|
||
showuserfileinfo;
|
||
|
||
if (not kabort) then star('Transfer complete.');
|
||
nl;
|
||
end;
|
||
nl;
|
||
|
||
convt:=FALSE;
|
||
if (not offline) then begin
|
||
assign(fi,memuboard.ulpath+fn);
|
||
{$I-} reset(fi); {$I+}
|
||
if (ioresult<>0) then ok:=FALSE
|
||
else begin
|
||
f.blocks:=trunc((filesize(fi)+127.0)/128.0);
|
||
close(fi);
|
||
if (f.blocks=0) then ok:=FALSE;
|
||
origblocks:=f.blocks;
|
||
end;
|
||
end;
|
||
|
||
if ((ok) and (not offline)) then begin
|
||
arcstuff(ok,convt,f.blocks,convtime,uls,memuboard.ulpath,fn,f.description);
|
||
doffstuff(f,fn,gotpts);
|
||
|
||
if (ok) then begin
|
||
if ((not resumefile) or (rn=0)) then newff(f,v) else writefv(rn,f,v);
|
||
|
||
if (uls) then begin
|
||
if (aacs(systat.ulvalreq)) then begin
|
||
inc(thisuser.uploads);
|
||
inc(thisuser.uk,f.blocks div 8);
|
||
end;
|
||
inc(systat.todayzlog.uploads);
|
||
inc(systat.todayzlog.uk,f.blocks div 8);
|
||
end;
|
||
|
||
s:=#3#3+'Upload "'+sqoutsp(fn)+'" on '+memuboard.name;
|
||
if (uls) then begin
|
||
tooktime1:=dt2r(tooktime);
|
||
if (tooktime1>=1.0) then begin
|
||
cps:=f.blocks; cps:=cps*128;
|
||
cps:=trunc(cps/tooktime1);
|
||
end else
|
||
cps:=0;
|
||
s:=s+#3#3+' ('+cstr(f.blocks div 8)+'k, '+ctim(tooktime1)+
|
||
', '+cstr(cps)+' cps)';
|
||
end;
|
||
sysoplog(s);
|
||
if ((incom) and (uls)) then begin
|
||
if (convt) then begin
|
||
lng:=origblocks*128;
|
||
star('Orig. file size: '+cstrl(lng)+' bytes.');
|
||
end;
|
||
lng:=f.blocks; lng:=lng*128;
|
||
if (convt) then
|
||
star('New file size: '+cstrl(lng)+' bytes.') else
|
||
star('File size: '+cstrl(lng)+' bytes.');
|
||
star('Upload time: '+longtim(tooktime));
|
||
r2dt(convtime,convtime1);
|
||
if (convt) then
|
||
star('Convert time: '+longtim(convtime1)+' (not refunded)');
|
||
star('Transfer rate: '+cstr(cps)+' cps');
|
||
r2dt(ulrefundgot,ulrefundgot1);
|
||
star('Time refund: '+longtim(ulrefundgot1)+'.');
|
||
if (gotpts<>0) then
|
||
star('File points: '+cstr(gotpts)+' pts.');
|
||
nl;
|
||
if (choptime<>0.0) then begin
|
||
choptime:=choptime+ulrefundgot;
|
||
freetime:=freetime-ulrefundgot;
|
||
star('Sorry, no upload time refund may be given at this time.');
|
||
star('You will get your refund after the event.');
|
||
nl;
|
||
end;
|
||
doul(gotpts);
|
||
end
|
||
else star('Entry added.');
|
||
end;
|
||
end;
|
||
if (not ok) and (not offline) then begin
|
||
if (exist(memuboard.ulpath+fn)) then begin
|
||
star('Upload not received.');
|
||
s:='file deleted';
|
||
if ((thisuser.sl>0 {systat.minresumelatersl} ) and
|
||
(f.blocks div 8>systat.minresume)) then begin
|
||
nl;
|
||
dyny:=TRUE;
|
||
if pynq('Save file for a later resume? ') then begin
|
||
doffstuff(f,fn,gotpts);
|
||
f.filestat:=f.filestat+[resumelater];
|
||
if (not aexists) or (rn=0) then newff(f,v) else writefv(rn,f,v);
|
||
s:='file saved for later resume';
|
||
end;
|
||
end;
|
||
if (not (resumelater in f.filestat)) then begin
|
||
if (exist(memuboard.ulpath+fn)) then begin
|
||
assign(fi,memuboard.ulpath+fn);
|
||
{$I-} erase(fi); {$I+}
|
||
end;
|
||
end;
|
||
sysoplog(#3#3+'Error uploading "'+sqoutsp(fn)+'" - '+s);
|
||
end;
|
||
star('Taking away time refund of '+ctim(ulrefundgot)+' minutes.');
|
||
freetime:=freetime-ulrefundgot;
|
||
end;
|
||
if (offline) then begin
|
||
f.blocks:=10;
|
||
doffstuff(f,fn,gotpts);
|
||
f.filestat:=f.filestat+[isrequest];
|
||
newff(f,v);
|
||
end;
|
||
close(ulff);
|
||
fileboard:=oldboard;
|
||
fiscan(pl); close(ulff);
|
||
end;
|
||
|
||
procedure iul;
|
||
var s:astr;
|
||
pl:integer;
|
||
c:char;
|
||
abort,done,addbatch:boolean;
|
||
begin
|
||
fiscan(pl);
|
||
if (badulpath) then exit;
|
||
if (not aacs(memuboard.ulacs)) then begin
|
||
nl; star('You cannot upload to this section.');
|
||
exit;
|
||
end;
|
||
locbatup:=FALSE;
|
||
if (incom) then printf('upload');
|
||
nl;
|
||
repeat
|
||
sprint(fstring.uploadline);
|
||
done:=TRUE; addbatch:=FALSE;
|
||
nl;
|
||
prt('Filename: '); mpl(12); input(s,12); s:=sqoutsp(s);
|
||
if (s<>'') then
|
||
if (not fso) then ul(abort,s,addbatch)
|
||
else begin
|
||
if (not iswildcard(s)) then ul(abort,s,addbatch)
|
||
else begin
|
||
locbatup:=TRUE;
|
||
ffile(memuboard.ulpath+s);
|
||
if (not found) then print('No files found.') else
|
||
repeat
|
||
if not ((dirinfo.attr and VolumeID=VolumeID) or
|
||
(dirinfo.attr and Directory=Directory)) then
|
||
ul(abort,dirinfo.name,addbatch);
|
||
nfile;
|
||
until (not found) or (abort);
|
||
end;
|
||
end;
|
||
done:=(not addbatch);
|
||
until (done) or (hangup);
|
||
end;
|
||
|
||
procedure fbaselist;
|
||
var s,os:astr;
|
||
onlin,nd,b,b2,i:integer;
|
||
abort,next,acc,showtitles:boolean;
|
||
|
||
procedure titles;
|
||
var sep:astr;
|
||
begin
|
||
sep:=#3#4+':'+#3#3;
|
||
if (showtitles) then begin
|
||
sprint(#3#3+'NNN'+sep+'Flags '+sep+'Arc'+sep+'Description');
|
||
sprint(#3#4+'===:=================:===:========================================');
|
||
showtitles:=FALSE;
|
||
end;
|
||
end;
|
||
|
||
procedure longlist;
|
||
begin
|
||
nl;
|
||
showtitles:=TRUE;
|
||
while (b<=maxulb) and (not abort) do begin
|
||
acc:=fbaseac(b); { fbaseac will load memuboard }
|
||
if ((fbunhidden in memuboard.fbstat) or (acc)) then begin
|
||
titles;
|
||
if (acc) then begin
|
||
s:=#3#5+cstr(ccuboards[1][b]);
|
||
while (length(s)<6) do s:=s+' ';
|
||
if (b in zscanr.fzscan) then s:=s+#3#9+'Scan ' else s:=s+#3#9+' ';
|
||
end else
|
||
s:=#3#9+' ';
|
||
if (fbnoratio in memuboard.fbstat) then s:=s+'No-Ratio '
|
||
else s:=s+' ';
|
||
if (fbusegifspecs in memuboard.fbstat) then s:=s+'GIF '
|
||
else s:=s+' ';
|
||
if (memuboard.arctype=0) then s:=s+#3#3+' '
|
||
else s:=s+#3#3+allcaps(systat.filearcinfo[memuboard.arctype].ext);
|
||
s:=s+' '+#3#5+memuboard.name;
|
||
sprint(s);
|
||
inc(nd);
|
||
if (not empty) then wkey(abort,next);
|
||
end;
|
||
inc(b);
|
||
end;
|
||
end;
|
||
|
||
procedure shortlist;
|
||
begin
|
||
nl;
|
||
while (b<=maxulb) and (not abort) do begin
|
||
acc:=fbaseac(b); { fbaseac will load memuboard }
|
||
if ((fbunhidden in memuboard.fbstat) or (acc)) then begin
|
||
if (acc) then begin
|
||
b2:=ccuboards[1][b];
|
||
s:=#3#5+cstr(b2); if (b2<10) then s:=' '+s;
|
||
if (b in zscanr.fzscan) then s:=s+'* ' else s:=s+' ';
|
||
end else
|
||
s:=' ';
|
||
s:=s+{#3#5+}memuboard.name;
|
||
if (fbnoratio in memuboard.fbstat) then s:=s+#3#5+' <NR>';
|
||
inc(onlin); inc(nd);
|
||
if (onlin=1) then begin
|
||
if (thisuser.linelen>=80) and (b<maxulb) and (lennmci(s)>40) then
|
||
s:=mlnmci(s,40);
|
||
sprompt(s); os:=s;
|
||
end else begin
|
||
i:=40-lennmci(os); os:='';
|
||
if (thisuser.linelen>=80) then begin
|
||
while (lennmci(os)<i) do os:=os+' ';
|
||
if (lennmci(s)>38) then s:=mlnmci(s,38);
|
||
end else
|
||
nl;
|
||
sprint(os+s);
|
||
onlin:=0;
|
||
end;
|
||
if (not empty) then wkey(abort,next);
|
||
end;
|
||
inc(b);
|
||
end;
|
||
if (onlin=1) and (thisuser.linelen>=80) then nl;
|
||
end;
|
||
|
||
begin
|
||
nl;
|
||
abort:=FALSE;
|
||
onlin:=0; s:=''; b:=0; nd:=0;
|
||
if pynq('Display detailed area listing? ') then longlist else shortlist;
|
||
if (nd=0) then sprompt(#3#7+'No file bases available.');
|
||
end;
|
||
|
||
procedure unlisted_download(s:astr);
|
||
var dok,kabort:boolean;
|
||
pl,oldnumbatchfiles,oldfileboard:integer;
|
||
begin
|
||
if (s<>'') then begin
|
||
if (not exist(s)) then print('File not found.')
|
||
else if (iswildcard(s)) then print('Can''t specify wildcards.')
|
||
else begin
|
||
oldnumbatchfiles:=numbatchfiles;
|
||
oldfileboard:=fileboard; fileboard:=-1;
|
||
send1(s,dok,kabort);
|
||
if (numbatchfiles=oldnumbatchfiles) and (dok) and (not kabort) then
|
||
dodl(5);
|
||
fileboard:=oldfileboard;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure do_unlisted_download;
|
||
var s:astr;
|
||
begin
|
||
nl;
|
||
{rcg11242000 DOSism.}
|
||
{print('Enter file name to download (d:path\filename.ext)');}
|
||
print('Enter file name to download (path/filename.ext)');
|
||
prt(':'); mpl(78); input(s,78);
|
||
unlisted_download(s);
|
||
end;
|
||
|
||
function nfvpointer:longint;
|
||
var i,x:integer;
|
||
v:verbrec;
|
||
vfo:boolean;
|
||
begin
|
||
vfo:=(filerec(verbf).mode<>fmclosed);
|
||
if (not vfo) then reset(verbf);
|
||
x:=filesize(verbf);
|
||
for i:=0 to filesize(verbf)-1 do begin
|
||
seek(verbf,i); read(verbf,v);
|
||
if (v.descr[1]='') then x:=i;
|
||
end;
|
||
if (not vfo) then close(verbf);
|
||
nfvpointer:=x;
|
||
end;
|
||
|
||
end.
|