Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/SYSPC22.ZIP/BULLET.PAS

Pascal/Delphi Source File | 1988-05-12 | 29.2 KB | 1,240 lines

overlay procedure bulletinmenu;

  procedure makeboard; forward;

  function sponsoron:boolean;
  begin
    sponsoron:=match(curboard.sponsor,unam)
  end;

  procedure clearorder (var bo:boardorder);
  var cnt:integer;
  begin
    for cnt:=0 to 255 do bo[cnt]:=cnt
  end;

  procedure carryout (var bo:boardorder);
  var u:userrec;
      cnt,un:integer;

    procedure doone;
    var cnt,q:integer;
        ns,a1,a2:set of byte;
    begin
      fillchar (ns,32,0);
      fillchar (a1,32,0);
      fillchar (a2,32,0);
      for cnt:=0 to 255 do begin
        q:=bo[cnt];
        if q<>cnt then begin
          if q in u.newscanconfig then ns:=ns+[cnt];
          if q in u.access1 then a1:=a1+[cnt];
          if q in u.access2 then a2:=a2+[cnt]
        end
      end;
      u.newscanconfig:=ns;
      u.access1:=a1;
      u.access2:=a2;
      seek (ufile,un);
      write (ufile,u)
    end;

  begin
    for cnt:=0 to 255 do if bo[cnt]=cnt then if cnt=255 then exit;
    write (^B'*> Adjusting user access flags...');
    seek (ufile,1);
    for un:=1 to numusers do begin
      if (un mod 10)=0 then write (' ',un);
      read (ufile,u);
      if length(u.handle)>0 then doone
    end;
    writeln ('Done <*');
  end;

  procedure switchboards (bnum1,bnum2:integer; var bo:boardorder);
  var bd1,bd2:boardrec;
      n1:integer;
  begin
    seekbdfile (bnum1);
    read (bdfile,bd1);
    seekbdfile (bnum2);
    read (bdfile,bd2);
    seekbdfile (bnum1);
    writebdfile (bd2);
    seekbdfile (bnum2);
    writebdfile (bd1);
    n1:=bo[bnum1];
    bo[bnum1]:=bo[bnum2];
    bo[bnum2]:=n1
  end;

  procedure setfirstboard; forward;

  procedure seekbfile (n:integer);
  begin
    seek (bfile,n-1); che
  end;

  function numbuls:integer;
  begin
    numbuls:=filesize(bfile)
  end;

  procedure assignbfile;
  begin
    assign (bfile,boarddir+curboardname+'.BUL')
  end;

  procedure formatbfile;
  begin
    assignbfile;
    rewrite (bfile);
    curboardnum:=searchboard(curboardname);
    if curboardnum=-1 then begin
      curboardnum:=filesize(bdfile);
      fillchar (curboard,sizeof(curboard),0);
      writecurboard
    end
  end;

  procedure openbfile;
  var b:bulrec;
      i:integer;
  begin
    curboardnum:=searchboard (curboardname);
    if curboardnum=-1 then begin
      makeboard;
      exit
    end;
    close (bfile);
    assignbfile;
    reset (bfile);
    i:=ioresult;
    if ioresult<>0 then formatbfile;
    seekbdfile (curboardnum);
    read (bdfile,curboard);
  end;

  function boardexist(n:sstr):boolean;
  begin
    boardexist:=not (searchboard(n)=-1)
  end;

  procedure addbul (var b:bulrec);
  begin
    seekbfile (numbuls+1);
    write (bfile,b)
  end;

  procedure delbul (bn:integer; deltext:boolean);
  var c,un:integer;
      b:bulrec;
      u:userrec;
  begin
    if (bn<1) or (bn>numbuls) then exit;
    seekbfile (bn);
    read (bfile,b);
    if deltext then deletetext (b.line);
    for c:=bn to numbuls-1 do begin
      seekbfile (c+1);
      read (bfile,b);
      seekbfile (c);
      write (bfile,b)
    end;
    seekbfile (numbuls);
    truncate (bfile)
  end;

  procedure delboard (bdn:integer);
  var bd1:boardrec;
      cnt,nbds:integer;
      bo:boardorder;
  begin
    clearorder (bo);
    nbds:=filesize(bdfile)-1;
    if nbds=0 then begin
      close (bdfile);
      rewrite (bdfile);
      exit
    end;
    for cnt:=bdn to nbds-1 do begin
      seekbdfile (cnt+1);
      read (bdfile,bd1);
      seekbdfile (cnt);
      writebdfile (bd1);
      bo[cnt]:=cnt+1
    end;
    seek (bdfile,nbds);
    truncate (bdfile);
    seek (bifile,nbds);
    truncate (bifile);
    carryout (bo)
  end;



