file11.pas

{$A+,B+,E+,F+,I+,L+,N-,O+,R-,S+,V-}
unit file11;

interface

uses
  crt,dos,

  {rcg11172000 no overlay under Linux.}
  {overlay,}

  myio,
  file0, file1,
  common;

function cansee(f:ulfrec):boolean;
procedure pbn(var abort,next:boolean);
procedure pfn(fnum:integer; f:ulfrec; var abort,next:boolean);
procedure searchb(b:integer; fn:astr; filestats:boolean; var abort,next:boolean);
procedure search;
procedure listfiles;
procedure searchbd(b:integer; ts:astr; var abort,next:boolean);
procedure searchd;
procedure newfiles(b:integer; var abort,next:boolean);
procedure gnfiles;
procedure nf(mstr:astr);
procedure fbasechange(var done:boolean; mstr:astr);
procedure createtempdir;
procedure fbasestats;

implementation

function cansee(f:ulfrec):boolean;
begin
  cansee:=((not (notval in f.filestat)) or (aacs(systat.seeunval)));
end;

function isulr:boolean;
begin
  isulr:=((systat.uldlratio) and (not systat.fileptratio));
end;

procedure pbn(var abort,next:boolean);
var s,s1:astr;
begin
  if (not bnp) then begin
    printacr('',abort,next);
    if (thisuser.flistopt<>30) then begin
      printacr('',abort,next);
      loaduboard(fileboard);
      s:=#3#5+memuboard.name+' '+#3#2+'#'+#3#4+cstr(ccuboards[1][fileboard]);
      s1:=#3#0; while (lenn(s1)<lenn(s)) do s1:=s1+'-';
      if (fbnoratio in memuboard.fbstat) then s:=s+#3#5+' <No-Ratio>';
      sprint(s);
      sprint(s1);
    end;
    case thisuser.flistopt of
      1:if (isulr) then begin
          printacr(#3#4+' Filename.Ext  Bytes  Description',abort,next);
          printacr(#3#4+' -------- --- ------- -------------------------------------------------------',
            abort,next);
        end else begin
          printacr(#3#4+' Filename.Ext Len Pts Description',abort,next);
          printacr(#3#4+' -------- --- --- --- -------------------------------------------------------',
            abort,next);
        end;
      2,30:begin
          s:=#3#4+' ###:Filename.Ext  Bytes  Pts DLs mm/dd/yy';
          s1:=#3#4+' ------------ --- ------- --- --- --------';
          if (aacs(memuboard.nameacs)) then begin
            s:=s+' ULed By';
            s1:=s1+' -----------------------------------';
          end;
          printacr(s,abort,next);
          printacr(s1,abort,next);
        end;
    end;
  end;
  bnp:=TRUE;
end;

procedure pfndd(fnum:integer; ts:astr; f:ulfrec; var abort,next:boolean);
var s,s1,dd,dd2:astr;
    v:verbrec;
    u:userrec;
    li:longint;
    i:integer;
    vfo:boolean;

  function ptsf:astr;
  begin
    if (isrequest in f.filestat) then ptsf:=#3#9+'Offline' else
      if (resumelater in f.filestat) then ptsf:=#3#7+'ResLatr' else
        if (notval in f.filestat) then ptsf:=#3#8+'Unvalid' else
          if ((isulr) and (f.filepoints=0)) then begin
            li:=f.blocks; li:=li*128;
            ptsf:=#3#4+mln(cstrl(li),7);
          end else
            ptsf:=#3#4+mln(cstr(f.blocks div 8),3)+' '+
                  mln(cstr(f.filepoints),3);
  end;

  function ptsf2:astr;
  begin
    if (isrequest in f.filestat) or (resumelater in f.filestat) or
       (notval in f.filestat) then ptsf2:=ptsf+'    '
    else begin
      li:=f.blocks; li:=li*128;
      ptsf2:=mln(cstrl(li),7)+' '+mln(cstr(f.filepoints),3);
    end;
  end;

  {rcg11172000 had to change this to get it compiling under Free Pascal...}
  {function substone(iscaps:boolean; src,old,new:astr):astr;}
  function substone(iscaps:boolean; src,old,_new:astr):astr;
  var p:integer;
  begin
    if (old<>'') then begin
      if (iscaps) then _new:=allcaps(_new);
      p:=pos(allcaps(old),allcaps(src));
      if (p>0) then begin
        insert(_new,src,p+length(old));
        delete(src,p,length(old));
      end;
    end;
    substone:=src;
  end;

begin
  loaduboard(fileboard);
  case thisuser.flistopt of
    1:begin
        dd:=f.description;
        if (ts<>'') then dd:=substone(TRUE,dd,ts,#3#0+allcaps(ts)+#3#5);
        if (f.daten>=daynum(newdate)) then s:=#3#8+'*' else s:=' ';
        dd2:=f.filename;
        if (ts<>'') then dd2:=substone(TRUE,dd2,ts,#3#0+allcaps(ts)+#3#3);
        s:=s+#3#3+dd2+' '+ptsf+' '+#3#5;
        s1:=copy(dd,1,55);
        if (not flistverb) and (f.vpointer<>-1) then begin
          if (lenn(dd)>52) then s1:=copy(dd,1,51)+#3#3+'+';
          s1:=s1+#3#9+'(v)';
        end else
          if (lenn(dd)>54) then s1:=copy(dd,1,53)+#3#3+'+';
        if ((isgifext(f.filename)) and (isgifdesc(s1))) then begin
          dd:=copy(s1,1,pos('c)',s1)+1);
          dd2:=#3#3+copy(s1,1,pos('c)',s1)+1)+#3#5;
          s1:=substone(FALSE,s1,dd,dd2);
        end;
        s:=s+s1;
      end;
    2,30:begin
        if (f.daten>=daynum(newdate)) then s:=#3#8+'*' else s:=' ';
        s:=s+#3#3+mn(fnum,3)+#3#4+':'+#3#3+f.filename+' '+ptsf2+' '+
           #3#5+mln(cstr(f.nacc),3)+' '+#3#7+f.date;
        if (aacs(memuboard.nameacs)) then
          s:=s+' '+#3#9+caps(f.stowner)+' #'+cstr(f.owner);
      end;
    3:begin
        printacr('',abort,next);

        dd:=f.description;
        if (ts<>'') then dd:=substone(TRUE,dd,ts,#3#0+allcaps(ts)+#3#5);
        dd2:=f.filename;
        if (ts<>'') then dd2:=substone(TRUE,dd2,ts,#3#0+allcaps(ts)+#3#3);

        if (f.daten>=daynum(newdate)) then s:=#3#8+'*' else s:=' ';
        s:=s+#3#3+dd2+#3#4+':'+#3#4+mln(cstr(f.nacc)+' DLs',7)+#3#4+':'+
             #3#4+'ULed on '+f.date;
        if (aacs(memuboard.nameacs)) then
          s:=s+' by '+#3#9+caps(f.stowner)+' #'+cstr(f.owner);
        printacr(s,abort,next);

        if (isrequest in f.filestat) then
          s1:=#3#9+'File stored off-line'
        else
          if (resumelater in f.filestat) then
            s1:=#3#7+'Resume-later file'
          else
            if (notval in f.filestat) then
              s1:=#3#8+'Not validated yet'
            else begin
              li:=f.blocks; li:=li*128;
              if ((isulr) and (f.filepoints=0)) then
                s1:=#3#4+cstrl(li)+' bytes'
              else
                s1:=#3#4+cstrl(li)+' bytes, '+cstr(f.filepoints)+' pts';
            end;
        s:=' '+mln(s1,20)+#3#4+':'+#3#5;
        s1:=copy(dd,1,55);
        if ((isgifext(f.filename)) and (isgifdesc(s1))) then begin
          dd:=copy(s1,1,pos('c)',s1)+1);
          dd2:=#3#3+copy(s1,1,pos('c)',s1)+1)+#3#5;
          s1:=substone(FALSE,s1,dd,dd2);
        end;
        s:=s+s1;
      end;
  end;
  printacr(s,abort,next);
  if ((f.vpointer<>-1) and (flistverb) and (thisuser.flistopt in [1,3])) then begin
    vfo:=(filerec(verbf).mode<>fmclosed);
    {$I-} if (not vfo) then reset(verbf); {$I+}
    if (ioresult=0) then begin
      {$I-} seek(verbf,f.vpointer); read(verbf,v); {$I+}
      if (ioresult=0) then
        for i:=1 to 4 do
          if (v.descr[i]='') then i:=4
          else begin
            dd:=substone(TRUE,v.descr[i],ts,#3#0+allcaps(ts)+#3#4);
            printacr('                          '+#3#2+':'+#3#4+dd,abort,next);
          end;
      if (not vfo) then close(verbf);
    end;
  end;
  if ((resumelater in f.filestat) and (f.owner=usernum)) then
    printacr(#3#8+'>'+#3#7+'>> '+#3#3+'You '+#3#5+'MUST RESUME'+#3#3+
             ' this file to receive credit for it',abort,next);
end;

procedure pfn(fnum:integer; f:ulfrec; var abort,next:boolean);
begin
  pfndd(fnum,'',f,abort,next);
end;

procedure searchb(b:integer; fn:astr; filestats:boolean; var abort,next:boolean);
var f:ulfrec;
    li,totfils,totsize:longint;
    oldboard,pl,rn:integer;
begin
  oldboard:=fileboard;
  if (fileboard<>b) then changefileboard(b);
  if (fileboard=b) then begin
    totfils:=0; totsize:=0;
    recno(fn,pl,rn);
    if (baddlpath) then exit;
    while ((rn<=pl) and (not abort) and (not hangup) and (rn<>0)) do begin
      seek(ulff,rn); read(ulff,f);
      if (cansee(f)) then begin
        pbn(abort,next);
        pfn(rn,f,abort,next);
        if (filestats) then begin
          inc(totfils);
          li:=f.blocks; li:=li*128; inc(totsize,li);
        end;
      end;
      nrecno(fn,pl,rn);
    end;
    if ((filestats) and (not abort) and (totfils>0)) then
      if (thisuser.flistopt<>3) then begin
        printacr(#3#4+' ------------ -------',abort,next);
        printacr(#3#4+' '+mln(cstr(totfils)+' files',12)+' '+cstr(totsize)+' bytes total',abort,next);
      end else begin
        nl;
        printacr(#3#4+cstr(totfils)+' files, '+cstr(totsize)+' bytes total.',abort,next);
      end;
    close(ulff);
  end;
  fileboard:=oldboard;
end;

procedure search;
var fn:astr;
    bn:integer;
    abort,next:boolean;
begin
  nl;
  sprint(fstring.searchline);
  sprint(fstring.pninfo);
  nl; gfn(fn);
  bn:=0; abort:=FALSE; next:=FALSE;
  while (not abort) and (bn<=maxulb) and (not hangup) do begin
    if (fbaseac(bn)) then searchb(bn,fn,FALSE,abort,next);
    inc(bn);
    wkey(abort,next);
    if (next) then begin abort:=FALSE; next:=FALSE; end;
  end;
end;

procedure listfiles;
var fn:astr;
    abort,next:boolean;
begin
  nl;
  sprint(fstring.listline);
  gfn(fn); abort:=FALSE;
  searchb(fileboard,fn,TRUE,abort,next);
end;

procedure searchbd(b:integer; ts:astr; var abort,next:boolean);
var oldboard,pl,rn,i:integer;
    f:ulfrec;
    ok,vfo:boolean;
    v:verbrec;
begin
  oldboard:=fileboard;
  if (fileboard<>b) then changefileboard(b);
  if (fileboard=b) then begin
    vfo:=(filerec(verbf).mode<>fmclosed);
    {$I-} if not vfo then reset(verbf); {$I+}
    fiscan(pl);
    if (baddlpath) then exit;
    rn:=1;
    while (rn<=pl) and (not abort) and (not hangup) do begin
      seek(ulff,rn); read(ulff,f);
      if (cansee(f)) then begin
        ok:=((pos(ts,allcaps(f.description))<>0) or
             (pos(ts,allcaps(f.filename))<>0));
        if (not ok) then
          if (f.vpointer<>-1) then begin
            {$I-} seek(verbf,f.vpointer); read(verbf,v); {$I+}
            if (ioresult=0) then begin
              i:=1;
              while (v.descr[i]<>'') and (i<=4) and (not ok) do begin
                if pos(ts,allcaps(v.descr[i]))<>0 then ok:=TRUE;
                inc(i);
              end;
            end;
          end;
      end;
      if (ok) then begin
        pbn(abort,next);
        pfndd(rn,ts,f,abort,next);
      end;
      inc(rn);
    end;
    close(ulff);
    reset(verbf); close(verbf);
  end;
  fileboard:=oldboard;
end;

procedure searchd;
var s:astr;
    bn:integer;
    abort,next:boolean;
begin
  nl;
  sprint(fstring.findline1);
  nl;
  sprint(fstring.findline2);
  prt(':'); mpl(20); input(s,20);
  if (s<>'') then begin
    nl; print('Searching for "'+s+'"'); nl;
    if pynq('Search all directories? ') then begin
      bn:=0; abort:=FALSE; next:=FALSE;
      while (not abort) and (bn<=maxulb) and (not hangup) do begin
        if (fbaseac(bn)) then searchbd(bn,s,abort,next);
        inc(bn);
        wkey(abort,next);
        if (next) then begin abort:=FALSE; next:=FALSE; end;
      end;
    end else begin
      abort:=FALSE; next:=FALSE;
      searchbd(fileboard,s,abort,next);
    end;
  end;
end;

procedure newfiles(b:integer; var abort,next:boolean);
var f:ulfrec;
    oldboard,pl,rn:integer;
begin
  oldboard:=fileboard;
  if (fileboard<>b) then changefileboard(b);
  if (fileboard=b) then begin
    fiscan(pl);
    if (baddlpath) then exit;
    rn:=1;
    while (rn<=pl) and (not abort) and (not hangup) do begin
      seek(ulff,rn); read(ulff,f);
      if ((cansee(f)) and (f.daten>=daynum(newdate))) or
         ((notval in f.filestat) and (cansee(f))) then begin
        pbn(abort,next);
        pfn(rn,f,abort,next);
      end;
      inc(rn);
    end;
    close(ulff);
  end;
  fileboard:=oldboard;
end;

procedure gnfiles;
var i:integer;
    abort,next:boolean;
begin
  sysoplog('NewScan of file bases');
  i:=0;
  abort:=FALSE; next:=FALSE;
  while (not abort) and (i<=maxulb) and (not hangup) do begin
    if ((fbaseac(i)) and (i in zscanr.fzscan)) then newfiles(i,abort,next);
    inc(i);
    wkey(abort,next);
    if (next) then begin abort:=FALSE; next:=FALSE; end;
  end;
end;

procedure nf(mstr:astr);
var bn:integer;
    abort,next:boolean;
begin
  if (mstr='C') then newfiles(board,abort,next)
  else if (mstr='G') then gnfiles
  else if (value(mstr)<>0) then newfiles(value(mstr),abort,next)
  else begin
    nl;
    sprint(fstring.newline);
    sprint(fstring.pninfo);
    nl;
    abort:=FALSE; next:=FALSE;
    if pynq('Search all directories? ') then gnfiles
      else newfiles(fileboard,abort,next);
  end;
end;

procedure fbasechange(var done:boolean; mstr:astr);
var s:astr;
    i:integer;
begin
  if (mstr<>'') then
    case mstr[1] of
      '+':begin
            i:=fileboard;
            if (fileboard>=maxulb) then i:=0 else
              repeat
                inc(i);
                if (fbaseac(i)) then changefileboard(i);
              until ((fileboard=i) or (i>maxulb));
            if (fileboard<>i) then sprint('@MHighest accessible file base.')
              else lastcommandovr:=TRUE;
          end;
      '-':begin
            i:=fileboard;
            if (fileboard<=0) then i:=maxulb else
              repeat
                dec(i);
                if fbaseac(i) then changefileboard(i);
              until ((fileboard=i) or (i<=0));
            if (fileboard<>i) then sprint('@MLowest accessible file base.')
              else lastcommandovr:=TRUE;
          end;
      'L':fbaselist;
    else
          begin
            changefileboard(value(mstr));
            if (pos(';',mstr)>0) then begin
              s:=copy(mstr,pos(';',mstr)+1,length(mstr));
              curmenu:=systat.menupath+s+'.mnu';
              newmenutoload:=TRUE;
              done:=TRUE;
            end;
            lastcommandovr:=TRUE;
          end;
    end
  else begin
    if (novice in thisuser.ac) then fbaselist;
    nl;
    s:='?';
    repeat
      prt('^7Change file base (^3?^7=^3List^7) : '); input(s,3);
      i:=ccuboards[0][value(s)];
      if (s='?') then begin fbaselist; nl; end else
        if (((i>=1) and (i<=maxulb)) or
           ((i=0) and (copy(s,1,1)='0'))) and
           (i<>fileboard) then
          changefileboard(i);
    until (s<>'?') or (hangup);
    lastcommandovr:=TRUE;
  end;
end;

procedure createtempdir;
var s:astr;
    i:integer;
begin
  nl;
  if (maxulb=maxuboards) then print('Too many file bases already.')
  else begin
    print('Enter file path for temporary directory');
    prt(':'); mpl(40); input(s,40);
    if (s<>'') then begin
      s:=fexpand(bslash(TRUE,s));
      fileboard:=maxulb+1;
      sysoplog('Created temporary directory #'+cstr(fileboard)+
               ' in "'+s+'"');
      with tempuboard do begin
        name:='<< Temporary >>';
        filename:='TEMPFILE';
        dlpath:=s;
        ulpath:=s;
        maxfiles:=2000;
        password:='';
        arctype:=0;
        cmttype:=1;
        fbdepth:=0;
        fbstat:=[];
        acs:='s'+cstr(thisuser.sl)+'d'+cstr(thisuser.dsl);
        ulacs:='s'+cstr(thisuser.sl)+'d'+cstr(thisuser.dsl);
        nameacs:='s'+cstr(thisuser.sl)+'d'+cstr(thisuser.dsl);
        for i:=1 to 6 do res[i]:=0;
      end;
      memuboard:=tempuboard;
    end;
  end;
end;

procedure fbasestats;
var s:astr;
    abort,next:boolean;

  procedure dd(var abort,next:boolean; s1,s2:astr; b:boolean);
  begin
    s1:=#3#3+s1+#3#5+' ';
    if (b) then printacr(s1+s2,abort,next)
      else printacr(s1+'None.',abort,next);
  end;

begin
  abort:=FALSE; next:=FALSE;
  nl;
  loaduboard(fileboard);
  with memuboard do begin
    s:=#3#3+'Statistics on "'+#3#5+memuboard.name+' #'+
       cstr(ccuboards[1][fileboard])+#3#3+'"';
    if (fbnoratio in fbstat) then s:=s+#3#5+' <No-Ratio>';
    printacr(s,abort,next);
    nl;
{    dd(abort,next,'AR requirement ....... :','"'+ar+'"',(ar<>'@'));}
    dd(abort,next,'Base password ........ :','"'+password+'"',(password<>''));
{    dd(abort,next,'SL requirement ....... :',cstr(sl)+' SL',(sl<>0));}
{    dd(abort,next,'DSL requirement ...... :',cstr(dsl)+' DSL',(dsl<>0));}
    dd(abort,next,'Max files allowed .... :',cstr(maxfiles),(maxfiles<>0));
{    dd(abort,next,'Age requirement ...... :',cstr(agereq),(agereq>1));}
    s:=systat.filearcinfo[arctype].ext;
    dd(abort,next,'Archive format ....... :','"'+s+'"',(arctype<>0));
    if (fso) then begin
      nl;
      {rcg11182000 lowercased this ".DIR" strings...}
      dd(abort,next,'Filename ...... :','"'+filename+'.dir"',TRUE);
      dd(abort,next,'DL file path .. :','"'+dlpath+'"',TRUE);
    end;
  end;
end;

end.