Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/FORUM25C.ZIP/BULLETIN.PAS

Pascal/Delphi Source File | 1989-02-07 | 30.5 KB | 1,217 lines

{$R-,S-,V-,B-,L- }
{$O+}

UNIT Bulletin;


{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}

INTERFACE

USES CRT,
     Gentypes,
     Configrt,
     Statret,
     Gensubs,
     Subs1,
     Subs2,
     Userret,
     Textret,
     Mainr1,
     Mainr2,
     Overret1,
     TopPost,       {    Keeps track of top ten posters  }
     Flags;


{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}

Procedure Bulletinmenu;

{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}

IMPLEMENTATION

{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}


{=============================================================================}

TYPE Newscan_modes = (Express,Extended);

VAR Scan_mode : Newscan_modes;
    Newscan_sub : BOOLEAN;

{=============================================================================}

Procedure bulletinmenu;
VAR q,
    Cur_bul,
    lastreadnum : INTEGER;
    Post        : Bulrec;
    Last_msg    : INTEGER;

{=============================================================================}

  Procedure makeboard; forward;
  Procedure setfirstboard; forward;

{=============================================================================}

  Function Sponsor_on : BOOLEAN;
  Begin
    Sponsor_on := Match(Curboard.Sponsor,Unam)
  End;

{=============================================================================}

  Procedure Clear_order(VAR bo : boardorder);
  VAR c1 : BYTE;
  Begin
    For c1 := 0 TO 255 DO bo[c1] := c1
  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 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;
      u.newscanconfig:=ns;
      u.access1:=a1;
      u.access2:=a2;
      seek (ufile,un);
      write (ufile,u)
    end;

  begin
    writeln (^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
  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 seekffile (n:integer);
  begin
    seek (ffile,n-1)
  end;

{=============================================================================}

  Function numfiles:integer;
  begin
    numfiles:=filesize (ffile)
  end;

{=============================================================================}

  Procedure assignffile;
  begin
    assign (ffile,boarddir+curboardname+'.FIL')
  end;

{=============================================================================}

  Procedure formatffile;
  begin
    close (ffile);
    assignffile;
    rewrite (ffile)
  end;

{=============================================================================}

  Procedure openffile;
  VAR f:filerec;
      i:integer;
  begin
    close (ffile);
    assignffile;
    reset (ffile);
    i:=ioresult;
    if i<>0 then formatffile
  end;

{=============================================================================}

  Procedure addfile (f:filerec);
  begin
    seekffile (numfiles+1);
    write (ffile,f)
  end;

{=============================================================================}

  Procedure delfile (fn:integer);
  VAR f:filerec;
      cnt:integer;
  begin
    for cnt:=fn to numfiles-1 do begin
      seekffile (cnt+1);
      read (ffile,f);
      seekffile (cnt);
      write (ffile,f)
    end;
    seekffile (numfiles);
    truncate (ffile)
  end;

{=============================================================================}

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

{=============================================================================}

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

{=============================================================================}

  Procedure getlastreadnum;
  VAR oldb:boolean;
      Post:bulrec;
      lr:word;
  begin
    lastreadnum:=numbuls;
    oldb:=false;
    lr:=urec.lastread[curboardnum];
    while (lastreadnum>0) and (not oldb) do begin
      seekbfile (lastreadnum);
      read (bfile,Post);
      oldb:=Post.id=lr;
      if not oldb then lastreadnum:=lastreadnum-1
    end
  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 Post: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;
    getlastreadnum;
    seekbdfile (curboardnum);
    read (bdfile,curboard);
    openffile
  end;

{=============================================================================}

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

{=============================================================================}

  Procedure addbul (VAR Post:bulrec);
  VAR b2:bulrec;
  begin
    if numbuls=0 then Post.id:=0 else begin
      seekbfile (numbuls);
      read (bfile,b2);
      Post.id:=b2.id+1
    end;
    seekbfile (numbuls+1);
    write (bfile,Post)
  end;

{=============================================================================}

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

{=============================================================================}

  Procedure getbrec;
  begin
    if checkcurbul then begin
      seekbfile (Cur_bul);
      read (bfile,Post); che
    end
  end;

{=============================================================================}

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

{=============================================================================}

  Procedure delboard (bdn:integer);
  VAR bd1:boardrec;
      cnt,nbds:integer;
      bo:boardorder;
  begin
    Clear_order(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;

{=============================================================================}

{$I UdAscii.Sub}

{=============================================================================}

  Procedure readcurbul;
  VAR q:anystr;
      t:sstr;
      cnt:integer;
  begin
    if checkcurbul then
      begin
        getbrec;
        If EightyCols in Urec.Config THEN
          Begin
            Tab(^B'[Sub board ] : '^S+Curboard.BoardName,45);
            Writeln(^B'[Number   ] : '^S,Cur_bul,' of ',numbuls);
            Tab(^B'[Title     ] : '^S+Copy(Post.title,1,28),45);
            if issysop or (not Post.anon) then
               writeln('[When     ] : '^S,datestr(Post.when),' at ',timestr(Post.when));
            q:='[Left by   ] : '^S;
            if Post.anon then
             begin
               q:=q+anonymousstr;
               if issysop then q:=q+' ('+Post.leftby+')'
             end
            else
             begin
              if Post.plevel=-1 then
                t:='unknown'
              else
                t:=strr(Post.plevel);
              q:=q+Post.leftby+' (Level '+t+')'
             end;
            Writeln(q);
          End
        ELSE
          Begin
            Writeln(^B'[Sub board ] : '^S+Curboard.BoardName,45);
            Writeln(^B'[Number    ] : '^S,Cur_bul,' of ',numbuls);
            writeln(^B'[Title     ] : '^S,Post.title);
            q:='[Left by  ] : '^S;
            if Post.anon then
             begin
               q:=q+anonymousstr;
               if issysop then q:=q+' ('+Post.leftby+')'
             end
            else
             begin
              if Post.plevel=-1 then
                t:='unknown'
              else
                t:=strr(Post.plevel);
              q:=q+Post.leftby+' (Level '+t+')'
             end;
            if issysop or (not Post.anon)
               then writeln ('[When     ] : '^S,datestr(Post.when),' at ',timestr(Post.when));
            writeln (q);
            if break then exit;
          End;
      printtext (Post.line)
    end;
    if Cur_bul>lastreadnum then begin
      lastreadnum:=Cur_bul;
      urec.lastread[curboardnum]:=Post.id
    end
  end;

{=============================================================================}

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

{=============================================================================}

  Procedure autodelete;
  VAR cnt:integer;
  begin
    writeln ('Erasing first five posts...');
    for cnt:=6 downto 2 do delbul (cnt,true)
  end;

{=============================================================================}

  Procedure postbul(Post_title : AnyStr);
  VAR l:integer;
      m:message;
      Post:bulrec;
  begin
    if ulvl<postlevel then begin
      reqlevel(postlevel);
      exit
    end;
    l:=editor(m,(Post_Title = ''));
    if l>=0 then
      begin
        Inc(urec.nbu);
        writeurec;
        Add_name(Unam,urec.nbu);
        Save_top_posters;
        Post.anon:=m.anon;
        If Post_Title = '' THEN
          Post.title:=m.title
        ELSE
          Post.Title := Post_Title;
        Post.when:=now;
        Post.leftby:=unam;
        Post.line:=l;
        Post.plevel:=ulvl;
        addbul (Post);
        newposts:=newposts+1;
        with curboard do
          if autodel<=numbuls then autodelete
      end
  end;

{=============================================================================}

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

{=============================================================================}

  Procedure readbul;
  begin
    getbnum ('read');
    readcurbul
  end;

{=============================================================================}

  Procedure readnextbul;
  VAR t:integer;
  begin
    t:=Cur_bul;
    Cur_bul:=Cur_bul+1;
    readcurbul;
    if Cur_bul=0 then Cur_bul:=t
  end;

{=============================================================================}

  Procedure readnum (n:integer);
  begin
    Cur_bul:=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;
    formatffile;
    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;
      Cur_bul:=0;
      with curboard do
        writeln (^M'[Sub-board ] : '^S,boardname,
                 ^M'[Sponsor   ] : '^S,sponsor,
                 ^M'[Bulletins ] : '^S,numbuls,
                 ^M'[Last read ] : '^S,lastreadnum,
                 ^M'[Files     ] : '^S,numfiles,^M)
    end;

    Procedure tryswitch;
    VAR n,s:integer;

      Procedure denyaccess;
      VAR Post:bulrec;
      begin
        reqlevel (curboard.level);
        setfirstboard
      end;

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

  VAR Post:bulrec;
  begin
    Cur_bul:=0;
    close (bfile);
    close (ffile);
    curboardname:=nn;
    if boardexist(nn) then tryswitch else begin
      writeln ('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
          tab (shortname,9);
          tab (boardname,26);
          writeln (level);
          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
        repeat
          writestr (^M^M'Board number [?=List]:');
          if input='?' then listboards
        until (input<>'?') or hungupon;
    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;
  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;
    Cur_bul := 0;
    openbfile
  End;

{=============================================================================}

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

{=============================================================================}

  Procedure killbul;
  VAR un:integer;
      u:userrec;
  begin
    writehdr ('Bulletin Deletion');
    getbnum ('delete');
    if not checkcurbul then exit;
    getbrec;
    if (not match(Post.leftby,unam)) and (not issysop) and (not Sponsor_on)
      then begin
        writeln ('You didn''t post that!');
        exit
      end;
    writeln ('Title:   ',Post.title,
             ^M'Left by: ',Post.leftby,^M^M);
    writestr ('Delete this? *');
    if not yes then exit;
    un:=lookupuser (Post.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;
      Delete_one_post(Post.Leftby,u.nbu);
      Save_top_posters;
    end;
    delbul (Cur_bul,true);
    writeln ('Bulletin deleted.');
    writelog (4,5,Post.title)
  end;

{=============================================================================}

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

{=============================================================================}

  Procedure sendbreply;
  begin
    if checkcurbul then begin
      getbrec;
      sendmailto (LookUpUser(Post.leftby),Post.anon)
    end else begin
      getbnum ('reply to');
      if checkcurbul then sendbreply
    end
  end;

{=============================================================================}

  Procedure listfiles;
  VAR cnt,r1,r2,nfiles:integer;
      f:filerec;
  begin
    nfiles:=numfiles;
    thereare (nfiles,'file','files');
    if nfiles=0 then exit;
    parserange (nfiles,r1,r2);
    if r1=0 then exit;
    for cnt:=r1 to r2 do begin
      seekffile (cnt);
      read (ffile,f); che;
      writeln (cnt,'. ',f.descrip);
      if break then exit
    end
  end;

{=============================================================================}

  Function getfilenumber (txt:lstr):integer;
  VAR fn:integer;
      gotten:boolean;
  begin
    getfilenumber:=0;
    input:=copy(input,2,255);
    if length(input)=0 then
      repeat
        gotten:=true;
        writestr (^M'File number to '+txt+' [?=List]:');
        if input='?' then
          begin
            writeln;
            listfiles;
            writeln;
            gotten:=false
          end
      until gotten;
    fn:=valu(input);
    if (fn<1) or (fn>numfiles) then fn:=0;
    getfilenumber:=fn
  end;

{=============================================================================}

  Procedure downloadfile;
  VAR fn:integer;
  begin
    fn:=getfilenumber ('download');
    if fn<>0 then
      begin
        sendfile (fn);
        urec.ndn:=urec.ndn+1
      end;
  end;

{=============================================================================}

  Procedure uploadfile;
  VAR f:filerec;
  begin
    writestr ('Describe the file'+^M+'=> *');
    if length(input)<>0 then begin
      f.descrip:=input;
      receivefile (f);
      urec.nup:=urec.nup+1
    end
  end;

{=============================================================================}

{$I BSponsr.pas}

{=============================================================================}

  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;

{=============================================================================}

Function Num_new_Bulletins(B_name : SStr) : INTEGER;
VAR Current : WORD;
    Tally   : WORD;
Begin
  CurBoardName := B_name;
  OpenBFile;
  Cur_bul := LastReadNum+1;
  Tally := 0;
  While (Cur_bul <= numbuls) DO
   Begin
     GetBrec;
     IF Post.when > laston THEN
       Begin
         Inc(Tally);
       End;
      Inc(Cur_bul);
    End;
  Num_new_bulletins := Tally;
End;

{=============================================================================}

VAR newmsgs : boolean;
    NewFIles : BOOLEAN;

  Procedure newscanboard;
  VAR Advance_board : BOOLEAN;

    Procedure shownewfiles;
    VAR cnt,first,numf:integer;
        f:filerec;
        nf:boolean;
    begin
      NewFiles := FALSE;
      numf:=numfiles;
      cnt:=numf;
      nf:=true;
      while (cnt>0) and nf do begin
        seekffile (cnt);
        read (ffile,f);
        nf:=f.when>laston;
        if nf then cnt:=cnt-1
      end;
      first:=cnt+1;
      if first>numf then exit;
      writehdr ('New files');
      NewFiles := TRUE;
      if aborted or break then exit;
      for cnt:=first to numf do begin
        seekffile (cnt);
        read (ffile,f);
        writeln (cnt,'. ',f.descrip);
        if aborted or break then exit
      end
    end;

{-----------------------------------------------------------------------------}

Procedure Execute_options;
VAR Command_char : CHAR;
    q : INTEGER;
Begin
   q := Menu('['+strr(Cur_Bul)+'/'+Strr(NumBuls)+']-Newscan',
             'BNEWS','REFQNP_#');
   Case q OF
    1 : Begin
            Writeln;
            WriteStr('Posting a reply to #'+Strr(Cur_bul));
            Writeln(Post.Title,' by ',Post.LeftBy);
            If Copy(Post.Title,1,3) <> 'RE:' THEN
               PostBul('RE: '+Post.Title)
            ELSE
               Postbul(Post.Title);
          End;
    6 : PostBul('');
    2 : Sendmailto(LookUpUser(Post.leftby),Post.anon);
    3 : Sendmailto(LookUpUser(Curboard.sponsor),FALSE);
    4 : Begin
           BeenAborted := TRUE;
           Writeln;
           Writeln('Newscan aborted');
          End;
    5 : Advance_board := TRUE;
   ELSE
     Begin
       If (-q <= Numbuls) AND (-q > 0) THEN Cur_bul := (-q)-1;
       Newscan_sub := FALSE;
     End;
  End;
End;

{-----------------------------------------------------------------------------}

  VAR oldb    : boolean;
  begin
    Advance_board := FALSE;
    beenaborted := FALSE;
    Newmsgs := FALSE;
    NewFiles := FALSE;
    Cur_bul := lastreadnum+1;
    Last_msg := numbuls;
    while Cur_bul <= numbuls do begin
      getbrec;
      IF (Post.when > laston) OR (NOT Newscan_sub) THEN
       Begin
        If (Scan_Mode = Extended) AND
           (ExtClrScr in Urec.Config) THEN Writeln(^L);
        Writeln;
        Writeln;
        readnum(Cur_bul);
        If Scan_mode = Extended THEN
          Begin
            Execute_options;
          End;
        newmsgs := true
       End;
      Cur_bul:=Cur_bul+1;
      IF (aborted) OR (Advance_board) THEN Exit
    end;
    shownewfiles;
    if (postprompts in urec.config) and
        (newmsgs) and (ulvl>=postlevel) AND
        (Scan_mode = Express ) THEN
         Begin
           writestr (^M'Post now? *');
           writeln;
           if yes then postbul('');
         End
  End;

{=============================================================================}

  Procedure newscanall;
  VAR cb       : integer;
      Scan_str : Mstr;
      c1       : BYTE;
      New_pst  : BYTE;
  Begin
    Writeln;
    Writeln('-%-  Newscan all subboards -%-'^M);
    WriteStr('Newscan mode: [E]xpress, or e[X]tended? *');
    If NOT (UpCase(Input[1]) IN ['E','X']) THEN Exit;
    Case UpCase(Input[1]) OF
      'E' : Scan_mode := Express;
      'X' : Scan_mode := Extended;
    End;
    BeenAborted:=false;
    Writehdr('New-scanning. [X] to abort.');
    IF aborted THEN exit;
    Case Scan_mode OF
      Express  : Scan_str := 'Express';
      Extended : Scan_str := 'Extended';
    End;

    For cb := 0 to FileSize(Bdfile)-1 DO
      Begin
        if aborted then exit;
        if haveaccess(cb) and (not (cb in urec.newscanconfig)) THEN
         Begin
          Curboardname:=curboard.shortname;
          Openbfile;
          IF aborted then EXIT;
          Writeln(^B,Scan_str+' scanning: [',curboard.boardname,']');
          if aborted then exit;

          NewMsgs := FALSE;
          NewFiles := FALSE;
          Newscan_sub := TRUE;

          newscanboard;

        End
      ELSE
        If haveaccess(cb) THEN
            Writeln(^B,'Skipping ',curboard.boardname,'.');
    End;

    Writeln(^B^M'Newscan complete!'^G);
    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)-1 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;
  Show_top_posters;
  setfirstboard;
  repeat
    boo := checkcurbul;
    with curboard do
      writeln (^M,boardname,' [',shortname,']: ',Cur_bul,' of ',numbuls);
    if Sponsor_on OR issysop THEN
      Writeln('%: Board sponsor commands');
    q := menu ('Bulletin','BULLET','PRDFUKT*MQ#_%LNBAVCHES+WO');
    case q of
      1  : postbul('');
      2  : readbul;
      3  : downloadfile;
      4,
      22 : sendmailto (LookUpUser(curboard.sponsor),false);
      5  : uploadfile;
      6  : killbul;
      8,
      16,
      17 : activeboard;
      7  : listbuls;
      9  : sendbreply;
      12 : if not hungupon then readnextbul;
      13 : boardsponsor;
      14 : listfiles;
      15 : newscanall;
      18 : Begin
             Scan_mode := Express;
             newscanboard;
           End;
      19 : togglenewscan;
      20 : help ('Bulletin.hlp');
      21 : editbul;
      23 : nextsubboard;
      24 : readnum (lastreadnum+1);
      25 : Show_top_posters;
      else if q<0 then readnum (-q)
    end
  until (q=10) or hungupon or (filesize(bdfile)=0);
  exit:
  close (bfile);
  close (ffile);
  closebdfile
End;

{=============================================================================}

{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}

{initialization}

{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}

Begin
  FillChar(Post_array,SizeOf(Top_poster_Type),0);
End.