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