var q,curbul:integer;
    b:bulrec;

  function queryaccess:accesstype;
  begin
    queryaccess:=getuseraccflag (urec,curboardnum)
  end;

  procedure autodelete;
  var cnt:integer;
  begin
    write ('*> Auto-delete active...Wait...');
    for cnt:=6 downto 2 do delbul (cnt,true);
    write (^H^H^H^H^H^H,'Continue <*');
  end;

  procedure postbul;
  var l:integer;
      m:message;
      b:bulrec;
  begin
    if ulvl<postlevel then begin
      reqlevel(postlevel);
      exit
    end;
    feed:=false;
    sendtoistru:=true;
    b.ranon:=false;
    if reply=1 then sendtoistru:=false;
    if reply=1 then l:=editor(m,false) else l:=editor(m,true);
    sendtoistru:=false;
    if l>=0 then
      begin
       urec.nbu:=urec.nbu+1;
        writeurec;
        if messages>32760 then messageS:=0;
        messages:=messages+1;
        newposts:=newposts+1;
        b.anon:=m.anon;
        b.title:=m.title;
        b.leftda:=datestr;
        b.leftti:=timestr;
        b.leftby:=unam;
        b.line:=l;
        b.senttol:=senttol;
        If Reply=0 then b.ranon:=false;
        if reply=0 then replyanon:=false;
        b.plevel:=ulvl;
        if reply=1 then begin
        b.title:='R) '+replyt;
        b.senttol:=replyguy;
        if canon then b.senttol:=anonymousstr;
        b.anon:=m.anon;
        b.ranon:=replyanon;
        end;
        addbul (b);
        with curboard do
          if autodel<=numbuls then autodelete
      end
  end;



  function checkcurbul:boolean;
  begin
    if (curbul<1) or (curbul>numbuls) then begin
      checkcurbul:=false;
      curbul:=0
    end else checkcurbul:=true
  end;

  procedure getbrec;
  begin
    if checkcurbul then begin
      seekbfile (curbul);
      read (bfile,b); che
    end
  end;

  procedure getbnum (txt:mstr);
  var q:boolean;
  begin
    if length(input)>1
      then curbul:=valu(copy(input,2,255))
      else begin
        writestr (^M'Bulletin to '+txt+':');
        curbul:=valu(input)
      end;
    q:=checkcurbul
  end;

  procedure readcurbul;
  var q:anystr;
      t:sstr;
      cnt:integer;
  begin
    if checkcurbul then begin
      getbrec;
    write (^B'Bulletin: ['^S,curbul);
    ansireset;
    write ('] of ['^S,numbuls);
    ansireset;
    writeln (']');
    write   ('From : [');
    write (^S);
      if b.anon
        then
          begin
            canon:=true;
            write (anonymousstr);
            ansireset;
            if issysop then writeln ('] (Actually by: '+b.leftby+')') else
            writeln (']');
          end
        else begin
      canon:=false;
      write (^S,b.leftby);
      ansireset;
      writeln (']');
      end;
      write ('To   : ['^S,b.senttol);
      ansireset;
      writeln (']');
      write ('Title: ['^S,b.title);
      ansireset;
      writeln (']');
      if issysop or (not b.anon)
  then begin
        write('When : ['^S,b.leftda);
        ansireset;
        write('] at ['^S,b.leftti);
        ansireset;
        writeln (']');
        end;
      if break then exit;
      printtext (b.line)
    end
  end;

    procedure sendbreply;
  begin
    if checkcurbul then begin
      getbrec;
      sendtoistru:=false;
      reply:=1;
      replyt:=b.title;
      replyguy:=b.leftby;
      replyanon:=b.anon;
      postbul;
      reply:=0;
    end;
  end;

  procedure killbul(f:integer);
  var un:integer;
      u:userrec;
  begin
    writehdr ('*> Bulletin Deletion <*');
    if f<>1 then getbnum ('delete');
    if not checkcurbul then exit;
    getbrec;
    if (not match(b.leftby,unam)) and (not issysop) and (not sponsoron)
      then begin
        writeln ('You didn''t post that!');
        exit
      end;
    writeln ('Title:   [',b.title,']');
    writeln;
    writestr ('Delete this? *');
    if not yes then exit;
    un:=lookupuser (b.leftby);
    if un<>0 then begin
      writeurec;
      seek (ufile,un);
      read (ufile,u);
      u.nbu:=u.nbu-1;
      seek (ufile,un);
      write (ufile,u);
      readurec
    end;
    delbul (curbul,true);
    writeln ('*> Bulletin deleted. <*');
    writelog (4,5,b.title)
  end;

    procedure readbul;
 var r1,r2,max:integer;
 begin

  Writeln(^B' '); writeln ('Read messages 1-',numbuls);
  parserange (numbuls,r1,r2);

    if (r1>r2) then exit;
    if (r1<1) then exit;
            max:=r1;

    repeat
    write(^B);
    if ansi then ansicls;
    if xpressed then begin
                     writeln (^B'*> Read Aborted <*');exit;end;
    if max<1 then max:=1;
    curbul:=max;
    if (curbul>numbuls) then exit;
    readcurbul;
    writeln (^M'Read Command:');
    writestr ('[CR] Next [E]nter [P]revious [R]eply [D]elete [A]gain [Q]uit : *');
    case upcase(input[1]) of
    'R':sendbreply;
    'A':max:=max-1;
    'D':begin
          killbul(1);
          max:=max-1;
        end;
    'P':max:=max-2;
    'Q':exit;
    'E':postbul;
       end;
         max:=max+1;
   until 0=1;
  end;

  procedure readnextbul;
  var t:integer;
  begin
    t:=curbul;
    curbul:=curbul+1;
    readcurbul;
    if curbul=0 then curbul:=t
  end;

  procedure readnum (n:integer);
  begin
    curbul:=n;
    readcurbul
  end;

  function haveaccess (n:integer):boolean;
  var a:accesstype;
  begin
    curboardnum:=n;
    seekbdfile (n);
    read (bdfile,curboard);
    a:=queryaccess;
    if a=bylevel
      then haveaccess:=ulvl>=curboard.level
      else haveaccess:=a=letin
  end;

  procedure makeboard;
  begin
    formatbfile;

    with curboard do begin
      shortname:=curboardname;
      buflen:=30;
      writestr (^M'%> Board name: &');
      boardname:=input;
      buflen:=30;
      writestr ('%> Sponsor (C/R for '+unam+'):');
      if input='' then input:=unam;
      sponsor:=input;
      writestr ('%> Minimum level for entry:');
      level:=valu(input);
      writestr ('%> Autodelete after:');
      autodel:=valu(input);
      if autodel<10 then begin
        writeln ('Must be at least 10!');
        autodel:=10
      end;
      setallflags (curboardnum,bylevel);
      writecurboard;
      writeln ('%> Board created. <*');
      writelog (4,4,boardname+' ['+shortname+']')
    end
  end;

  procedure setactive (nn:sstr);

    procedure doswitch;
    begin
      openbfile;
      curbul:=0;
      with curboard do begin
       if ansi and urec.windows then begin
        ansicls;
        windowit (69,6,1,2);
        movexy (4,3);
        writeln ('Area          : '^S,shortname);
        movexy (4,4);
        writeln ('Name          : '^S,boardname);
        movexy (4,5);
        writeln ('Sponsor       : '^S,sponsor);
        movexy (4,6);
        writeln ('Bulletins     : '^S,numbuls);
        movexy (1,9);
        end
        else begin
        write (^M'*> Sub-board: ['^S,boardname);
        ansireset;
        writeln (']');
        write ('*> Sponsor:   ['^S,sponsor);
        ansireset;
        writeln (']');
        write   ('*> Bulletins: ['^S,numbuls);
        ansireset;
        writeln (']',^M)
        end;
      end;
    end;


    procedure tryswitch;
    var n,s:integer;

      procedure denyaccess;
      var b:bulrec;
      begin
        reqlevel (curboard.level);
        setfirstboard
      end;

    begin
      curboardname:=nn;
      curboardnum:=searchboard(nn);
      if haveaccess(curboardnum)
        then doswitch
        else denyaccess
    end;

  var b:bulrec;
  begin
    curbul:=0;
    close (bfile);
    curboardname:=nn;
    if boardexist(nn) then tryswitch else begin
      writeln ('*> Error : No such board: [',curboardname,']');
      if issysop
        then
          begin
            writestr (^M'%> Create one (Y/N)? *');
            if yes
              then
                begin
                  makeboard;
                  setactive (curboardname)
                end
              else setfirstboard
          end
        else setfirstboard
    end
  end;

  function validbname (n:sstr):boolean;
  var cnt:integer;
  begin
    validbname:=false;
    if (length(n)=0) or (length(n)>8) then exit;
    for cnt:=1 to length(n) do
      if not (upcase(n[cnt]) in ['0'..'9','A'..'Z']) then exit;
    validbname:=true
  end;

  procedure listboards;
  var cnt,oldcurboard:integer;
      printed:boolean;
  begin
    oldcurboard:=curboardnum;
    writeln (^M'[Number]   [Name]                      [Level]'^M);
    if break then exit;
    for cnt:=0 to filesize(bdfile)-1 do
      if haveaccess(cnt) then
        with curboard do begin
          write ('[',shortname:8,'] ');
          tab ('['+boardname,26);
          writeln ('] [',level:5,']');

          if break then exit
        end;
    curboardnum:=oldcurboard;
    seekbdfile (curboardnum);
    read (bdfile,curboard)
  end;

  procedure activeboard;
  begin
    if length(input)>1
      then input:=copy(input,2,255)
      else begin
        listboards;
        repeat
          writestr (^M^M'Board number [?=List]:');
          if input='?' then listboards
        until (input<>'?') or hungupon;
        end;
    if hungupon or (length(input)=0) then exit;
    if input[1]='*' then input:=copy(input,2,255);
    if validbname(input)
      then setactive (input)
      else
        begin
          writeln (^M'*> Invalid board name! <*');
          setfirstboard
        end
  end;

  procedure setfirstboard; { FORWARD }
  begin
    if filesize(bdfile)=0 then exit;
    if not haveaccess(0)
      then error ('*> User can''t access first board','','');
    seek (bdfile,0);
    read (bdfile,curboard);
    curboardname:=curboard.shortname;
    curboardnum:=0;
    curbul:=0;
    openbfile;
    if (urec.windows) and (ansi) then
    with curboard do begin
     ansicls;
        windowit (69,6,1,2);
        movexy (4,3);
        writeln ('Area          : '^S,shortname);
        movexy (4,4);
        writeln ('Name          : '^S,boardname);
        movexy (4,5);
        writeln ('Sponsor       : '^S,sponsor);
        movexy (4,6);
        writeln ('Bulletins     : '^S,numbuls);
        movexy (1,9);
    end;
  end;

  procedure listbuls;
  var cnt,bn:integer;
      q:boolean;
  begin
    if length(input)>1 then begin
      curbul:=valu(copy(input,2,255));
      q:=checkcurbul
    end;
    if curbul=0
      then
        begin
          writestr (^M'List titles starting at #*');
          curbul:=valu(input)
        end
      else
        if length(input)>1
          then curbul:=valu(input)
          else curbul:=curbul+10;
    if not checkcurbul then curbul:=1;
    writeln ('Titles:'^M);
    for cnt:=0 to 9 do
      begin
        bn:=curbul+cnt;
        if (bn>0) and (bn<=numbuls) then
          begin
            seekbfile (bn);
            read (bfile,b);
            write (bn,'. ',b.title,' by ');
            if not b.anon then writeln (b.leftby) else writeln (anonymousstr);
            if break then exit
          end
      end
  end;



  procedure editbul;
  var me:message;
  begin
    getbnum ('edit');
    if not checkcurbul then exit;
    getbrec;
    if (not match(b.leftby,unam)) and (not issysop) and (not sponsoron)
      then begin
        writeln ('You didn''t post that!');
        exit
      end;
    reloadtext (b.line,me);
    me.title:=b.title;
    me.anon:=b.anon;
    if reedit (me,true) then begin
      writelog (4,6,b.title);
      deletetext (b.line);
      b.line:=maketext (me);
      if b.line<0 then begin
        write (^M'*> Deleting bulletin...');
        writeln ('Done <*');
        delbul (curbul,false)
      end else begin
        seekbfile (curbul);
        write (bfile,b)
      end
    end
  end;

  procedure boardsponsor;

    procedure getbgen (txt:mstr; var q);
    var s:lstr absolute q;
    begin
      writeln (^B'Current ',txt,': ',s);
      buflen:=30;
      writestr ('Enter new '+txt+':');
      if length(input)>0 then s:=input
    end;

    procedure getbint (txt:mstr; var i:integer);
    var a:anystr;
    begin
      a:=strr(i);
      getbgen (txt,a);
      i:=valu(a);
      writecurboard
    end;

    procedure getbstr (txt:mstr; var q);
    begin
      getbgen (txt,q);
      writecurboard
    end;

    procedure setacc (ac:accesstype; un:integer);
    var u:userrec;
    begin
      seek (ufile,un);
      read (ufile,u);
      setuseraccflag (u,curboardnum,ac);
      seek (ufile,un);
      write (ufile,u)
    end;

    function queryacc (un:integer):accesstype;
    var u:userrec;
    begin
      seek (ufile,un);
      read (ufile,u);
      queryacc:=getuseraccflag (u,curboardnum)
    end;

    overlay procedure setnameaccess;
    var un,n:integer;
        ac:accesstype;
        q,unm:mstr;
    begin
      writestr (^M'Change access for user:');
      un:=lookupuser(input);
      if un=0 then begin
        writeln ('No such user!');
        exit
      end;
      unm:=input;
      ac:=queryacc(un);
      writeln (^B^M'Current access: ',accessstr[ac]);
      getacflag (ac,q);
      if ac=invalid then exit;
      if un=unum then writeurec;
      setacc (ac,un);
      if un=unum then readurec;
      case ac of
        letin:n:=1;
        keepout:n:=2;
        bylevel:n:=3
      end;
      writelog (5,n,unm)
    end;

    overlay procedure setallaccess;
    var cnt:integer;
        ac:accesstype;
        q:mstr;
    begin
      writehdr ('Set Everyone''s Access');
      getacflag (ac,q);
      if ac=invalid then exit;
      writeurec;
      setallflags (curboardnum,ac);
      readurec;
      writeln ('Done.');
      writelog (5,4,accessstr[ac])
    end;

    overlay procedure listaccess;

      procedure listacc (all:boolean);
      var cnt:integer;
          a:accesstype;
          u:userrec;

        procedure writeuser;
        begin
          if all
            then
              begin
                tab (u.handle,30);
                if a=bylevel
                  then writeln ('Level='+strr(u.level))
                  else writeln ('Let in')
              end
            else writeln (u.handle)
        end;

      begin
        seek (ufile,1);
        for cnt:=1 to numusers do begin
          read (ufile,u);
          a:=getuseraccflag (u,curboardnum);
          case a of
            letin:writeuser;
            bylevel:if all and (u.level>=curboard.level) then writeuser
          end;
          if break then exit
        end
      end;

    begin
      writestr (
'List A)ll users who have access, or only those with S)pecial access? *');
      if length(input)=0 then exit;
      case upcase(input[1]) of
        'A':listacc (true);
        'S':listacc (false)
      end
    end;

    overlay procedure getblevel;
    var b:bulrec;
    begin
      getbint ('level',curboard.level);
      writelog (5,12,strr(curboard.level))
    end;

    overlay procedure getautodel;
    var b:bulrec;
    begin
      with curboard do begin
        getbint ('auto-delete',autodel);
        if autodel<10
          then
            begin
              writeln (^B'*> Illegal Setting. Value at 10 <*');
              autodel:=numbuls+1;
              if autodel<10 then autodel:=10;
              writeln (^B'Setting autodelete to ',autodel);
              writecurboard
            end
          else
            if autodel<=numbuls
              then
                begin
                  writeln (^B'*> Deleting bulletins...');
                  while autodel<=numbuls do delbul (2,true)
                end
      end;
      writelog (5,11,strr(curboard.autodel))
    end;



    overlay procedure movebulletin;
    var b:bulrec;
        tcb:boardrec;
        tcbn,dbn,bnum:integer;
        tcbname,dbname:sstr;
    begin
      writehdr ('Bulletin Move');
      getbnum ('move');
      if not checkcurbul then exit;
      bnum:=curbul;
      seekbfile (bnum);
      read (bfile,b);
      writestr ('Move "'+b.title+'" posted by '+b.leftby+
        ' to which board? *');
      if length(input)=0 then exit;
      tcbname:=curboardname;
      dbname:=input;
      dbn:=searchboard(dbname);
      if dbn=-1 then begin
        writeln ('No such board!');
        exit
      end;
      write ('*> Moving...');
      delbul (bnum,false);
      close (bfile);
      curboardname:=dbname;
      openbfile;
      addbul (b);
      close (bfile);
      curboardname:=tcbname;
      openbfile;
      writelog (5,13,b.title);
      writeln (^B'Done <*')
    end;



    overlay procedure setsponsor;
    var un:integer;
        b:bulrec;
    begin
      writestr ('%> New sponsor:');
      if length(input)=0 then exit;
      un:=lookupuser (input);
      if un=0
        then writeln ('%> No such user. <%')
        else
          begin
            curboard.sponsor:=input;
            writelog (5,8,input);
            writecurboard
          end
    end;

    overlay procedure renameboard;
    var sn:sstr;
        nfp,nbf,nff:lstr;
        qf:file;
        d:integer;
    begin
      getbstr ('board name',curboard.boardname);
      sn:=curboard.shortname;
      getbgen ('access name/number',sn);
      writelog (5,5,curboard.boardname+' ['+sn+']');
      if match(sn,curboard.shortname) then exit;
      if not validbname(sn) then begin
        writeln ('Invalid board name!');
        exit
      end;
      if boardexist(sn) then begin
        writeln ('*> Board already exists <*');
        exit
      end;
      curboard.shortname:=sn;
      writecurboard;
      close (bfile);
      nfp:=boarddir+sn+'.';
      nbf:=nfp+'BUL';
      nff:=nfp+'FIL';
      assign (qf,nbf);
      erase (qf);
      d:=ioresult;
      assign (qf,nff);
      erase (qf);
      d:=ioresult;
      rename (bfile,nbf);
      setfirstboard;
      q:=9
    end;

    overlay procedure killboard;
    var cnt:integer;
        f:file;
        fr:filerec;
        bd:boardrec;
    begin
      writestr ('*> Kill board:  Are you sure? *');
      if not yes then exit;
      writelog (5,10,'');
      writeln (^B^M'*> Deleting messages... <*');
      for cnt:=numbuls downto 1 do
        begin
          delbul(cnt,true);
          write (cnt,' ')
        end;
      writeln (^B^M'*> Deleting sub-board files... <*');
      close (bfile);
      assignbfile;
      erase (bfile);
      if ioresult<>0 then writeln (^B'Error erasing board file.');
      writeln (^M'*> Removing sub-board... <*');
      delboard (curboardnum);
      writeln (^B'*> Sub-board erased <*');
      setfirstboard;
      q:=9
    end;

    overlay procedure sortboards;
    var cnt,mark,temp:integer;
        bd1,bd2:boardrec;
        bn1,bn2:sstr;
        bo:boardorder;
    begin
      writestr ('Sort sub-boards: Are you sure? *');
      if not yes then exit;
      clearorder (bo);
      mark:=filesize(bdfile)-1;
      repeat
        if mark<>0 then begin
          temp:=mark;
          mark:=0;
          for cnt:=0 to temp-1 do begin
            seek (bifile,cnt);
            read (bifile,bn1);
            read (bifile,bn2);
            if upstring(bn1)>upstring(bn2) then begin
              mark:=cnt;
              switchboards (cnt,cnt+1,bo)
            end
          end
        end
      until mark=0;
      carryout (bo);
      writelog (5,16,'');
      setfirstboard;
      q:=9
    end;

    overlay procedure orderboards;
    var numb,curb,newb:integer;
        bo:boardorder;
    label exit;
    begin
      clearorder (bo);
      writehdr ('Re-order sub-boards');
      numb:=filesize (bdfile);
      thereare (numb,'sub-board','sub-boards');
      for curb:=0 to numb-2 do begin
        repeat
          writestr ('New board #'+strr(curb+1)+' [?=List, CR to quit]:');
          if length(input)=0 then goto exit;
          if input='?'
            then
              begin
                listboards;
                newb:=-1
              end
            else
              begin
                newb:=searchboard(input);
                if newb<0 then writeln ('Not found!  Please re-enter...')
              end
        until (newb>=0);
        switchboards (curb,newb,bo)
      end;
      exit:
      carryout (bo);
      writelog (5,14,'');
      q:=9;
      setfirstboard
    end;



  begin
    if (not sponsoron) and (not issysop) then begin
      writeln ('Nice try, except you aren''t the sponsor.');
      exit
    end;
    writelog (4,3,curboard.boardname+' ['+curboard.shortname+']');
    repeat
      q:=menu ('Sponsor','SPONSOR','DLSTMWUEQRKC@BO@VA@H');
      case q of
        1:getautodel;
        2:getblevel;
        3:setsponsor;
        4:;
        5:;
        6:;
        7:setnameaccess;
        8:setallaccess;
        10:renameboard;
        11:killboard;
        12:sortboards;
        13:movebulletin;
        14:orderboards;
        15:listaccess;
        16:;
        17:;
      end
    until (q=9) or hungupon
  end;

  var beenaborted:boolean;

  function aborted:boolean;
  begin
    if beenaborted then begin
      aborted:=true;
      exit
    end;
    aborted:=xpressed or hungupon;
    if xpressed then begin
      beenaborted:=true;
      writeln (^B'*> NewScan Aborted! <*')
    end
  end;

  procedure newscanboard;

  var newmsgs:boolean;

  begin
    beenaborted:=false;
    newmsgs:=false;
    for curbul:=1 to numbuls do begin
      getbrec;
  if later (b.leftda,b.leftti,urec.ldmns,urec.ltmns) or
     later (b.leftda,b.leftti,lastonda,lastonti) then begin
        readnum (curbul);
   repeat
   writeln (^M'NewScan Command:');
   writestr ('[CR] Next [E]nter [R]eply [D]elete [A]gain [S]kip Area [Q]uit: *');
    ns:=true;
    if length(input)=0 then input:=' ';
    input:=upcase(input[1]);
    if (input='R') then sendbreply else
    if (input='D') then killbul(1);
    if (input='E') then postbul;
    if (input='A') then readnum (curbul);
    if (input='S') then exit;
    if (input='Q') then begin
    dogit:=true;
    exit;
    end;
      newmsgs:=true;
      writeln;
    until input<>'A';
      end;

      if aborted then exit
    end;

    if (postprompts in urec.config) and newmsgs and (ulvl>=postlevel)
      then begin
        writestr (^M'Post now? *');
        writeln;
        if yes then postbul
      end
  end;

  procedure newscanall;
  var cb:integer;
  begin
    dogit:=false;
    beenaborted:=false;
    writehdr ('*> Newscanning <*');
    if aborted then exit;
    for cb:=0 to filesize(bdfile)-1 do begin
      if aborted then exit;
      if dogit then exit;
      if haveaccess(cb) and (not (cb in urec.newscanconfig)) then begin
        curboardname:=curboard.shortname;
        openbfile;
        if aborted then exit;
        writeln (^B^M'*> Sect: ',curboard.boardname,'...'^M);
        ns:=true;
        if aborted then exit;
        newscanboard
      end
    end;
    writeln (^B^M'*> Newscan complete <*'^G);
    ns:=false;
    urec.lastmessages:=messages;
    urec.ldmns:=datestr;
    urec.ltmns:=timestr;
    writeurec;
    setfirstboard
  end;

  procedure noboards;
  begin
    writeln ('No sub-boards exist!');
    if not issysop then exit;
    writestr ('Create the first sub-board now? *');
    if not yes then exit;
    writestr ('Enter its access name/number:');
    if not validbname(input) then writeln (^B'Invalid board name!') else begin
      curboardname:=input;
      makeboard
    end
  end;

  procedure togglenewscan;
  begin
    write ('Newscan this board: ');
    if curboardnum in urec.newscanconfig
      then
        begin
          writeln ('Yes');
          urec.newscanconfig:=urec.newscanconfig-[curboardnum]
        end
      else
        begin
          writeln ('No');
          urec.newscanconfig:=urec.newscanconfig+[curboardnum]
        end
  end;

  procedure nextsubboard;
  var cb:integer;
      obn:sstr;
  begin
    obn:=curboardname;
    cb:=curboardnum;
    while cb<filesize(bdfile) do begin
      cb:=cb+1;
      if haveaccess (cb) then begin
        seek (bifile,cb);
        read (bifile,obn);
        setactive (obn);
        exit
      end
    end;
    writestr ('This is the last sub-board!');
    setactive (obn)
  end;

