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