(*****************************************************************************)
(*>                                                                         <*)
(*>  SYSOP9  .PAS -  Written by Eric Oman                                   <*)
(*>                                                                         <*)
(*>  SysOp functions: File base editor                                      <*)
(*>                                                                         <*)
(*****************************************************************************)
{$A+,B+,E+,F+,I+,L+,N-,O+,R-,S+,V-}
unit sysop9;

interface

procedure dlboardedit;

implementation

uses
  crt, dos,

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

  common,
  file0, file2,
  sysop1, sysop8;

var zc:integer;

procedure fbase_del(var zscanr1:zscanrec; x,y:integer);
begin
  for zc:=x to maxulb-1 do
    if (zc+1 in zscanr1.fzscan) then zscanr1.fzscan:=zscanr1.fzscan+[zc]
                                else zscanr1.fzscan:=zscanr1.fzscan-[zc];
  zscanr1.mzscan:=zscanr1.mzscan+[maxulb];
end;

procedure fbase_ins(var zscanr1:zscanrec; x,y:integer);
begin
  for zc:=numboards downto x+1 do
    if (zc-1 in zscanr1.fzscan) then zscanr1.fzscan:=zscanr1.fzscan+[zc]
                                else zscanr1.fzscan:=zscanr1.fzscan-[zc];
  zscanr1.fzscan:=zscanr1.fzscan+[x];
end;

procedure fbase_pos(var zscanr1:zscanrec; x,y:integer);
var s_fzscan:boolean;
    i,j,k:integer;
begin
  s_fzscan:=(x in zscanr1.fzscan);
  i:=x; if (x>y) then j:=-1 else j:=1;
  while (i<>y) do begin
    if (i+j in zscanr1.fzscan) then zscanr1.fzscan:=zscanr1.fzscan+[i]
                               else zscanr1.fzscan:=zscanr1.fzscan-[i];
    inc(i,j);
  end;
  if (s_fzscan) then zscanr1.fzscan:=zscanr1.fzscan+[y]
                else zscanr1.fzscan:=zscanr1.fzscan-[y];
(*
            y   x
          012345678901234567890
   (k) 1> xx*==*Oxxx...........
          xx.*==*xxx...........
   (j) 2> xxO*==*xxx...........

            x   y
          012345678901234567890
   (k) 1> xxOxxxxxxx...........
   (j) 2> xxxxxxOxxx...........

           y  x         x  y
          0123456      0123456
          XxxxOXX      XOxxxXX
          X.xxxXX      Xxxx.XX
          XOxxxXX      XxxxOXX
          0312456      0231456

*)
end;