var boo:boolean;
label exit;
begin
  cursection:=bulletinsysop;
  openbdfile;
  if filesize(bdfile)=0 then begin
    noboards;
    if filesize(bdfile)=0 then begin
      closebdfile;
      goto exit
    end
  end;
  if not haveaccess(0)
    then
      begin
        writeln (^B'You do not have access to the first sub-board!');
        closebdfile;
        goto exit
      end;
  setfirstboard;
  repeat
    boo:=checkcurbul;

    with curboard do
      writeln (^M,'[',shortname,']:[',boardname,'] Message ',curbul,' of ',numbuls);
    if sponsoron or issysop
      then writeln ('%: Board sponsor commands');
    ns:=false;
    q:=menu ('Bulletin','BULLET','PRDFUKT*MQ#_%LNBAVCHES+');
    case q of
      1:postbul;
      2:readbul;
      3:;
      4,22:sendmailto (curboard.sponsor,false);
      5:;
      6:killbul(0);
      8,16,17:activeboard;
      7:listbuls;
      9:;
      12:if not hungupon then readnextbul;
      13:boardsponsor;
      14:;
      15:newscanall;
      18:newscanboard;
      19:togglenewscan;
      20:;
      21:editbul;
      23:nextsubboard;
      else if q<0 then readnum (-q)
    end
  until (q=10) or hungupon or (filesize(bdfile)=0);
  exit:
  close (bfile);
  closebdfile
end;