558 lines
16 KiB
ObjectPascal
558 lines
16 KiB
ObjectPascal
{$A+,B+,E+,F+,I+,L+,N-,O+,R-,S+,V-}
|
|
unit file6;
|
|
|
|
interface
|
|
|
|
uses
|
|
crt,dos,
|
|
|
|
{rcg11172000 no overlay under Linux.}
|
|
{overlay,}
|
|
|
|
file0, file1, file2, file4, file9,
|
|
execbat,
|
|
common;
|
|
|
|
procedure delbatch(n:integer);
|
|
procedure mpkey(var s:astr);
|
|
function bproline1(cline:astr):astr;
|
|
procedure bproline(var cline:astr; filespec:astr);
|
|
function okprot(prot:protrec; ul,dl,batch,resume:boolean):boolean;
|
|
procedure showprots(ul,dl,batch,resume:boolean);
|
|
function findprot(cs:astr; ul,dl,batch,resume:boolean):integer;
|
|
procedure batchdl;
|
|
procedure listbatchfiles;
|
|
procedure removebatchfiles;
|
|
procedure clearbatch;
|
|
|
|
implementation
|
|
|
|
procedure delbatch(n:integer);
|
|
var c:integer;
|
|
begin
|
|
if ((n>=1) and (n<=numbatchfiles)) then begin
|
|
batchtime:=batchtime-batch[n].tt;
|
|
if (n<>numbatchfiles) then
|
|
for c:=n to numbatchfiles-1 do batch[c]:=batch[c+1];
|
|
dec(numbatchfiles);
|
|
end;
|
|
end;
|
|
|
|
procedure mpkey(var s:astr);
|
|
var sfqarea,smqarea:boolean;
|
|
begin
|
|
sfqarea:=fqarea; smqarea:=mqarea;
|
|
fqarea:=FALSE; mqarea:=FALSE;
|
|
|
|
mmkey(s);
|
|
|
|
fqarea:=sfqarea; mqarea:=smqarea;
|
|
end;
|
|
|
|
function bproline2(cline:astr):astr;
|
|
var s:astr;
|
|
begin
|
|
s:=substall(cline,'%C',start_dir);
|
|
s:=substall(s,'%G',copy(systat.gfilepath,1,length(systat.gfilepath)-1));
|
|
bproline2:=s;
|
|
end;
|
|
|
|
function bproline1(cline:astr):astr;
|
|
var s,s1:astr;
|
|
begin
|
|
if ((not incom) and (not outcom)) then s1:=cstrl(modemr.waitbaud) else s1:=spd;
|
|
s:=substall(cline,'%B',s1);
|
|
s:=substall(s,'%L',bproline2(protocol.dlflist));
|
|
s:=substall(s,'%P',cstr(modemr.comport));
|
|
s:=substall(s,'%T',bproline2(protocol.templog));
|
|
bproline1:=bproline2(s);
|
|
end;
|
|
|
|
procedure bproline(var cline:astr; filespec:astr);
|
|
const lastpos:integer=-1;
|
|
begin
|
|
if (pos('%F',cline)<>0) then begin
|
|
lastpos:=pos('%F',cline)+length(filespec);
|
|
cline:=substall(cline,'%F',filespec);
|
|
end else begin
|
|
insert(' '+filespec,cline,lastpos);
|
|
inc(lastpos,length(filespec)+1);
|
|
end;
|
|
end;
|
|
|
|
function okprot(prot:protrec; ul,dl,batch,resume:boolean):boolean;
|
|
var s:astr;
|
|
begin
|
|
okprot:=FALSE;
|
|
with prot do begin
|
|
if (ul) then s:=ulcmd else if (dl) then s:=dlcmd else s:='';
|
|
if (s='NEXT') and ((ul) or (batch) or (resume)) then exit;
|
|
if (s='BATCH') and ((batch) or (resume)) then exit;
|
|
if (batch<>(xbisbatch in xbstat)) then exit;
|
|
if (resume<>(xbisresume in xbstat)) then exit;
|
|
if (not (xbactive in xbstat)) then exit;
|
|
if (not aacs(acs)) then exit;
|
|
if (s='') then exit;
|
|
end;
|
|
okprot:=TRUE;
|
|
end;
|
|
|
|
procedure showprots(ul,dl,batch,resume:boolean);
|
|
var s:astr;
|
|
i:integer;
|
|
abort,next:boolean;
|
|
begin
|
|
nofile:=TRUE;
|
|
if (resume) then printf('protres')
|
|
else begin
|
|
if (batch) and (ul) then printf('protbul');
|
|
if (batch) and (dl) then printf('protbdl');
|
|
if (not batch) and (ul) then printf('protsul');
|
|
if (not batch) and (dl) then printf('protsdl');
|
|
end;
|
|
if (nofile) then begin
|
|
seek(xf,0);
|
|
abort:=FALSE; next:=FALSE; i:=0;
|
|
while ((i<=filesize(xf)-1) and (not abort)) do begin
|
|
read(xf,protocol);
|
|
if (okprot(protocol,ul,dl,batch,resume)) then sprint(protocol.descr);
|
|
if (not empty) then wkey(abort,next);
|
|
inc(i);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
(* XF should be OPEN --
|
|
returns:
|
|
(-1):Ascii (xx):Xmodem (xx):Xmodem-CRC (xx):Ymodem
|
|
(-10):Quit (-11):Next (-12):Batch (-99):Invalid (or no access)
|
|
else, the protocol #
|
|
*)
|
|
function findprot(cs:astr; ul,dl,batch,resume:boolean):integer;
|
|
var s:astr;
|
|
i:integer;
|
|
done:boolean;
|
|
begin
|
|
findprot:=-99;
|
|
if (cs='') then exit;
|
|
seek(xf,0);
|
|
done:=FALSE; i:=0;
|
|
while ((i<=filesize(xf)-1) and (not done)) do begin
|
|
read(xf,protocol);
|
|
with protocol do
|
|
if (cs=ckeys) then
|
|
if (okprot(protocol,ul,dl,batch,resume)) then begin
|
|
if (ul) then s:=ulcmd else if (dl) then s:=dlcmd else s:='';
|
|
if (s='ASCII') then begin done:=TRUE; findprot:=-1; end
|
|
else if (s='QUIT') then begin done:=TRUE; findprot:=-10; end
|
|
else if (s='NEXT') then begin done:=TRUE; findprot:=-11; end
|
|
else if (s='BATCH') then begin done:=TRUE; findprot:=-12; end
|
|
else if (s<>'') then begin done:=TRUE; findprot:=i; end;
|
|
end;
|
|
inc(i);
|
|
end;
|
|
end;
|
|
|
|
procedure batchdl;
|
|
var batfile,tfil:text; {@4 file list file}
|
|
xferstart,xferend,tooktime,batchtime1:datetimerec;
|
|
nfn,snfn,s,s1,s2,i,logfile:astr;
|
|
st,tott,tooktime1:real;
|
|
tblks,tblks1,cps,lng:longint;
|
|
tpts,tpts1,tnfils,tnfils1:integer;
|
|
sx,sy,hua,n,p,toxfer,rcode:integer;
|
|
c:char;
|
|
swap,done1,dok,kabort,nomore,readlog:boolean;
|
|
|
|
function tempfile(i:integer):astr;
|
|
begin
|
|
tempfile:='temp'+cstr(i)+'.$$$';
|
|
end;
|
|
|
|
procedure sprtcl(c:char; s:astr);
|
|
var wnl:boolean;
|
|
begin
|
|
if copy(s,length(s),1)<>#0 then wnl:=TRUE else wnl:=FALSE;
|
|
if not wnl then s:=copy(s,1,length(s)-1);
|
|
sprompt('^3'+c+'^1) ^4'+s);
|
|
if wnl then nl;
|
|
end;
|
|
|
|
procedure addnacc(i:integer; s:astr);
|
|
var f:ulfrec;
|
|
oldboard,pl,rn:integer;
|
|
begin
|
|
if (i<>-1) then begin
|
|
oldboard:=fileboard; fileboard:=i;
|
|
s:=sqoutsp(stripname(s));
|
|
recno(s,pl,rn); {* opens ulff *}
|
|
if rn<>0 then begin
|
|
seek(ulff,rn); read(ulff,f);
|
|
inc(f.nacc);
|
|
seek(ulff,rn); write(ulff,f);
|
|
end;
|
|
fileboard:=oldboard;
|
|
close(ulff);
|
|
end;
|
|
end;
|
|
|
|
procedure chopoffspace(var s:astr);
|
|
begin
|
|
if (pos(' ',s)<>0) then s:=copy(s,1,pos(' ',s)-1);
|
|
end;
|
|
|
|
procedure figuresucc;
|
|
var filestr,statstr:astr;
|
|
foundit:boolean;
|
|
|
|
function wasok:boolean;
|
|
var i:integer;
|
|
foundcode:boolean;
|
|
begin
|
|
foundcode:=FALSE;
|
|
for i:=1 to 6 do
|
|
if (protocol.dlcode[i]<>'') and
|
|
(protocol.dlcode[i]=copy(statstr,1,length(protocol.dlcode[i]))) then
|
|
foundcode:=TRUE;
|
|
wasok:=FALSE;
|
|
if ((foundcode) and (not (xbxferokcode in protocol.xbstat))) then exit;
|
|
if ((not foundcode) and (xbxferokcode in protocol.xbstat)) then exit;
|
|
wasok:=TRUE;
|
|
end;
|
|
|
|
begin
|
|
readlog:=FALSE;
|
|
if (protocol.templog<>'') then begin
|
|
assign(batfile,bproline1(protocol.templog));
|
|
{$I-} reset(batfile); {$I+}
|
|
if (ioresult=0) then begin
|
|
assign(tfil,bproline1(protocol.dloadlog));
|
|
{$I-} append(tfil); {$I+}
|
|
if (ioresult<>0) then rewrite(tfil);
|
|
readlog:=TRUE;
|
|
while (not eof(batfile)) do begin
|
|
readln(batfile,s); writeln(tfil,s);
|
|
filestr:=copy(s,protocol.logpf,length(s)-(protocol.logpf-1));
|
|
statstr:=copy(s,protocol.logps,length(s)-(protocol.logps-1));
|
|
chopoffspace(filestr);
|
|
foundit:=FALSE; n:=0;
|
|
while ((n<numbatchfiles) and (not foundit)) do begin
|
|
inc(n);
|
|
if (allcaps(batch[n].fn)=allcaps(filestr)) then foundit:=TRUE;
|
|
end;
|
|
if (foundit) then begin
|
|
if (wasok) then begin
|
|
sysoplog(#3#5+'Batch downloaded "'+stripname(batch[n].fn)+'"');
|
|
inc(tnfils);
|
|
inc(tblks,batch[n].blks);
|
|
inc(tpts,batch[n].pts);
|
|
loaduboard(batch[n].section);
|
|
if (not (fbnoratio in memuboard.fbstat)) then begin
|
|
inc(tnfils1);
|
|
inc(tblks1,batch[n].blks);
|
|
inc(tpts1,batch[n].pts);
|
|
end;
|
|
addnacc(batch[n].section,batch[n].fn);
|
|
delbatch(n);
|
|
end else
|
|
sysoplog(#3#7+'Tried batch download "'+stripname(batch[n].fn)+'"');
|
|
end else
|
|
sysoplog(#3#7+'*Batch downloaded unauthorized file? "'+filestr+'"');
|
|
end;
|
|
close(batfile);
|
|
close(tfil);
|
|
end;
|
|
end;
|
|
if (not readlog) then begin
|
|
while (toxfer>0) do begin
|
|
sysoplog(#3#5+'Batch download "'+stripname(batch[1].fn)+'"');
|
|
inc(tnfils);
|
|
inc(tblks,batch[1].blks);
|
|
inc(tpts,batch[1].pts);
|
|
loaduboard(batch[1].section);
|
|
if (not (fbnoratio in memuboard.fbstat)) then begin
|
|
inc(tnfils1);
|
|
inc(tblks,batch[1].blks);
|
|
inc(tpts1,batch[1].pts);
|
|
end;
|
|
addnacc(batch[1].section,batch[1].fn);
|
|
delbatch(1); dec(toxfer);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if (numbatchfiles=0) then begin
|
|
nl; print('Batch queue empty.');
|
|
end else begin
|
|
nl;
|
|
print('Checking batch download request...');
|
|
|
|
tott:=0.0;
|
|
for n:=1 to numbatchfiles do
|
|
tott:=tott+batch[n].tt;
|
|
|
|
nl;
|
|
print('Number files in batch .. : '+cstr(numbatchfiles));
|
|
print('Batch download time .... : '+ctim(tott));
|
|
print('Time left online ....... : '+ctim(nsl));
|
|
|
|
if (tott>nsl) then begin
|
|
nl;
|
|
print('Insufficient time for download!!');
|
|
print('You must remove some files from your batch queue.');
|
|
exit;
|
|
end;
|
|
|
|
reset(xf);
|
|
done1:=FALSE;
|
|
repeat
|
|
nl;
|
|
sprompt('^4Batch Protocol (^0?^4=^0list^4) : ^3'); mpkey(i);
|
|
if (i='?') then begin
|
|
nl;
|
|
showprots(FALSE,TRUE,TRUE,FALSE);
|
|
end else begin
|
|
p:=findprot(i,FALSE,TRUE,TRUE,FALSE);
|
|
if (p=-99) then print('Invalid entry.') else done1:=TRUE;
|
|
end;
|
|
until (done1) or (hangup);
|
|
if (p<>-10) then begin
|
|
seek(xf,p); read(xf,protocol); close(xf);
|
|
nl; sprint(#3#7+'Hangup after transfer?');
|
|
prt('(A)bort (N)o (Y)es (M)aybe : '); onek(c,'ANYM'^M);
|
|
if (c=^M) then c:='N';
|
|
hua:=pos(c,'ANYM');
|
|
dok:=TRUE;
|
|
if (hua<>1) then begin
|
|
tblks:=0; tpts:=0; tnfils:=0;
|
|
tblks1:=0; tpts1:=0; tnfils1:=0;
|
|
nl; nl;
|
|
|
|
nfn:=bproline1(protocol.dlcmd);
|
|
toxfer:=0; tott:=0.0;
|
|
if (pos('%F',protocol.dlcmd)<>0) then begin
|
|
done1:=FALSE;
|
|
while ((not done1) and (toxfer<numbatchfiles)) do begin
|
|
inc(toxfer); snfn:=nfn;
|
|
bproline(nfn,batch[toxfer].fn);
|
|
if (length(nfn)>protocol.maxchrs) then done1:=TRUE
|
|
else tott:=tott+batch[toxfer].tt;
|
|
end;
|
|
end;
|
|
|
|
if (protocol.dlflist<>'') then begin
|
|
tott:=0.0;
|
|
assign(batfile,bproline1(protocol.dlflist));
|
|
rewrite(batfile);
|
|
for n:=1 to numbatchfiles do begin
|
|
writeln(batfile,batch[n].fn);
|
|
inc(toxfer); tott:=tott+batch[n].tt;
|
|
end;
|
|
close(batfile);
|
|
end;
|
|
|
|
(* output x-fer batch file *)
|
|
assign(batfile,'tgtemp1.bat'); rewrite(batfile);
|
|
if (protocol.envcmd<>'') then
|
|
writeln(batfile,bproline1(protocol.envcmd));
|
|
writeln(batfile,nfn);
|
|
writeln(batfile,'exit');
|
|
close(batfile);
|
|
|
|
(* delete old log file *)
|
|
if (exist(bproline1(protocol.templog))) then begin
|
|
assign(batfile,bproline1(protocol.templog));
|
|
{$I-} erase(batfile); {$I+}
|
|
end;
|
|
|
|
r2dt(batchtime,batchtime1);
|
|
if (useron) then
|
|
print('Transmitting batch - Time: '+longtim(batchtime1));
|
|
|
|
if (useron) then shel(caps(thisuser.name)+' is batch downloading!')
|
|
else shel('Sending file(s)...');
|
|
|
|
getdatetime(xferstart);
|
|
swap:=systat.swapshell;
|
|
systat.swapshell:=FALSE;
|
|
shelldos(FALSE,'tgtemp1',rcode);
|
|
systat.swapshell:=swap;
|
|
shel2;
|
|
getdatetime(xferend);
|
|
timediff(tooktime,xferstart,xferend);
|
|
|
|
(* delete TGTEMP1.BAT batch file *)
|
|
assign(batfile,'tgtemp1.bat');
|
|
{$I-} erase(batfile); {$I+}
|
|
|
|
figuresucc;
|
|
|
|
tooktime1:=dt2r(tooktime);
|
|
if (tooktime1>=1.0) then begin
|
|
cps:=tblks; cps:=cps*128;
|
|
cps:=trunc(cps/tooktime1);
|
|
end else
|
|
cps:=0;
|
|
|
|
showuserfileinfo;
|
|
commandline('');
|
|
nl; nl;
|
|
|
|
s:='Download totals: ';
|
|
if (tnfils=0) then s:=s+'No' else s:=s+cstr(tnfils);
|
|
s:=s+' file'; if (tnfils<>1) then s:=s+'s';
|
|
lng:=tblks; lng:=lng*128;
|
|
s:=s+', '+cstrl(lng)+' bytes';
|
|
if (tpts<>0) then begin
|
|
s:=s+', '+cstr(tpts)+' file point';
|
|
if (tpts<>1) then s:=s+'s';
|
|
end;
|
|
s:=s+'.';
|
|
star(s);
|
|
|
|
if (tnfils1<>tnfils) then begin
|
|
if (tnfils<tnfils1) then tnfils1:=tnfils;
|
|
|
|
s:='Download charges: ';
|
|
if (tnfils1=0) then s:=s+'No' else s:=s+cstr(tnfils1);
|
|
s:=s+' file'; if (tnfils1<>1) then s:=s+'s';
|
|
lng:=tblks1; lng:=lng*128;
|
|
s:=s+', '+cstrl(lng)+' bytes';
|
|
if (tpts1<>0) then begin
|
|
s:=s+', '+cstr(tpts1)+' file point';
|
|
if (tpts1<>1) then s:=s+'s';
|
|
end;
|
|
s:=s+'.';
|
|
star(s);
|
|
end;
|
|
|
|
star('Download time: '+longtim(tooktime));
|
|
star('Transfer rate: '+cstr(cps)+' cps');
|
|
|
|
thisuser.dk:=thisuser.dk+(tblks1 div 8);
|
|
inc(thisuser.downloads,tnfils1);
|
|
dec(thisuser.filepoints,tpts1);
|
|
|
|
inc(systat.todayzlog.downloads,tnfils);
|
|
inc(systat.todayzlog.dk,tblks div 8);
|
|
|
|
if (numbatchfiles<>0) then begin
|
|
tblks:=0; tpts:=0;
|
|
for n:=1 to numbatchfiles do begin
|
|
inc(tblks,batch[n].blks);
|
|
inc(tpts,batch[n].pts);
|
|
end;
|
|
lng:=tblks; lng:=lng*128;
|
|
s:='Not transferred: '+cstr(numbatchfiles)+' file';
|
|
if (numbatchfiles<>1) then s:=s+'s';
|
|
s:=s+', '+cstrl(lng)+' bytes';
|
|
if (tpts<>0) then begin
|
|
s:=s+', '+cstr(tpts)+' file point';
|
|
if (tpts<>1) then s:=s+'s';
|
|
end;
|
|
s:=s+'.';
|
|
star(s);
|
|
end;
|
|
|
|
case hua of
|
|
3:hangup:=TRUE;
|
|
4:begin
|
|
nl;
|
|
nl;
|
|
print('System will automatically hang up in 30 seconds.');
|
|
print('Hit [H] to hang up now, any other key to abort.');
|
|
st:=timer;
|
|
while (tcheck(st,30)) and (empty) do;
|
|
if (empty) then hangup:=TRUE;
|
|
if (not empty) then
|
|
if upcase(inkey)='H' then
|
|
hangup:=TRUE;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure listbatchfiles;
|
|
var tot:record
|
|
pts:integer;
|
|
blks:longint;
|
|
tt:real;
|
|
end;
|
|
s:astr;
|
|
i:integer;
|
|
abort,next:boolean;
|
|
begin
|
|
if (numbatchfiles=0) then begin
|
|
nl; print('Batch queue empty.');
|
|
end else begin
|
|
abort:=FALSE; next:=FALSE;
|
|
with tot do begin
|
|
pts:=0; blks:=0; tt:=0.0;
|
|
end;
|
|
|
|
nl;
|
|
printacr(#3#4+'##:Filename.Ext Area Pts Bytes hh:mm:ss',abort,next);
|
|
printacr(#3#4+'--------------- ---- ----- ------- --------',abort,next);
|
|
|
|
i:=1;
|
|
while (not abort) and (not hangup) and (i<=numbatchfiles) do begin
|
|
with batch[i] do begin
|
|
if section=-1 then s:=#3#7+'Unli' else s:=#3#5+mrn(cstr(section),4);
|
|
s:=#3#3+mn(i,2)+#3#4+':'+#3#5+align(stripname(fn))+' '+
|
|
s+' '+#3#4+mrn(cstr(pts),5)+' '+
|
|
#3#4+mrn(cstrl(blks*128),7)+' '+#3#7+ctim(tt);
|
|
if (section<>-1) then begin
|
|
loaduboard(section);
|
|
if (fbnoratio in memuboard.fbstat) then s:=s+#3#5+' <No-Ratio>';
|
|
end;
|
|
printacr(s,abort,next);
|
|
tot.pts:=tot.pts+pts;
|
|
tot.blks:=tot.blks+blks;
|
|
tot.tt:=tot.tt+tt;
|
|
end;
|
|
inc(i);
|
|
end;
|
|
|
|
printacr(#3#4+'--------------- ---- ----- ------- --------',abort,next);
|
|
with tot do
|
|
s:=#3#3+mln('Totals:',20)+' '+#3#4+mrn(cstr(pts),5)+' '+
|
|
#3#4+mrn(cstrl(blks*128),7)+' '+#3#7+ctim(tt);
|
|
printacr(s,abort,next);
|
|
end;
|
|
end;
|
|
|
|
procedure removebatchfiles;
|
|
var s:astr;
|
|
i:integer;
|
|
begin
|
|
if numbatchfiles=0 then begin
|
|
nl; print('Batch queue empty.');
|
|
end else
|
|
repeat
|
|
nl;
|
|
prt('File # to remove (1-'+cstr(numbatchfiles)+') (?=list) : ');
|
|
input(s,2); i:=value(s);
|
|
if (s='?') then listbatchfiles;
|
|
if (i>0) and (i<=numbatchfiles) then begin
|
|
print('"'+stripname(batch[i].fn)+'" deleted out of queue.');
|
|
delbatch(i);
|
|
end;
|
|
if (numbatchfiles=0) then print('Queue now empty.');
|
|
until (s<>'?');
|
|
end;
|
|
|
|
procedure clearbatch;
|
|
begin
|
|
nl;
|
|
if pynq('Clear queue? ') then begin
|
|
numbatchfiles:=0;
|
|
batchtime:=0.0;
|
|
print('Queue now empty.');
|
|
end;
|
|
end;
|
|
|
|
end.
|