procedure dlboardedit;
const ltype:integer=1;
var i1,ii,culb,i2:integer;
    c:char;
    s0:astr;
    f:file;
    abort,next,done:boolean;

  function newindexno:longint;
  var ubrd:ulrec;
      i,j:integer;
  begin
    reset(ulf);
    j:=-1;
    for i:=0 to filesize(ulf)-1 do begin
      read(ulf,ubrd);
      if (ubrd.permindx>j) then j:=ubrd.permindx;
    end;
    inc(j);
    newindexno:=j;
  end;

  procedure dlbed(x:integer);
  var i,j:integer;
  begin
    if ((x>=0) and (x<=maxulb)) then begin
      i:=x; {-1;}
      if (i>=0) and (i<=filesize(ulf)-2) then
        for j:=i to filesize(ulf)-2 do begin
          seek(ulf,j+1); read(ulf,memuboard);
          seek(ulf,j); write(ulf,memuboard);
        end;
      seek(ulf,filesize(ulf)-1); truncate(ulf);
      dec(maxulb);
      dozscanfunc(fbase_del,x,0);
    end;
  end;

  procedure dlbei(x:integer);
  var s:string;
      i,j,k:integer;
  begin
    i:=x; {-1;}
    if ((i>=0) and (i<=filesize(ulf)) and (maxulb<maxuboards)) then begin
      for j:=filesize(ulf)-1 downto i do begin
        seek(ulf,j); read(ulf,memuboard);
        write(ulf,memuboard); { ...to next record }
      end;
      with memuboard do begin
        getdir(0,s);
        name:='<< Not Used >>';
        filename:='NEWDIR';
        {rcg11242000 DOSism.}
        {dlpath:=s[1]+':DLOADS\';}
        dlpath:=s[1]+':DLOADS/';
        ulpath:=dlpath;
        maxfiles:=2000;
        password:='';
        arctype:=1; cmttype:=1;
        fbdepth:=0;
        fbstat:=[];
        acs:='';
        ulacs:='';
        nameacs:='';
        permindx:=newindexno;
        for k:=1 to 6 do res[k]:=0;
      end;
      seek(ulf,i); write(ulf,memuboard);
      inc(maxulb);

      dozscanfunc(fbase_ins,x,0);
    end;
  end;

  procedure dlbep(x,y:integer);
  var tempuboard:ulrec;
      i,j,k:integer;
  begin
    k:=y; if (y>x) then dec(y);
{    dec(x); dec(y);}
    seek(ulf,x); read(ulf,tempuboard);
    i:=x; if (x>y) then j:=-1 else j:=1;
    while (i<>y) do begin
      if (i+j<filesize(ulf)) then begin
        seek(ulf,i+j); read(ulf,memuboard);
        seek(ulf,i); write(ulf,memuboard);
      end;
      inc(i,j);
    end;
    seek(ulf,y); write(ulf,tempuboard);
{    inc(x); inc(y);} {y:=k;}

    dozscanfunc(fbase_pos,x,y);
  end;

  function samulpath(dl,ul:astr):astr;
  begin
    if (dl<>ul) then samulpath:=ul else samulpath:='Same';
  end;

  function flagstate(fb:ulrec):astr;
  var s:astr;
  begin
    s:='';
    with fb do begin
      if (fbisdir in fbstat) then s:=s+'D' else s:=s+'-';
      if (fbusegifspecs in fbstat) then s:=s+'G' else s:=s+'-';
      if (fbdirdlpath in fbstat) then s:=s+'I' else s:=s+'-';
      if (fbnoratio in fbstat) then s:=s+'N' else s:=s+'-';
      if (fbunhidden in fbstat) then s:=s+'U' else s:=s+'-';
    end;
    flagstate:=s;
  end;

  procedure getdirspec(var s:string);
  begin
    {rcg11182000 lowercased these ".DIR" strings...}
    with memuboard do
      if (fbdirdlpath in fbstat) then
        s:=fexpand(dlpath+filename+'.dir')
      else
        s:=fexpand(systat.gfilepath+filename+'.dir');
  end;

  procedure dlbem;
  var f:file;
      dirinfo:searchrec;
      xloaded,i,ii:integer;
      c:char;
      s,s1,s2:astr;
{      d:dlnscan;}
      b:byte;
      changed,nospace,ok:boolean;
  begin
    xloaded:=-1;
    prt('Begin editing at which? (0-'+cstr(maxulb)+') : '); inu(ii);
    c:=' ';
    if (ii>=0) and (ii<=maxulb) and (not badini) then begin
      while (c<>'Q') and (not hangup) do begin
        if (xloaded<>ii) then begin
          seek(ulf,ii); read(ulf,memuboard);
          xloaded:=ii; changed:=FALSE;
        end;
        with memuboard do
          repeat
            if (c<>'?') then begin
              cls;
              sprint(#3#1+'File base #'+cstr(ii)+' of '+cstr(maxulb)); nl;
              sprint('1. Name        : '+#3#5+name);
              print('2. Filename    : '+filename);
              print('3. DL/UL path  : '+dlpath+' / '+samulpath(dlpath,ulpath));
              print('4. ACS req.    : "'+acs+'"');
              print('5. UL/Name ACS : "'+ulacs+'" / "'+nameacs+'"');
              print('6. Max files   : '+cstr(maxfiles));
              print('7. Password    : "'+password+'"');
              if arctype=0 then s:='None' else s:=systat.filearcinfo[arctype].ext;
              s:=s+'/'; if cmttype=0 then s:=s+'None' else s:=s+cstr(cmttype);
              print('8. Arc/cmt type: '+s);
              print('9. Dir depth   : '+cstr(fbdepth));
              print('   Flags       : '+flagstate(memuboard));
              print('   P-Index     : '+cstrl(permindx));
              print('Q. Quit');
            end;
            nl;
            prt('Edit menu (?=help) : '); onek(c,'Q123456789DGINU[]FJL?'^M);
            nl;
            case c of
              '?':begin
                    sprint('<CR>Redisplay screen');
                    sprint('1-8:Modify item');
                    lcmds(15,3,'[Back entry',']Forward entry');
                    lcmds(15,3,'Jump to entry','First entry in list');
                    lcmds(15,3,'Quit and save','Last entry in list');
                    nl;
                    sprint('Toggles:');
                    lcmds(15,3,'NoRatio','Unhidden');
                    lcmds(15,3,'Dir-header','I*.DIR file in DLPATH');
                    lcmds(15,3,'GifSpecs','');
                  end;
              '1':begin
                    prt('New name: '); cl(5);
                    inputwnwc(name,40,changed);
                  end;
              '2':begin
                    getdirspec(s1);
                    prt('New filename: '); mpl(8); input(s,8); s:=sqoutsp(s);
                    if (pos('.',s)>0) then
                      filename:=copy(s,1,pos('.',s)-1);
                    if (s<>'') then begin
                      if (s<>filename) then changed:=TRUE;
                      filename:=s;
                      getdirspec(s2);
                      if ((exist(s1)) and (not exist(s2))) then begin
                        nl;
                        print('Old DIR filename: "'+s1+'"');
                        print('New DIR filename: "'+s2+'"');
                        nl;
                        if pynq('Rename old filename to new filename? ') then begin
                          assign(f,s1);
                          {$I-} rename(f,s2); {$I+}
                          if (ioresult<>0) then begin
                            print('Errors renaming directory filename.');
                            pausescr;
                          end;
                        end;
                      end;
                    end;
                  end;
              '3':begin
                    print('Enter new download path:');
                    prt(':'); mpl(40); input(s,40); s:=sqoutsp(s);
                    if (s<>'') then begin
                      {rcg11242000 DOSisms.}
                      {
                      while (copy(s,length(s)-1,2)='\\') do s:=copy(s,1,length(s)-1);
                      if (copy(s,length(s),1)<>'\') then s:=s+'\';
                      }
                      while (copy(s,length(s)-1,2)='//') do s:=copy(s,1,length(s)-1);
                      if (copy(s,length(s),1)<>'/') then s:=s+'/';
                      if (s<>dlpath) then changed:=TRUE;
                      dlpath:=s;
                      if (not existdir(s)) then begin
                        nl;
                        print('"'+s+'" does not exist.');
                        if (pynq('Create file directory now? ')) then begin
                          {$I-} mkdir(bslash(FALSE,s)); {$I+}
                          if (ioresult<>0) then begin
                            print('Errors creating directory.');
                            pausescr;
                          end;
                        end;
                      end;
                    end;
                    nl;
                    print('Enter new upload path: ("D"=Same as DL path)');
                    prt(':'); mpl(40); input(s,40); s:=sqoutsp(s);
                    if ((s='D') or (s='d')) then s:=dlpath;
                    if (s<>'') then begin
                      {rcg11242000 DOSism.}
                      {
		      while (copy(s,length(s)-1,2)='\\') do s:=copy(s,1,length(s)-1);
                      if (copy(s,length(s),1)<>'\') then s:=s+'\';
                      }
		      while (copy(s,length(s)-1,2)='//') do s:=copy(s,1,length(s)-1);
                      if (copy(s,length(s),1)<>'/') then s:=s+'/';
                      if (s<>ulpath) then changed:=TRUE;
                      ulpath:=s;
                      if (not existdir(s)) then begin
                        nl;
                        print('"'+s+'" does not exist.');
                        if (pynq('Create file directory now? ')) then begin
                          {$I-} mkdir(bslash(FALSE,s)); {$I+}
                          if (ioresult<>0) then begin
                            print('Errors creating directory.');
                            pausescr;
                          end;
                        end;
                      end;
                    end;
                  end;
              '4':begin
                    prt('New ACS: '); mpl(20);
                    inputwn(acs,20,changed);
                  end;
              '5':begin
                    prt('New UL ACS: '); mpl(20);
                    inputwn(ulacs,20,changed);
                    prt('New See-Names ACS: '); mpl(20);
                    inputwn(nameacs,20,changed);
                  end;
              '6':begin
                    prt('New max files: '); mpl(4); inu(i);
                    if (not badini) then begin
                      if (maxfiles<>i) then changed:=TRUE;
                      if (i>2000) then i:=2000;
                      maxfiles:=i;
                    end;
                  end;
              '7':begin
                    prt('New PW: ');
                    mpl(10); inputwn1(password,10,'u',changed);
                  end;
              '8':begin
                    if (arctype=0) then s:='None'
                      else s:=systat.filearcinfo[arctype].ext;
                    prt('New archive type ("0" for none) ['+s+'] : ');
                    input(s,3);
                    if (s<>'') then begin
                      b:=arctype;
                      if (value(s) in [1..maxarcs]) then b:=value(s)
                      else
                        for i:=1 to maxarcs do
                          if s=systat.filearcinfo[i].ext then b:=i;
                      if (value(s)=0) and (copy(s,1,1)='0') then b:=0;
                      if (arctype<>b) then changed:=TRUE;
                      arctype:=b;
                    end;
                    prt('New comment type ['+cstr(cmttype)+'] : '); ini(b);
                    if (not badini) and (b in [0..3]) then begin
                      if (cmttype<>b) then changed:=TRUE;
                      cmttype:=b;
                    end;
                  end;
              '9':begin
                    prt('New file base depth: '); mpl(3); ini(b);
                    if (not badini) then begin
                      if (fbdepth<>b) then changed:=TRUE;
                      fbdepth:=b;
                    end;
                  end;
              'D','G','I','N','U':
                  begin
                    changed:=TRUE;
                    case c of
                      'D':if (fbisdir in fbstat) then
                            fbstat:=fbstat-[fbisdir]
                          else fbstat:=fbstat+[fbisdir];
                      'G':if (fbusegifspecs in fbstat) then
                            fbstat:=fbstat-[fbusegifspecs]
                          else fbstat:=fbstat+[fbusegifspecs];
                      'I':begin
                            getdirspec(s1);
                            if (fbdirdlpath in fbstat) then
                              fbstat:=fbstat-[fbdirdlpath]
                            else fbstat:=fbstat+[fbdirdlpath];
                            getdirspec(s2);
                            if ((exist(s1)) and (not exist(s2))) then begin
                              print('Old DIR filename: '+s1);
                              print('New DIR filename: '+s2);
                              nl;
                              if pynq('Move old DIR file to new directory? ') then begin
                                nl;
                                sprompt(#3#5+'Progress: ');
                                movefile(ok,nospace,TRUE,s1,s2);
                                if (nospace) then
                                if (ok) then nl;
                                if (not ok) then begin
                                  sprompt(#3#7+'Move failed');
                                  if (not nospace) then nl else
                                    sprompt(' - Insuffient space on drive '+
                                            chr(exdrv(s2)+64)+':');
                                  sprint('!');
                                end;
                              end;
                            end;
                          end;
                      'N':if (fbnoratio in fbstat) then
                            fbstat:=fbstat-[fbnoratio]
                          else fbstat:=fbstat+[fbnoratio];
                      'U':if (fbunhidden in fbstat) then
                            fbstat:=fbstat-[fbunhidden]
                          else fbstat:=fbstat+[fbunhidden];
                    end;
                  end;
              '[':if (ii>0) then dec(ii) else c:=' ';
              ']':if (ii<maxulb) then inc(ii) else c:=' ';
              'F':if (ii<>0) then ii:=0 else c:=' ';
              'J':begin
                    prt('Jump to entry: ');
                    input(s,3);
                    if (value(s)>=0) and (value(s)<=maxulb) then ii:=value(s) else c:=' ';
                  end;
              'L':if (ii<>maxulb) then ii:=maxulb else c:=' ';
            end;
          until (pos(c,'Q[]FJL')<>0) or (hangup);
        if (changed) then begin
          seek(ulf,xloaded); write(ulf,memuboard);
          changed:=FALSE;
        end;
      end;
    end;
  end;

  procedure dlbepi;
  var i,j:integer;
  begin
    prt('Move which file base? (0-'+cstr(maxulb)+') : '); inu(i);
    if ((not badini) and (i>=0) and (i<=maxulb)) then begin
      prt('Move before which file base? (0-'+cstr(maxulb+1)+') : ');
      inu(j);
      if ((not badini) and (j>=0) and (j<=maxulb+1) and
          (j<>i) and (j<>i+1)) then begin
        nl;
        dlbep(i,j);
      end;
    end;
  end;

  function rnr(b:boolean):astr;
  begin
    if b then rnr:='Active' else rnr:='';
  end;

  function atyp(i:integer):astr;
  begin
    if i in [1..6] then atyp:=mln(cstr(i)+'-'+systat.filearcinfo[i].ext,5)
      else atyp:='None ';
  end;

begin
  c:=#0;
  reset(ulf);
  repeat
    if (c<>'?') then begin
      cls; done:=FALSE; abort:=FALSE;
      case ltype of

(*
                                                                            :
NNN:File base name           :Flags:ACS       :UL ACS    :Name ACS  :Maxf:Dep
===:=========================:=====:==========:==========:==========:====:===

NNN:File base name  :Filename:Download path          :Upload path
===:================:========:=======================:=======================

NNN:File base name                     :Arc/Cmt-type:P-Index:Password
===:===================================:===:========:=======:================
*)
        1:begin
            printacr(#3#0+'NNN'+sepr2+'File base name           '+sepr2+
                     'Flags'+sepr2+'ACS       '+sepr2+'UL ACS    '+sepr2+
                     'Name ACS  '+sepr2+'Maxf'+sepr2+'Dep',abort,next);
            printacr(#3#4+'===:=========================:=====:==========:==========:==========:====:===',abort,next);
          end;
        2:begin
            printacr(#3#0+'NNN'+sepr2+'File base name  '+sepr2+'Filename'+
                     sepr2+'Download path           '+sepr2+'Upload path',abort,next);
            printacr(#3#4+'===:================:========:========================:=======================',abort,next);
          end;
        3:begin
            printacr(#3#0+'NNN'+sepr2+'File base name                      '+
                     sepr2+'Arc/Cmt-type'+sepr2+'P-Index'+sepr2+'Password',abort,next);
            printacr(#3#4+'===:====================================:===:========:=======:================',abort,next);
          end;
      end;
      ii:=0;
      while (ii<=maxulb) and (not abort) and (not hangup) do begin
        seek(ulf,ii); read(ulf,memuboard);
        with memuboard do
          case ltype of
            1:printacr(#3#0+mn(ii,3)+' '+#3#5+mln(name,25)+' '+
                       #3#3+flagstate(memuboard)+#3#9+' '+mln(acs,10)+' '+
                       mln(ulacs,10)+' '+mln(nameacs,10)+' '+
                       #3#3+mn(maxfiles,4)+' '+mn(fbdepth,3),abort,next);
            2:printacr(#3#0+mn(ii,3)+' '+#3#5+mln(name,16)+' '+
                       #3#3+mln(filename,8)+' '+mln(dlpath,24)+' '+
                       mln(ulpath,23),abort,next);
            3:printacr(#3#0+mn(ii,3)+' '+#3#5+mln(name,36)+' '+
                       #3#9+mn(arctype,3)+' '+mn(cmttype,3)+'      '+
                       mn(permindx,7)+' '+password,abort,next);
          end;
        inc(ii);
      end;
      readuboard:=-1; loaduboard(0);
    end;
    nl;
    prt('File base editor (?=help) : ');
    onek(c,'QDIMPT?'^M);
    case c of
      '?':begin
            nl;
            print('<CR>Redisplay screen');
            lcmds(12,3,'Delete base','Insert base');
            lcmds(12,3,'Modify base','Position base');
            lcmds(12,3,'Quit','Toggle display format');
          end;
      'Q':done:=TRUE;
      'D':begin
            prt('File base to delete? (0-'+cstr(maxulb)+') : '); inu(ii);
            if ((ii>=0) and (ii<=maxulb) and (not badini)) then begin
              readuboard:=-1; loaduboard(ii);
              if (fbdirdlpath in memuboard.fbstat) then s0:=memuboard.dlpath
                else s0:=systat.gfilepath;
              {rcg11182000 lowercased this ".DIR" string...}
              s0:=s0+memuboard.filename+'.dir';
              nl; sprint('File base: '+#3#5+memuboard.name);
              if pynq('Delete this? ') then begin
                sysoplog('* Deleted file base: '+memuboard.name);
                dlbed(ii);
                if pynq('Delete directory file? ') then begin
                  writeln; writeln('Deleting: '+s0);
                  {$I-} assign(f,s0); reset(f); close(f); {$I+}
                  if (ioresult=0) then erase(f);
                  pausescr;
                end;
              end;
            end;
          end;
      'I':begin
            prt('File base to insert before? (0-'+cstr(maxulb+1)+') : '); inu(ii);
            if ((ii>=0) and (ii<=maxulb+1)) then begin
              sysoplog('* Inserted new file base');
              dlbei(ii);
            end;
          end;
      'M':dlbem;
      'P':dlbepi;
      'T':ltype:=ltype mod 3+1;   { toggle between 1, 2 & 3 }
    end;
  until (done) or (hangup);
  close(ulf);
  if ((systat.compressbases) and (useron)) then newcomptables;

  if ((fileboard<0) or (fileboard>maxulb)) then fileboard:=1;
  readuboard:=-1; loaduboard(fileboard);
end;

end.