home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-385-Vol-1of3.iso / f / faq-s.zip / MSG.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-04  |  69KB  |  2,403 lines

  1. {$R-,S-,I-,D-,F+,V-,B-,N-,O+ }
  2. {$M 65500,0,0 }
  3.  
  4. unit msg;
  5.  
  6. interface
  7.  
  8. uses crt,dos,overlay,
  9.      gentypes,configrt,statret,gensubs,subs1,subs2,subs3,
  10.      userret,textret,mainr1,mainr2,overret1,flags,mainmenu,modem;
  11.  
  12. procedure messagemenu;
  13.  
  14. implementation
  15.  
  16. procedure messagemenu;
  17. var q,curbul,lastreadnum:integer;
  18.     b:bulrec;
  19.     reading,quitmasterinc,cscan:boolean;
  20.  
  21.   procedure togglecscan;
  22.   begin
  23.    if cscan then cscan:=false else
  24.     cscan:=true;
  25.    writeln;
  26.    write (^R'Auto-Scan is now: '^S);
  27.    if cscan then writeln ('On') else writeln ('Off');
  28.    writeln;
  29.   end;
  30.  
  31.   procedure makeboard; forward;
  32.  
  33.   function sponsoron:boolean;
  34.   begin
  35.     sponsoron:=match(curboard.sponsor,unam)
  36.   end;
  37.  
  38.   procedure clearorder (var bo:boardorder);
  39.   var cnt:integer;
  40.   begin
  41.     for cnt:=0 to 255 do bo[cnt]:=cnt
  42.   end;
  43.  
  44.   procedure carryout (var bo:boardorder);
  45.   var u:userrec;
  46.       cnt,un:integer;
  47.  
  48.     procedure doone;
  49.     var cnt,q:integer;
  50.         ns,a1,a2:set of byte;
  51.     begin
  52.       fillchar (ns,32,0);
  53.       fillchar (a1,32,0);
  54.       fillchar (a2,32,0);
  55.       for cnt:=0 to 255 do begin
  56.         q:=bo[cnt];
  57.         if q in u.newscanconfig then ns:=ns+[cnt];
  58.         if q in u.access1 then a1:=a1+[cnt];
  59.         if q in u.access2 then a2:=a2+[cnt]
  60.       end;
  61.       u.newscanconfig:=ns;
  62.       u.access1:=a1;
  63.       u.access2:=a2;
  64.       seek (ufile,un);
  65.       write (ufile,u)
  66.     end;
  67.  
  68.   begin
  69.     writeln (^B'Adjusting user access flags.');
  70.     seek (ufile,1);
  71.     for un:=1 to numusers do begin
  72.       if (un mod 10)=0 then write (' ',un);
  73.       read (ufile,u);
  74.       if length(u.handle)>0 then doone
  75.     end
  76.   end;
  77.  
  78.   procedure switchboards (bnum1,bnum2:integer; var bo:boardorder);
  79.   var bd1,bd2:boardrec;
  80.       n1:integer;
  81.   begin
  82.     seekbdfile (bnum1);
  83.     read (bdfile,bd1);
  84.     seekbdfile (bnum2);
  85.     read (bdfile,bd2);
  86.     seekbdfile (bnum1);
  87.     writebdfile (bd2);
  88.     seekbdfile (bnum2);
  89.     writebdfile (bd1);
  90.     n1:=bo[bnum1];
  91.     bo[bnum1]:=bo[bnum2];
  92.     bo[bnum2]:=n1
  93.   end;
  94.  
  95.   procedure setfirstboard; forward;
  96.  
  97.   procedure seekffile (n:integer);
  98.   begin
  99.     seek (ffile,n-1)
  100.   end;
  101.  
  102.   function numfiles:integer;
  103.   begin
  104.     numfiles:=filesize (ffile)
  105.   end;
  106.  
  107.   procedure assignffile;
  108.   begin
  109.     assign (ffile,datadir+copy(curboardname,1,8)+'.FI'+strr(conn));
  110. end;
  111.  
  112.   procedure formatffile;
  113.   begin
  114.     close (ffile);
  115.     assignffile;
  116.     rewrite (ffile)
  117.   end;
  118.  
  119.   procedure openffile;
  120.   var f:filerec;
  121.       i:integer;
  122.   begin
  123.     close (ffile);
  124.     assignffile;
  125.     reset (ffile);
  126.     i:=ioresult;
  127.     if i<>0 then formatffile
  128.   end;
  129.  
  130.   procedure addfile (f:filerec);
  131.   begin
  132.     seekffile (numfiles+1);
  133.     write (ffile,f)
  134.   end;
  135.  
  136.   procedure delfile (fn:integer);
  137.   var f:filerec;
  138.       cnt:integer;
  139.   begin
  140.     for cnt:=fn to numfiles-1 do begin
  141.       seekffile (cnt+1);
  142.       read (ffile,f);
  143.       seekffile (cnt);
  144.       write (ffile,f)
  145.     end;
  146.     seekffile (numfiles);
  147.     truncate (ffile)
  148.   end;
  149.  
  150.   procedure seekbfile (n:integer);
  151.   begin
  152.     seek (bfile,n-1); che
  153.   end;
  154.  
  155.   function numbuls:integer;
  156.   begin
  157.     numbuls:=filesize(bfile)
  158.   end;
  159.  
  160.   procedure getlastreadnum;
  161.   var oldb:boolean;
  162.       b:bulrec;
  163.       lr:word;
  164.   begin
  165.     lastreadnum:=numbuls;
  166.     oldb:=false;
  167.     lr:=urec.lastread[curboardnum];
  168.     if lr=0
  169.       then lastreadnum:=0
  170.       else
  171.         while (lastreadnum>0) and (not oldb) do begin
  172.           seekbfile (lastreadnum);
  173.           read (bfile,b);
  174.           oldb:=b.id=lr;
  175.           if not oldb then lastreadnum:=lastreadnum-1
  176.         end
  177.   end;
  178.  
  179.   procedure assignbfile;
  180.   begin
  181.     assign (bfile,datadir+copy(curboardname,1,8)+'.MS'+strr(conn));
  182.   end;
  183.  
  184.   procedure formatbfile;
  185.   begin
  186.     assignbfile;
  187.     rewrite (bfile);
  188.     curboardnum:=searchboard(curboardname);
  189.     if curboardnum=-1 then begin
  190.       curboardnum:=filesize(bdfile);
  191.       fillchar (curboard,sizeof(curboard),0);
  192.       writecurboard
  193.     end
  194.   end;
  195.  
  196.   procedure openbfile;
  197.   var b:bulrec;
  198.       i:integer;
  199.   begin
  200.     curboardnum:=searchboard (curboardname);
  201.     if curboardnum=-1 then begin
  202.       makeboard;
  203.       exit
  204.     end;
  205.     close (bfile);
  206.     assignbfile;
  207.     reset (bfile);
  208.     i:=ioresult;
  209.     if ioresult<>0 then formatbfile;
  210.     seekbdfile (curboardnum);
  211.     read (bdfile,curboard);
  212.     getlastreadnum;
  213.     openffile
  214.   end;
  215.  
  216.   function boardexist(n:sstr):boolean;
  217.   begin
  218.     boardexist:=not (searchboard(n)=-1)
  219.   end;
  220.  
  221.   procedure addbul (var b:bulrec);
  222.   var b2:bulrec;
  223.   begin
  224.     if numbuls=0 then b.id:=1 else begin
  225.       seekbfile (numbuls);
  226.       read (bfile,b2);
  227.       if b2.id=65535
  228.         then b.id:=1
  229.         else b.id:=b2.id+1
  230.     end;
  231.     seekbfile (numbuls+1);
  232.     write (bfile,b)
  233.   end;
  234.  
  235.   function checkcurbul:boolean;
  236.   begin
  237.     if (curbul<1) or (curbul>numbuls) then begin
  238.       checkcurbul:=false;
  239.       curbul:=0
  240.     end else checkcurbul:=true
  241.   end;
  242.  
  243.   procedure getbrec;
  244.   begin
  245.     if checkcurbul then begin
  246.       seekbfile (curbul);
  247.       read (bfile,b); che
  248.     end
  249.   end;
  250.  
  251.   procedure delbul (bn:integer; deltext:boolean);
  252.   var c,un:integer;
  253.       b:bulrec;
  254.       u:userrec;
  255.   begin
  256.     if (bn<1) or (bn>numbuls) then exit;
  257.     seekbfile (bn);
  258.     read (bfile,b);
  259.     if deltext then deletetext (b.line);
  260.     for c:=bn to numbuls-1 do begin
  261.       seekbfile (c+1);
  262.       read (bfile,b);
  263.       seekbfile (c);
  264.       write (bfile,b)
  265.     end;
  266.     seekbfile (numbuls);
  267.     truncate (bfile);
  268.     getlastreadnum
  269.   end;
  270.  
  271.   procedure delboard (bdn:integer);
  272.   var bd1:boardrec;
  273.       cnt,nbds:integer;
  274.       bo:boardorder;
  275.   begin
  276.     clearorder (bo);
  277.     nbds:=filesize(bdfile)-1;
  278.     if nbds=0 then begin
  279.       close (bdfile);
  280.       rewrite (bdfile);
  281.       exit
  282.     end;
  283.     for cnt:=bdn to nbds-1 do begin
  284.       seekbdfile (cnt+1);
  285.       read (bdfile,bd1);
  286.       seekbdfile (cnt);
  287.       writebdfile (bd1);
  288.       bo[cnt]:=cnt+1
  289.     end;
  290.     seek (bdfile,nbds);
  291.     truncate (bdfile);
  292.     seek (bifile,nbds);
  293.     truncate (bifile);
  294.     carryout (bo)
  295.   end;
  296.  
  297.   procedure sendfile (fn:integer);
  298.   var f:filerec;
  299.       cnt:integer;
  300.       k:char;
  301.       q:file of byte;
  302.   label exit;
  303.   begin
  304.     seekffile (fn);
  305.     read (ffile,f);
  306.     assign (q,f.fname);
  307.     reset (q);
  308.     iocode:=ioresult;
  309.     if iocode<>0 then begin
  310.       fileerror (f.fname,'SENDFILE (Ascii download)');
  311.       goto exit
  312.     end;
  313.     writelog (4,1,f.descrip);
  314.     writeln ('File:        '^S,f.descrip);
  315.     writeln ('Uploaded by: '^S,f.sentby);
  316.     writeln ('Downloaded:  '^s,f.downloaded);
  317.     writeln ('File size:   '^S,filesize(q),' characters'^M);
  318.     writeln (^B'Press [Space] when you are ready, or [X] to abort.');
  319.     repeat
  320.       repeat until charready;
  321.       k:=readchar;
  322.       if hungupon then goto exit;
  323.       if upcase(k)='X' then goto exit
  324.     until k=' ';
  325.     if not hungupon
  326.       then
  327.         begin
  328.           printfile (f.fname);
  329.           f.downloaded:=f.downloaded+1;
  330.           seekffile (fn);
  331.           write (ffile,f);
  332.           writeln (^B^M+asciidownload+^M'Press a key.');
  333.           repeat until charready;
  334.           k:=readchar
  335.         end;
  336.     exit:
  337.     close (q)
  338.   end;
  339.  
  340.   procedure receivefile (f:filerec);
  341.   var fn:lstr;
  342.       cnt,timeul:integer;
  343.       k:char;
  344.       done:boolean;
  345.       fff:text;
  346.       last3:array [1..3] of char;
  347.  
  348.     procedure putchar (k:char);
  349.     begin
  350.       write (fff,k);
  351.       write (usr,k)
  352.     end;
  353.  
  354.   begin
  355.     fn:='';
  356.     cnt:=1;
  357.     timeul:=timer;
  358.     repeat
  359.       if cnt<=length(f.descrip) then begin
  360.         k:=upcase(f.descrip[cnt]);
  361.         if k in ['A'..'Z'] then fn:=fn+k
  362.       end;
  363.       cnt:=cnt+1
  364.     until cnt>length(f.descrip);
  365.     if fn='' then fn:='Noname';
  366.     fn:=copy(fn,1,8);
  367.     while devicename(fn) do fn:=fn+chr(random(26)+64);
  368.     fn:=uploaddir+fn+'.';
  369.     cnt:=0;
  370.     repeat
  371.       cnt:=cnt+1
  372.     until (cnt=1000) or (not exist(fn+strr(cnt)));
  373.     if cnt=1000 then begin
  374.       writeln ('Please try another description!');
  375.       exit
  376.     end;
  377.     fn:=fn+strr(cnt);
  378.     assign (fff,fn);
  379.     rewrite (fff);
  380.     iocode:=ioresult;
  381.     if iocode<>0 then begin
  382.       error ('%I opening %1 in RECEIVEFILE (ASCII upload)','',fn);
  383.       exit
  384.     end;
  385.     f.fname:=fn;
  386.     f.sentby:=unam;
  387.     f.downloaded:=0;
  388.     f.when:=now;
  389.     writeln (^B'ASCII receive ready.'^M,
  390.              'Press [CR] and /E to end, /X to abort.'^M);
  391.     textcolor (outlockcolor);
  392.     repeat
  393.       repeat until charready;
  394.       if hungupon
  395.         then done:=true
  396.         else
  397.           begin
  398.             k:=chr(ord(readchar) and 127);
  399.             last3[1]:=last3[2];
  400.             last3[2]:=last3[3];
  401.             last3[3]:=upcase(k);
  402.             done:=((last3[1]=^M) or (last3[1]=^J))
  403.                   and (last3[2]='/') and ((last3[3]='E') or (last3[3]='X'));
  404.             if not done then begin
  405.               if (last3[2]=^M) and (k<>^J) then putchar (^J);
  406.               if last3[2]='/' then putchar ('/');
  407.               if k<>'/'
  408.                 then putchar (k)
  409.             end
  410.           end
  411.     until done;
  412.     textclose (fff);
  413.     textcolor (normbotcolor);
  414.     if last3[3]='E' then begin
  415.       addfile (f);
  416.       timeul:=timer-timeul;
  417.       if timeul<0 then timeul:=timeul+1440;
  418.       writeln (^B^M'That upload took ',timeul,' minutes.');
  419.       logontime:=logontime+timeul;
  420.       writelog (4,2,f.descrip)
  421.     end else begin
  422.       writestr (^M^M'Upload aborted!');
  423.       erase (fff);
  424.       iocode:=ioresult
  425.     end
  426.   end;
  427.  
  428.   procedure getbnum (txt:mstr);
  429.   var q:boolean;
  430.   begin
  431.     if length(input)>1
  432.       then curbul:=valu(copy(input,2,255))
  433.       else begin
  434.         writestr (^M'Message to '+txt+':');
  435.         curbul:=valu(input)
  436.       end;
  437.     q:=checkcurbul
  438.   end;
  439.  
  440. procedure killbul;
  441.   var un:integer;
  442.       u:userrec;
  443.   begin
  444.     writehdr ('Message Deletion');
  445.     if not reading then
  446.     getbnum ('delete');
  447.     if not checkcurbul then exit;
  448.     getbrec;
  449.     if (not match(b.leftby,unam)) and (not issysop) and (not sponsoron)
  450.       then begin
  451.         writeln ('You didn''t post that!');
  452.         exit
  453.       end;
  454.     writeln ('Subject: ',b.title,
  455.            ^M'Left by: ',b.leftby,^M^M);
  456.     writestr ('Delete this? *');
  457.     if not yes then exit;
  458.     un:=lookupuser (b.leftby);
  459.     if un<>0 then begin
  460.       writeurec;
  461.       seek (ufile,un);
  462.       read (ufile,u);
  463.       u.nbu:=u.nbu-1;
  464.       seek (ufile,un);
  465.       write (ufile,u);
  466.       readurec
  467.     end;
  468.     delbul (curbul,true);
  469.     if messages<1 then messages:=1;
  470.     messages:=messages-1;
  471.     if urec.lastmessages<1 then urec.lastmessages:=1;
  472.     urec.lastmessages:=urec.lastmessages-1;
  473.     writeln ('Message deleted.');
  474.     writelog (4,5,b.title)
  475.   end;
  476.  
  477.   procedure autodelete;
  478.   begin
  479.     writeln (^R'Erasing first post '^P'-'^R' Please wait.');
  480.     delbul (1,true)
  481.   end;
  482.  
  483.   function wipe(amount:byte):string;
  484.   var z:integer;
  485.       gee:string[80];
  486.    begin
  487.    for z:=1 to amount do gee:=gee+' ';
  488.    wipe:=gee;
  489.    end;
  490.  
  491.   procedure postbul;
  492.   var l:integer;
  493.       m:message;
  494.       b:bulrec;
  495.       ds:longint;
  496.   begin
  497.     if ulvl<postlevel then begin
  498.       reqlevel(postlevel);
  499.       exit
  500.     end;
  501.     l:=editor(m,true,'');
  502.     if l>=0 then
  503.       begin
  504.         inc(urec.nbu);
  505.         writeurec;
  506.         if messages>32760 then messages:=0;
  507.         inc(messages);
  508.         b.anon:=m.anon;
  509.         b.title:=m.title;
  510.         b.when:=now;
  511.         b.leftby:=unam;
  512.         b.status:='['+urec.note+']';
  513.         if sponsoron then b.status:=b.status+' [Sponsor]';
  514.         b.recieved:=false;
  515.         b.leftto:=m.leftto;
  516.         b.line:=l;
  517.         b.plevel:=ulvl;
  518.         b.id:=curboard.net;
  519.         if (curboard.net>0) and (usenet) and (featurea) then begin b.where:=^R+'CelerityNet V'+netver+' - '+longname;
  520.         b.where2:=^R+netcomment; end;
  521.         addbul (b);
  522.         inc(newposts);
  523.         with curboard do
  524.           if autodel<=numbuls then autodelete;
  525.       if (curboard.net>0) and (usenet) and (featurea) then
  526.       writeln(^R'This post will be visible in all CelerityNet Boards.')
  527.     end
  528.   end;
  529.  
  530.   procedure readcurbul;
  531.   var q:anystr;
  532.       t:sstr;
  533.       cnt,emusux,anarkyamerika:integer;
  534.       oligarch:mstr;
  535.   begin
  536.     q:=wipe(80);
  537.     if checkcurbul then begin
  538.       getbrec;
  539.       if (ansi and not cscan) then begin
  540.         clearscr;
  541.       end;
  542.       write   (^B^M^R'Message'^P': '^S);
  543.       oligarch:=^S+strr(curbul)+^R' of '^S+strr(numbuls);
  544.       write (oligarch);
  545.       for emusux:=1 to 32-(length(oligarch)) do
  546.       write (' ');
  547.       write  (^R'Posted '^P': ');
  548.       if issysop or (not b.anon) then
  549.       write(^S,datestr(b.when),' at ',timestr(b.when),^R) else writeln (^S'Unknown');
  550.       writeln;
  551.       write{ln}   (^B^R'Subject'^P': ');
  552.       write(^S,b.title);
  553.       for emusux:=1 to 29-(length(b.title)) do
  554.       write (' ');
  555.       write   (^R'To     '^P': '^S,b.leftto);
  556.       if (b.recieved) then begin
  557.        write (' ');
  558.        write (^P'[Received]'^R);
  559.       end;
  560.       writeln;
  561.       q:=^R'From   '^P': '^S;
  562.       if b.anon then
  563.           begin
  564.             q:=q+anonymousstr;
  565.             if (issysop) or (ulvl>=readanonlvl) then q:=q+' ['+b.leftby+']'
  566.           end
  567.         else
  568.           begin
  569.             if b.plevel=-1
  570.               then t:='unknown'
  571.               else t:=strr(b.plevel);
  572.            q:=q+b.leftby+' [Level '+t+'] '+b.status;
  573.           end;
  574.       writeln (q);
  575.       if break then exit;
  576.       printtext (b.line);
  577.       if (curboard.net>0) and (usenet) and (featurea) then
  578.       write (^M+b.where+^M+b.where2);
  579.       if match (b.leftto,unam) then begin
  580.        b.recieved:=true;
  581.        seekbfile (curbul);
  582.        write (bfile,b);
  583.       end;
  584.       ansicolor (urec.regularcolor);
  585.     end;
  586.   { if curbul>lastreadnum then }
  587.     begin
  588.       lastreadnum:=curbul;
  589.       urec.lastread[curboardnum]:=b.id
  590.     end
  591.   end;
  592.  
  593.   function queryaccess:accesstype;
  594.   begin
  595.     queryaccess:=getuseraccflag (urec,curboardnum)
  596.   end;
  597.  
  598.   procedure readbul;
  599.   begin
  600.     getbnum ('Read');
  601.     readcurbul
  602.   end;
  603.  
  604.   procedure readnextbul;
  605.   var t:integer;
  606.   begin
  607.     t:=curbul;
  608.     inc(curbul);
  609.     readcurbul;
  610.     if curbul=0 then curbul:=t
  611.   end;
  612.  
  613.   procedure readnum (n:integer);
  614.   begin
  615.     curbul:=n;
  616.     readcurbul
  617.   end;
  618.  
  619.   function haveaccess (n:integer):boolean;
  620.   var a:accesstype;
  621.   begin
  622.     curboardnum:=n;
  623.     seekbdfile (n);
  624.     read (bdfile,curboard);
  625.     a:=queryaccess;
  626.     if a=bylevel
  627.       then haveaccess:=ulvl>=curboard.level
  628.       else haveaccess:=a=letin
  629.   end;
  630.  
  631.    procedure setanon;
  632.    begin
  633.      writestr ('Allow Anonymous Posts? [Y/N]: *');
  634.      if (yes) then curboard.anony:=true;
  635.      if not yes then curboard.anony:=false;
  636.      writecurboard;
  637.    end;
  638.  
  639.    procedure setnet;
  640.    begin
  641.      writestr ('CelerityNet ID # [0]: *');
  642.      if (valu(input)>0) then curboard.net:=valu(input);
  643.      if (valu(input)<1) and (valu(input)>-1) then curboard.net:=0;
  644.      writecurboard;
  645.    end;
  646.  
  647.   {procedure makeboard;
  648.   begin
  649.     formatbfile;
  650.     formatffile;
  651.     with curboard do begin
  652.       shortname:=curboardname;
  653.       buflen:=30;
  654.       writestr (^M'Board Name: &');
  655.       boardname:=input;
  656.       buflen:=30;
  657.       writestr ('Sponsor [CR/'+unam+']:');
  658.       if input='' then input:=unam;
  659.       sponsor:=input;
  660.       writestr ('Minimum Level for entry:');
  661.       level:=valu(input);
  662.       setnet;
  663.       writestr ('Autodelete after [CR/100]:');
  664.       if length(input)<1 then input:='100';
  665.       autodel:=valu(input);
  666.       if autodel<10 then begin
  667.         writeln ('Must be at least 10!');
  668.         autodel:=10
  669.       end;
  670.       setanon;
  671.       setallflags (curboardnum,bylevel);
  672.       writecurboard;
  673.       writeln ('Board created.');
  674.       writelog (4,4,boardname+' ['+shortname+']')
  675.     end
  676.   end;}
  677.  
  678.   Procedure makeboard;
  679.     Begin
  680.       formatbfile;
  681.       With curboard Do Begin
  682.         if ansigraphics in urec.config then begin
  683.         clearscr;
  684.         WriteLn(^R'         ┌───────────'^P'['^S' FAQ Sub-Board Installation '^P']'^R'────────────┐');
  685.         WriteLn(^R'         │                                                     │');
  686.         WriteLn(^R'         │                                                     │');
  687.         WriteLn(^R'         │                                                     │');
  688.         WriteLn(^R'         │                                                     │');
  689.         WriteLn(^R'         │                                                     │');
  690.         WriteLn(^R'         │                                                     │');
  691.         WriteLn(^R'         │                                                     │');
  692.         WriteLn(^R'         │                                                     │');
  693.         WriteLn(^R'         └─────────────────────────────────────────────────────┘');
  694.         PrintXy(12,8,^P'Allow Anonymous [CR/No]: ');
  695.         PrintXy(12,7,^P'CelerityNet ID# [CR/0]: ');
  696.         PrintXy(12,6,^P'Maximum Number of Messages: ');
  697.         PrintXy(12,5,^P'Co-SysOp/Sponsor ['+^S+unam+^P+']: ');
  698.         PrintXy(12,4,^P'Minimum Access Entry: ');
  699.         PrintXy(12,3,^P'Message Area Name: ');
  700.         shortname:=curboardname;
  701.         BufLen:=29;
  702.         movexy(12,3);
  703.         writestr(^P'Message Area Name: &');
  704.         if input='' then EXiT;
  705.         boardname:=Input;
  706.         BufLen:=30;
  707.         {movexy(12,5);
  708.         writestr(^P'Access Type [G]roup [L]evel [B]oth [CR/L]: *');
  709.         If Input='' Then Input:='L';
  710.         Area_Type:=UpCase(Input[1]);
  711.         if not ( area_type[1] in [ 'B' , 'G' , 'L' ] ) then
  712.           area_type := 'L' ;
  713.         if area_type[1] in [ 'G' , 'B' ] then
  714.           begin
  715.             movexy(12,7);
  716.             writestr(^P'Group File list [CR/None]: *');
  717.             If Input='' Then Input:='None';
  718.             File_List:=Input;
  719.           end
  720.         else
  721.           File_List := 'None';
  722.         if area_type[1] in [ 'L' , 'B' ] then}
  723.           begin
  724.             movexy(12,4);
  725.             writestr(^P'Minimum Access Entry: *');
  726.             level:=valu(Input);
  727.           end
  728.         {else
  729.           level := maxint};
  730.         movexy(12,5);
  731.         writestr(^P'Co-Sysop/Sponsor ['+^S+unam+^P+']: *');
  732.         If Input='' Then Input:=unam;
  733.         sponsor:=Input;
  734.         movexy(12,6);
  735.         writestr(^P'Maximum Number of Messages: *');
  736.         autodel:=valu(Input);
  737.         If autodel<10 Then Begin
  738.           WriteLn('Must be at least 10!');
  739.           autodel:=50
  740.         End;
  741.         movexy(12,7);
  742.         writestr(^P'CelerityNet ID# [CR/0]: *');
  743.         if input='' then begin input:='0'; printxy2 (36,7,^U+'0'); end;
  744.         net:=valu(input);
  745.         movexy(12,8);
  746.         writestr(^P'Allow Anonymous [CR/No]: *');
  747.         if input='' then begin anony:=false; printxy2 (37,8,^U+'No '); end;
  748.         if yes then begin anony:=true; printxy2 (37,8,^U+'Yes'); end;
  749.         end else begin
  750.       shortname:=curboardname;
  751.       buflen:=30;
  752.       writestr (^M'Board Name: &');
  753.       boardname:=input;
  754.       buflen:=30;
  755.       writestr ('Sponsor [CR/'+unam+']:');
  756.       if input='' then input:=unam;
  757.       sponsor:=input;
  758.       writestr ('Minimum Level for entry:');
  759.       level:=valu(input);
  760.       setnet;
  761.       writestr ('Autodelete after [CR/100]:');
  762.       if length(input)<1 then input:='100';
  763.       autodel:=valu(input);
  764.       if autodel<10 then begin
  765.         writeln ('Must be at least 10!');
  766.         autodel:=10
  767.       end;
  768.       setanon;
  769.         end;
  770.         setallflags(curboardnum,bylevel);
  771.         writecurboard;
  772.         writeln (^M^M^R'Message Base Created');
  773.         writelog(4,4,boardname+' ['+shortname+']')
  774.       End
  775.     End;
  776.  
  777.   procedure setactive (nn:sstr; showinfo:boolean);
  778.  
  779.     procedure doswitch;
  780.     begin
  781.       openbfile;
  782.       curbul:=lastreadnum;
  783.       with curboard do
  784.       begin
  785.        writeln;
  786.        if showinfo then begin
  787.        if asciigraphics in urec.config then begin
  788.        clearscr;
  789.        writeln (^R'┌─────────────┬────────────────────────────────┐');
  790.        write (^R'│ '^S'Sub-board:'^R'  │ '^S);
  791.        tab (boardname,31);
  792.        writeln (^R'│');
  793.        write (^R'│ '^S'Messages:'^R'   │ '^S);
  794.        tab (strr(numbuls),31);
  795.        writeln (^R'│');
  796.        write (^R'│ '^S'Last read:'^R'  │ '^S);
  797.        tab (strr(lastreadnum),31);
  798.        writeln (^R'│');
  799.        write (^R'│ '^S'Sponsor:'^R'    │ '^S);
  800.        tab(sponsor,31);
  801.        writeln (^R'│');
  802.        write (^R'│ '^S'Files:'^R'      │ '^S);
  803.        tab (strr(numfiles),31);
  804.        writeln (^R'│');
  805.        write (^R'│ '^S'CelerityNet:'^R'│ '^S);
  806.        if net>0 then begin
  807.        tab ('Yes',31);
  808.        end else
  809.        tab ('No ',31);
  810.        writeln (^R'│');
  811.        writeln (^R'└─────────────┴────────────────────────────────┘');
  812.        end else begin
  813.        clearscr;
  814.        writeln (^R'+-------------+--------------------------------+');
  815.        write (^R'| '^S'Sub-board:'^R'  | '^S);
  816.        tab (boardname,31);
  817.        writeln (^R'|');
  818.        write (^R'| '^S'Messages:'^R'   | '^S);
  819.        tab (strr(numbuls),31);
  820.        writeln (^R'|');
  821.        write (^R'| '^S'Last read:'^R'  | '^S);
  822.        tab (strr(lastreadnum),31);
  823.        writeln (^R'|');
  824.        write (^R'| '^S'Sponsor:'^R'    | '^S);
  825.        tab(sponsor,31);
  826.        writeln (^R'|');
  827.        write (^R'| '^S'Files:'^R'      | '^S);
  828.        tab (strr(numfiles),31);
  829.        writeln (^R'|');
  830.        write (^R'| '^S'CelerityNet:'^R'| '^S);
  831.        if net>0 then begin
  832.        tab ('Yes',31);
  833.        end else
  834.        tab ('No ',31);
  835.        writeln (^R'|');
  836.        writeln (^R'+-------------+--------------------------------+');
  837.         end;
  838.        end;
  839.        writeln;
  840.       end;
  841.     end;
  842.  
  843.     procedure tryswitch;
  844.     var n,s:integer;
  845.  
  846.       procedure denyaccess;
  847.       var b:bulrec;
  848.       begin
  849.         reqlevel (curboard.level);
  850.         setfirstboard
  851.       end;
  852.  
  853.     begin
  854.       curboardname:=nn;
  855.       curboardnum:=searchboard(nn);
  856.       if haveaccess(curboardnum)
  857.         then doswitch
  858.         else denyaccess
  859.     end;
  860.  
  861.   var b:bulrec;
  862.   begin
  863.     curbul:=0;
  864.     close (bfile);
  865.     close (ffile);
  866.     curboardname:=nn;
  867.     if boardexist(nn) then tryswitch else begin
  868.       writeln ('No such board: ',curboardname,'!');
  869.       if issysop
  870.         then
  871.           begin
  872.             writestr (^M'Create one? [y/n]: *');
  873.             if yes
  874.               then
  875.                 begin
  876.                   makeboard;
  877.                   setactive (upstring(curboardname),true)
  878.                 end
  879.               else setfirstboard
  880.           end
  881.         else setfirstboard
  882.     end
  883.   end;
  884.  
  885.   function validbname (n:sstr):boolean;
  886.   var cnt:integer;
  887.   begin
  888.     if (length(n)=0) or (length(n)>15) then begin
  889.     validbname:=false;
  890.     exit;
  891.     end;
  892.     for cnt:=1 to length(n) do
  893.       if not (upcase(n[cnt]) in ['0'..'9','A'..'Z']) then begin
  894.     validbname:=false end else
  895.       exit;
  896.     validbname:=true
  897.   end;
  898.  
  899.   procedure listboards;
  900.     procedure spacelen(le:byte);
  901.    var aaa:byte;
  902.    begin
  903.     for aaa:=1 to le do
  904.     write(' ');
  905.    end;
  906.  
  907.   var cnt,oldcurboard:integer;
  908.       printed:boolean;
  909.   begin
  910.     oldcurboard:=curboardnum;
  911.     if exist (textfiledir+'Msgarea.'+strr(conn)) then
  912.      printfile (textfiledir+'Msgarea.'+strr(conn)) else
  913.    begin
  914.    writehdr ('Message Area List');
  915.    if asciigraphics in urec.config then begin
  916.    writeln (^R'┌────────────────┬───────────────────────────────────────┬───────┬─────┬─────┐');
  917.    writeln (^R'│ '^S'Name'^R'           │ '^S'Subboard Name'^R'                         │ '^S'Level'^R' │ '^S'A/A'^R' │ '^S+
  918.    'Net'^R' │');
  919.    writeln (^R'├────────────────┼───────────────────────────────────────┼───────┼─────┼─────┤');
  920.     end else begin
  921.    writeln (^R'+----------------+---------------------------------------+-------+-----+-----+');
  922.    writeln (^R'| '^S'Name'^R'           | '^S'Subboard Name'^R'                         | '^S'Level'^R' | '^S'A/A'^R' | '^S+
  923.    'Net'^R' |');
  924.    writeln (^R'|----------------|---------------------------------------|-------|-----|-----|');
  925.     end;
  926.           if (asciigraphics in urec.config) then begin
  927.     if break then exit;
  928.     for cnt:=0 to filesize(bdfile)-1 do
  929.       if haveaccess(cnt) then
  930.         with curboard do begin
  931.           write (^R'│ '^S,shortname,^R);
  932.           spacelen(15-length(shortname));
  933.           write (^R'│ '^S,boardname,^R);
  934.           spacelen(38-length(boardname));
  935.           write (^R'│ '^S,level,^R);
  936.           spacelen(6-length(strr(level)));
  937.        if anony then
  938.           write (^R'│ '^S'Yes'^R' │')
  939.        else
  940.           write (^R'│ '^S'No'^R'  │');
  941.        if net>0 then
  942.           writeln (^R' '^S'Yes'^R' │')
  943.        else
  944.           writeln (^R' '^S'No'^R'  │');
  945.           if break then exit
  946.         end;
  947.     end;
  948.   end;
  949.   if not (asciigraphics in urec.config) then begin
  950.     if break then exit;
  951.     for cnt:=0 to filesize(bdfile)-1 do
  952.       if haveaccess(cnt) then
  953.         with curboard do begin
  954.           write (^R'| '^S,shortname,^R);
  955.           spacelen(15-length(shortname));
  956.           write (^R'| '^S,boardname,^R);
  957.           spacelen(38-length(boardname));
  958.           write (^R'| '^S,level,^R);
  959.           spacelen(6-length(strr(level)));
  960.        if anony then
  961.           write (^R'| '^S'Yes'^R' |')
  962.        else
  963.           write (^R'| '^S'No'^R'  |');
  964.        if net>0 then
  965.           writeln (^R' '^S'Yes'^R' |')
  966.        else
  967.           writeln (^R' '^S'No'^R'  |');
  968.           if break then exit
  969.         end;
  970.     end;
  971.    if asciigraphics in urec.config then
  972.    writeln (^R'└────────────────┴───────────────────────────────────────┴───────┴─────┴─────┘') else
  973.    writeln (^R'+----------------+---------------------------------------+-------+-----+-----+');
  974.     writeln;
  975.     curboardnum:=oldcurboard;
  976.     seekbdfile (curboardnum);
  977.     read (bdfile,curboard)
  978.   end;
  979.  
  980.   procedure activeboard;
  981.   begin
  982.     if length(input)>1
  983.       then input:=copy(input,2,255)
  984.       else begin
  985.         repeat
  986.           writestr ({^M}'Board Number [?/List]:');
  987.           input:=upstring(input);
  988.           if input='?' then listboards
  989.         until (input<>'?') or hungupon;
  990.       end;
  991.     if hungupon or (length(input)=0) then exit;
  992.     if input[1]='*' then input:=copy(input,2,255);
  993.     if validbname(input)
  994.       then setactive (input,true)
  995.       else
  996.         begin
  997.           writeln (^M'Invalid board name!');
  998.           setfirstboard
  999.         end
  1000.   end;
  1001.  
  1002.   procedure setfirstboard; { FORWARD }
  1003.   var fbn:sstr;
  1004.   begin
  1005.     if filesize(bdfile)=0 then exit;
  1006.     if not haveaccess(0)
  1007.       then error ('User can''t access first board','','');
  1008.     seek (bifile,0);
  1009.     read (bifile,fbn);
  1010.     setactive (fbn,true)
  1011.   end;
  1012.  
  1013.   procedure listbuls;
  1014.   var cnt,bn:integer;
  1015.       q:boolean;
  1016.   begin
  1017.     if length(input)>1 then begin
  1018.       curbul:=valu(copy(input,2,255));
  1019.       q:=checkcurbul
  1020.     end;
  1021.     if curbul=0
  1022.       then
  1023.         begin
  1024.           writestr (^M'List titles starting at #*');
  1025.           curbul:=valu(input)
  1026.         end
  1027.       else
  1028.         if length(input)>1
  1029.           then curbul:=valu(input)
  1030.           else curbul:=curbul+10;
  1031.     if not checkcurbul then curbul:=1;
  1032.     writeln ('Titles:'^M);
  1033.     for cnt:=0 to 9 do
  1034.       begin
  1035.         bn:=curbul+cnt;
  1036.         if (bn>0) and (bn<=numbuls) then
  1037.           begin
  1038.             seekbfile (bn);
  1039.             read (bfile,b);
  1040.             write (bn,'. '^S,b.title,^R' by ');
  1041.             if b.anon
  1042.               then writeln (anonymousstr)
  1043.               else writeln (b.leftby);
  1044.             if break then exit
  1045.           end
  1046.       end
  1047.   end;
  1048.  
  1049.   procedure editbul;
  1050.   var me:message;
  1051.   begin
  1052.     getbnum ('edit');
  1053.     if not checkcurbul then exit;
  1054.     getbrec;
  1055.     if (not match(b.leftby,unam)) and (not issysop) and (not sponsoron)
  1056.       then begin
  1057.         writeln ('You didn''t post that!');
  1058.         exit
  1059.       end;
  1060.     reloadtext (b.line,me);
  1061.     me.title:=b.title;
  1062.     me.anon:=b.anon;
  1063.     me.leftto:=b.leftto;
  1064.     if reedit (me,true) then begin
  1065.       writelog (4,6,b.title);
  1066.       deletetext (b.line);
  1067.       b.line:=maketext (me);
  1068.       if b.line<0 then begin
  1069.         writestr (^M'Deleting message.');
  1070.         delbul (curbul,false)
  1071.       end else begin
  1072.         seekbfile (curbul);
  1073.         write (bfile,b)
  1074.       end
  1075.     end
  1076.   end;
  1077.  
  1078.  
  1079.   procedure sendbreply;
  1080.   begin
  1081.     if checkcurbul then begin
  1082.       getbrec;
  1083.       sendmailto (b.leftby,b.anon)
  1084.     end else begin
  1085.       getbnum ('reply to');
  1086.       if checkcurbul then sendbreply
  1087.     end
  1088.   end;
  1089.  
  1090.   procedure listfiles;
  1091.   var cnt,r1,r2,nfiles:integer;
  1092.       f:filerec;
  1093.   begin
  1094.     nfiles:=numfiles;
  1095.     thereare (nfiles,'file','files');
  1096.     if nfiles=0 then exit;
  1097.     parserange (nfiles,r1,r2);
  1098.     if r1=0 then exit;
  1099.     for cnt:=r1 to r2 do begin
  1100.       seekffile (cnt);
  1101.       read (ffile,f); che;
  1102.       writeln (cnt,'. ',f.descrip);
  1103.       if break then exit
  1104.     end;
  1105.     writeln;
  1106.   end;
  1107.  
  1108.   function getfilenumber (txt:lstr):integer;
  1109.   var fn:integer;
  1110.       gotten:boolean;
  1111.   begin
  1112.     getfilenumber:=0;
  1113.     input:=copy(input,2,255);
  1114.     if length(input)=0 then
  1115.       repeat
  1116.         gotten:=true;
  1117.         writestr (^M'File Number to '+txt+' [?/List]:');
  1118.         if input='?' then
  1119.           begin
  1120.             writeln;
  1121.             listfiles;
  1122.             writeln;
  1123.             gotten:=false
  1124.           end
  1125.       until gotten;
  1126.     fn:=valu(input);
  1127.     if (fn<1) or (fn>numfiles) then fn:=0;
  1128.     getfilenumber:=fn
  1129.   end;
  1130.  
  1131.   procedure downloadfile;
  1132.   var fn:integer;
  1133.   begin
  1134.     fn:=getfilenumber ('download');
  1135.     if fn<>0 then
  1136.       begin
  1137.         sendfile (fn);
  1138.         urec.ndn:=urec.ndn+1
  1139.       end;
  1140.   end;
  1141.  
  1142.   procedure uploadfile;
  1143.   var f:filerec;
  1144.   begin
  1145.     writestr ('Describe the file'+^M+': *');
  1146.     if length(input)<>0 then begin
  1147.       f.descrip:=input;
  1148.       receivefile (f);
  1149.       urec.nup:=urec.nup+1
  1150.     end
  1151.   end;
  1152.  
  1153.   procedure boardsponsor;
  1154.  
  1155.     procedure getbgen (txt:mstr; var q);
  1156.     var s:lstr absolute q;
  1157.     begin
  1158.       writeln (^B'Current ',txt,': ',s);
  1159.       buflen:=30;
  1160.       writestr ('Enter new '+txt+': &');
  1161.       if length(input)>0 then s:=input
  1162.     end;
  1163.  
  1164.     procedure getbint (txt:mstr; var i:integer);
  1165.     var a:anystr;
  1166.     begin
  1167.       a:=strr(i);
  1168.       getbgen (txt,a);
  1169.       i:=valu(a);
  1170.       writecurboard
  1171.     end;
  1172.  
  1173.     procedure getbstr (txt:mstr; var q);
  1174.     begin
  1175.       getbgen (txt,q);
  1176.       writecurboard
  1177.     end;
  1178.  
  1179.     procedure setacc (ac:accesstype; un:integer);
  1180.     var u:userrec;
  1181.     begin
  1182.       seek (ufile,un);
  1183.       read (ufile,u);
  1184.       setuseraccflag (u,curboardnum,ac);
  1185.       seek (ufile,un);
  1186.       write (ufile,u)
  1187.     end;
  1188.  
  1189.     function queryacc (un:integer):accesstype;
  1190.     var u:userrec;
  1191.     begin
  1192.       seek (ufile,un);
  1193.       read (ufile,u);
  1194.       queryacc:=getuseraccflag (u,curboardnum)
  1195.     end;
  1196.  
  1197.     procedure setnameaccess;
  1198.     var un,n:integer;
  1199.         ac:accesstype;
  1200.         q,unm:mstr;
  1201.     begin
  1202.       writestr (^M'Change Access for User:');
  1203.       un:=lookupuser(input);
  1204.       if un=0 then begin
  1205.         writeln ('No such user!');
  1206.         exit
  1207.       end;
  1208.       unm:=input;
  1209.       ac:=queryacc(un);
  1210.       writeln (^B^M'Current access: ',accessstr[ac]);
  1211.       getacflag (ac,q);
  1212.       if ac=invalid then exit;
  1213.       if un=unum then writeurec;
  1214.       setacc (ac,un);
  1215.       if un=unum then readurec;
  1216.       case ac of
  1217.         letin:n:=1;
  1218.         keepout:n:=2;
  1219.         bylevel:n:=3
  1220.       end;
  1221.       writelog (5,n,unm)
  1222.     end;
  1223.  
  1224.     procedure setallaccess;
  1225.     var cnt:integer;
  1226.         ac:accesstype;
  1227.         q:mstr;
  1228.     begin
  1229.       writehdr ('Set Everyone''s Access');
  1230.       getacflag (ac,q);
  1231.       if ac=invalid then exit;
  1232.       writeurec;
  1233.       setallflags (curboardnum,ac);
  1234.       readurec;
  1235.       writeln ('Done.');
  1236.       writelog (5,4,accessstr[ac])
  1237.     end;
  1238.  
  1239.     procedure listaccess;
  1240.  
  1241.       procedure listacc (all:boolean);
  1242.       var cnt:integer;
  1243.           a:accesstype;
  1244.           u:userrec;
  1245.  
  1246.         procedure writeuser;
  1247.         begin
  1248.           if all
  1249.             then
  1250.               begin
  1251.                 tab (u.handle,30);
  1252.                 if a=bylevel
  1253.                   then writeln ('Level='+strr(u.level))
  1254.                   else writeln ('Let in')
  1255.               end
  1256.             else writeln (u.handle)
  1257.         end;
  1258.  
  1259.       begin
  1260.         seek (ufile,1);
  1261.         for cnt:=1 to numusers do begin
  1262.           read (ufile,u);
  1263.           a:=getuseraccflag (u,curboardnum);
  1264.           case a of
  1265.             letin:writeuser;
  1266.             bylevel:if all and (u.level>=curboard.level) then writeuser
  1267.           end;
  1268.           if break then exit
  1269.         end
  1270.       end;
  1271.  
  1272.     begin
  1273.       writestr (
  1274. 'List [A]ll users who have access, or only those with [S]pecial access? *');
  1275.       if length(input)=0 then exit;
  1276.       case upcase(input[1]) of
  1277.         'A':listacc (true);
  1278.         'S':listacc (false)
  1279.       end
  1280.     end;
  1281.  
  1282.     procedure getblevel;
  1283.     var b:bulrec;
  1284.     begin
  1285.       getbint ('level',curboard.level);
  1286.       writelog (5,12,strr(curboard.level))
  1287.     end;
  1288.  
  1289.    procedure getautodel;
  1290.     var b:bulrec;
  1291.     begin
  1292.       with curboard do begin
  1293.         getbint ('auto-delete',autodel);
  1294.         if autodel<10
  1295.           then
  1296.             begin
  1297.               writeln (^B'HEY!  It can''t be less than ten!');
  1298.               autodel:=numbuls+1;
  1299.               if autodel<10 then autodel:=10;
  1300.               writeln (^B'Setting autodelete to ',autodel);
  1301.               writecurboard
  1302.             end
  1303.           else
  1304.             if autodel<=numbuls
  1305.               then
  1306.                 begin
  1307.                   writeln (^B'Deleting message.');
  1308.                   while autodel<=numbuls do delbul (2,true)
  1309.                 end
  1310.       end;
  1311.       writelog (5,11,strr(curboard.autodel))
  1312.     end;
  1313.  
  1314.     procedure getfiletitle;
  1315.     var fn:integer;
  1316.         f:filerec;
  1317.     begin
  1318.       fn:=getfilenumber ('change the title of');
  1319.       if fn<>0 then begin
  1320.         seekffile (fn);
  1321.         read (ffile,f); che;
  1322.         writeln (^B'Old description: ',f.descrip);
  1323.         writestr ('New description [or CR]:');
  1324.         if length(input)>0 then begin
  1325.           f.descrip:=input;
  1326.           seekffile (fn);
  1327.           write (ffile,f);
  1328.           writelog (5,9,f.descrip)
  1329.         end
  1330.       end
  1331.     end;
  1332.  
  1333.     procedure movefile;
  1334.     var f:filerec;
  1335.         tcb:boardrec;
  1336.         tcbn,dbn,fn:integer;
  1337.         tcbname:sstr;
  1338.     begin
  1339.       writehdr ('File Move');
  1340.       fn:=getfilenumber ('move');
  1341.       if fn=0 then exit;
  1342.       seekffile (fn);
  1343.       read (ffile,f);
  1344.       writestr ('Move "'+f.descrip+'" to which board? *');
  1345.       if length(input)=0 then exit;
  1346.       tcb:=curboard;
  1347.       tcbn:=curboardnum;
  1348.       tcbname:=curboardname;
  1349.       dbn:=searchboard(input);
  1350.       if dbn=-1 then begin
  1351.         writeln ('No such board!');
  1352.         exit
  1353.       end;
  1354.       writeln ('Moving.');
  1355.       delfile (fn);
  1356.       close (bfile);
  1357.       close (ffile);
  1358.       seek (bdfile,dbn);
  1359.       read (bdfile,curboard);
  1360.       curboardnum:=dbn;
  1361.       curboardname:=curboard.shortname;
  1362.       openbfile;
  1363.       addfile (f);
  1364.       close (bfile);
  1365.       close (ffile);
  1366.       curboard:=tcb;
  1367.       curboardname:=tcbname;
  1368.       curboardnum:=tcbn;
  1369.       openbfile;
  1370.       writelog (5,6,f.descrip);
  1371.       writeln (^B'Done!')
  1372.     end;
  1373.  
  1374.     procedure movebulletin;
  1375.     var b:bulrec;
  1376.         tcb:boardrec;
  1377.         tcbn,dbn,bnum:integer;
  1378.         tcbname,dbname:sstr;
  1379.     begin
  1380.       writehdr ('Message Move');
  1381.       getbnum ('move');
  1382.       if not checkcurbul then exit;
  1383.       bnum:=curbul;
  1384.       seekbfile (bnum);
  1385.       read (bfile,b);
  1386.       writestr ('Move "'+b.title+'" posted by '+b.leftby+
  1387.         ' to which board? *');
  1388.       if length(input)=0 then exit;
  1389.       tcbname:=curboardname;
  1390.       dbname:=input;
  1391.       dbn:=searchboard(dbname);
  1392.       if dbn=-1 then begin
  1393.         writeln ('No such board!');
  1394.         exit
  1395.       end;
  1396.       writeln ('Moving.');
  1397.       delbul (bnum,false);
  1398.       close (bfile);
  1399.       close (ffile);
  1400.       curboardname:=dbname;
  1401.       openbfile;
  1402.       addbul (b);
  1403.       close (bfile);
  1404.       close (ffile);
  1405.       curboardname:=tcbname;
  1406.       openbfile;
  1407.       writelog (5,13,b.title);
  1408.       writeln (^B'Done!')
  1409.     end;
  1410.  
  1411.     procedure wipeoutfile;
  1412.     var un,fn:integer;
  1413.         f:filerec;
  1414.         q:file;
  1415.         n:mstr;
  1416.         u:userrec;
  1417.     begin
  1418.       writehdr ('File Wipe-out');
  1419.       fn:=getfilenumber ('wipe out');
  1420.       if fn=0 then exit;
  1421.       seekffile (fn);
  1422.       read (ffile,f);
  1423.       writestr ('Wipe out: "'+f.descrip+'" ? *');
  1424.       if not yes then exit;
  1425.       writestr ('Erase disk file '+f.fname+'? *');
  1426.       if yes then begin
  1427.         assign (q,f.fname);
  1428.         erase (q);
  1429.         un:=ioresult
  1430.       end;
  1431.       delfile (fn);
  1432.       writelog (5,7,f.descrip);
  1433.       n:=f.sentby;
  1434.       un:=lookupuser(n);
  1435.       if un<>0
  1436.         then
  1437.           begin
  1438.             seek (ufile,un);
  1439.             read (ufile,u);
  1440.             u.nup:=u.nup-1;
  1441.             writeln (n,' now has ',u.nup,' uploads.');
  1442.             seek (ufile,un);
  1443.             write (ufile,u)
  1444.           end
  1445.     end;
  1446.  
  1447.     procedure setsponsor;
  1448.     var un:integer;
  1449.         b:bulrec;
  1450.     begin
  1451.       writestr ('New sponsor:');
  1452.       if length(input)=0 then exit;
  1453.       un:=lookupuser (input);
  1454.       if un=0
  1455.         then writeln ('No such user.')
  1456.         else
  1457.           begin
  1458.             curboard.sponsor:=input;
  1459.             writelog (5,8,input);
  1460.             writecurboard
  1461.           end
  1462.     end;
  1463.  
  1464. {$I rename.pas}
  1465.     procedure killboard;
  1466.     var cnt:integer;
  1467.         f:file;
  1468.         fr:filerec;
  1469.         bd:boardrec;
  1470.     begin
  1471.       writestr ('Kill Board - You sure? [y/n]: *');
  1472.       if not yes then exit;
  1473.       writelog (5,10,'');
  1474.       writeln (^B^M'Deleting messages.');
  1475.       for cnt:=numbuls downto 1 do
  1476.         begin
  1477.           delbul(cnt,true);
  1478.           write (cnt,' ');
  1479.           messages:=messages-1;
  1480.           urec.lastmessages:=urec.lastmessages-1
  1481.         end;
  1482.       if messages<1 then messages:=1;
  1483.       if urec.lastmessages<1 then urec.lastmessages:=1;
  1484.       writeln (^B^M'Deleting files.');
  1485.       for cnt:=numfiles downto 1 do
  1486.         begin
  1487.           seekffile (cnt);
  1488.           read (ffile,fr);
  1489.           assign (f,fr.fname);
  1490.           erase (f);
  1491.           if ioresult<>0 then writeln (^B'Error erasing ',fr.fname);
  1492.           delfile (cnt);
  1493.           write (cnt,' ')
  1494.         end;
  1495.       writeln (^B^M'Deleting sub-board files.');
  1496.       close (bfile);
  1497.       assignbfile;
  1498.       erase (bfile);
  1499.       if ioresult<>0 then writeln (^B'Error erasing board file.');
  1500.       close (ffile);
  1501.       assignffile;
  1502.       erase (ffile);
  1503.       if ioresult<>0 then writeln (^B'Error erasing file directory file.');
  1504.       writeln (^M'Removing sub-board.');
  1505.       delboard (curboardnum);
  1506.       writeln (^B'Sub-board erased!');
  1507.       setfirstboard;
  1508.       q:=9
  1509.     end;
  1510.  
  1511.     procedure sortboards;
  1512.     var cnt,mark,temp:integer;
  1513.         bd1,bd2:boardrec;
  1514.         bn1,bn2:sstr;
  1515.         bo:boardorder;
  1516.     begin
  1517.       writestr ('Sort sub-boards: Are you sure? *');
  1518.       if not yes then exit;
  1519.       clearorder (bo);
  1520.       mark:=filesize(bdfile)-1;
  1521.       repeat
  1522.         if mark<>0 then begin
  1523.           temp:=mark;
  1524.           mark:=0;
  1525.           for cnt:=0 to temp-1 do begin
  1526.             seek (bifile,cnt);
  1527.             read (bifile,bn1);
  1528.             read (bifile,bn2);
  1529.             if upstring(bn1)>upstring(bn2) then begin
  1530.               mark:=cnt;
  1531.               switchboards (cnt,cnt+1,bo)
  1532.             end
  1533.           end
  1534.         end
  1535.       until mark=0;
  1536.       carryout (bo);
  1537.       writelog (5,16,'');
  1538.       setfirstboard;
  1539.       q:=9
  1540.     end;
  1541.  
  1542. (* {$I netmail.pas}
  1543.  
  1544. procedure netmailprocess;
  1545.  
  1546. var ib,ib2,ib3:integer;
  1547.     fit:bulrec;
  1548.     f5:file of bulrec;
  1549.     hardf:file of message;
  1550.     textf:message;
  1551.     filename:mstr;
  1552.     filename2:mstr;
  1553.     fl1,fl2:sstr;
  1554.     curb:boardrec;
  1555.     f1,f2:text;
  1556.  
  1557. begin
  1558.       if (curboard.net>0) and (usenet) and (featurea) then
  1559. begin writeln (^R'Subboard doesn''t support CelerityNet!');
  1560. exit;
  1561. end;
  1562.       if (curboard.net>0) and (usenet) and (featurea) then
  1563. begin writeln (^R'Configuration doesn''t use CelerityNet!');
  1564. exit;
  1565. end;
  1566. {writestr('Have you switched to the proper area to receive? *');
  1567. if yes then
  1568.   begin}
  1569.     writeln ('Current Bulletin :'^S,curbul);
  1570.     writeln ('Last Bulletin    :'^S,numbuls);
  1571.     writeln;
  1572.    {buflen:=7;
  1573.     writestr('Enter FAQpaket filename to process : *');
  1574.     if (length(input)>0) then}
  1575.          {filename:='C'+strr(conn)+copy(curboardname,1,6);}
  1576.           filename:=strr(conn)+'NET'+curboard.shortname;
  1577.           filename2:='NETRECV'+strr(conn);
  1578.           begin
  1579.               writeln('Please wait - removing compression/encosion on file');
  1580.               extractzip(networkdir+filename2+'.ZIP','','');
  1581.               fl1:=networkdir+filename+'.SQ'+strr(conn);
  1582.               fl2:=networkdir+filename+'.ME'+strr(conn);
  1583.               assign(f5,networkdir+filename+'.SQ'+strr(conn));
  1584.               assign(hardf,networkdir+filename+'.ME'+strr(conn));
  1585.                  {$i-}
  1586.                  if exist(fl1) then erase(f5);
  1587.                  reset(f5);
  1588.                  {$i+}
  1589.  
  1590.                  if ioresult<>0 then
  1591.                   begin
  1592.                    writeln('File not found.');
  1593.                    exit;
  1594.                   end;
  1595.                   {$i-}
  1596.                   if exist(fl2) then erase(hardf);
  1597.                   reset(hardf);
  1598.                   {$i+}
  1599.                   if ioresult<>0 then
  1600.                   begin
  1601.                    writeln('File not found.');
  1602.                    exit;
  1603.                   end;
  1604.                  writeln(^R'Please wait - Processing FAQNet-paket for Sub '^P'['^S+curboard.shortname+^P']'^R'.');
  1605.                  while not eof(f5) do
  1606.                    begin
  1607.                     read(f5,b);
  1608.                     read(hardf,textf);
  1609.                     b.line:=maketext(textf);
  1610.                     addbul(b);
  1611.                    end;
  1612.                  close(f5);
  1613.                  close(hardf);
  1614.                  writeln(^R'FAQNet package for Sub '^P'['^S+curboardname+^P']'^R' processed.');
  1615.                  assign (f1,networkdir+filename+'.SQ'+strr(conn));
  1616.                  assign (f2,networkdir+filename+'.ME'+strr(conn));
  1617.                  reset (f1);
  1618.                  reset (f2);
  1619.                  rewrite (f1);
  1620.                  rewrite (f2);
  1621.                  erase (f1);
  1622.                  erase (f2);
  1623.                  textclose (f1);
  1624.                  textclose (f2);
  1625.                Writestr('Do you wish to remove the FAQpaket file from your system? *');
  1626.                if yes then
  1627.             begin
  1628.                assign (f1,networkdir+filename2+'.ZIP');
  1629.                reset (f1);
  1630.                rewrite (f1);
  1631.                erase (f1);
  1632.                textclose (f1);
  1633.             end;
  1634.           end;
  1635.  {end
  1636.   else writeln('FAQpaket processing stopped.');}
  1637. end;
  1638.  
  1639. {procedure netmail;
  1640.  
  1641. var ch:char;
  1642.  
  1643. begin
  1644. writehdr ('Netmail');
  1645. writeln (^P'['^S'1'^P']'^R' Process a FAQ-Paket netmail package to transmit.');
  1646. writeln (^P'['^S'2'^P']'^R' Process a FAQ-Paket netmail package already recieved.');
  1647. writeln (^P'['^S'3'^P']'^R' FAQ-Packet System Update.');
  1648. writeln;
  1649. writestr('Please make your choice [C/R]:*');
  1650. if (length(input)>0) then
  1651.  begin
  1652.   if (not sponsoron) and (not issysop) then begin
  1653.   writeln('Invalid Command.');
  1654.   exit;
  1655.   end;
  1656.  ch:=upcase(input[1]);
  1657.  case ch of
  1658.         '1':netmailsend;
  1659.         '2':netmailprocess;
  1660.         '3':systemlist;
  1661.        end;
  1662.  end;
  1663. end;} *)
  1664.  
  1665.     procedure orderboards;
  1666.     var numb,curb,newb:integer;
  1667.         bo:boardorder;
  1668.     label exit;
  1669.     begin
  1670.       clearorder (bo);
  1671.       writehdr ('Re-order sub-boards');
  1672.       numb:=filesize (bdfile);
  1673.       thereare (numb,'sub-board','sub-boards');
  1674.       for curb:=0 to numb-2 do begin
  1675.         repeat
  1676.           writestr ('New Board #'+strr(curb+1)+' [?/List, CR/Quit]:');
  1677.           if length(input)=0 then goto exit;
  1678.           if input='?'
  1679.             then
  1680.               begin
  1681.                 listboards;
  1682.                 newb:=-1
  1683.               end
  1684.             else
  1685.               begin
  1686.                 newb:=searchboard(input);
  1687.                 if newb<0 then writeln ('Not found!  Please re-enter.')
  1688.               end
  1689.         until (newb>=0);
  1690.         switchboards (curb,newb,bo)
  1691.       end;
  1692.       exit:
  1693.       carryout (bo);
  1694.       writelog (5,14,'');
  1695.       q:=9;
  1696.       setfirstboard
  1697.     end;
  1698.  
  1699.     procedure addresident;
  1700.     var f:filerec;
  1701.     begin
  1702.       writestr ('Filename (including path):');
  1703.       if hungupon or (length(input)=0) then exit;
  1704.       if devicename(input) then begin
  1705.         writeln ('That''s a DOS device name!!');
  1706.         exit
  1707.       end;
  1708.       if not exist(input) then begin
  1709.         writeln ('File not found.');
  1710.         exit
  1711.       end;
  1712.       f.sentby:=unam;
  1713.       f.fname:=input;
  1714.       writestr ('Description:');
  1715.       if length(input)=0 then exit;
  1716.       f.descrip:=input;
  1717.       f.downloaded:=0;
  1718.       f.when:=now;
  1719.       addfile (f);
  1720.       writelog (5,15,f.fname)
  1721.     end;
  1722.  
  1723.   begin
  1724.     if (not sponsoron) and (not issysop) then begin
  1725.       writeln ('Nice try, but you aren''t the sponsor.');
  1726.       exit
  1727.     end;
  1728.     writelog (4,3,curboard.boardname+' ['+curboard.shortname+']');
  1729.     repeat
  1730.       q:=menu ('Message Base Sponsor','SPONSOR','DLSTMWUEQRKCNBOVF[]PYZ*?');
  1731.       case q of                                               (* |  |  *)
  1732.       {  1:getautodel;
  1733.         2:getblevel;
  1734.         3:setsponsor; }
  1735.         4:getfiletitle;
  1736.         5:movefile;
  1737.         6:wipeoutfile;
  1738.         7:setnameaccess;
  1739.         8:setallaccess;
  1740.         10:modboard; {renameboard;}
  1741.         11:killboard;
  1742.         12:sortboards;
  1743.         13:movebulletin;
  1744.         14:orderboards;
  1745.         15:listaccess;
  1746.         16:addresident;
  1747.         17:begin
  1748.             writestr ('Current Posts ['+strr(urec.nbu)+']: &');
  1749.             if length(input)>0 then urec.nbu:=valu(input);
  1750.             writeurec;
  1751.            end;
  1752.        {18:netmailsend;
  1753.         19:netmailprocess;
  1754.         20:systemlist;}
  1755.        {21:setanon;
  1756.         22:setnet;}
  1757.         23:activeboard;
  1758.         24:begin
  1759. writeln ('C╔═════════════════════════════════════╗Hs');
  1760. writeln ('uC║ Message Base Sponsor Section        ║Hs');
  1761. writeln ('uC╚═════════════════════════════════════╝HHC╔═════s');
  1762. writeln ('u════════════════════════════════╗HC║ [B]  s');
  1763. writeln ('uRe-Order Sub-Boards            ║HC║ [Cs');
  1764. writeln ('u]  Sort Sub-Boards                ║HC║ [s');
  1765. writeln ('uE]  Set All Access                 ║Hs');
  1766. writeln ('uC║ [F]  Change # of Posts              s');
  1767. writeln ('u║HC║ [K]  Kill Sub-Boards               s');
  1768. writeln ('u ║HC║ [M]  Move a File             s');
  1769. writeln ('u       ║HC║ [N]  Move Message      s');
  1770. writeln ('u             ║HC║ [O]  List Sub-Boas');
  1771. writeln ('urd Access          ║HC║ [Q]  Quit  s');
  1772. writeln ('u                 ╔════════════════════════════════════s');
  1773. writeln ('u═╗HC║ [R]  Re-Configure Sub-Boars');
  1774. writeln ('u║ [V]  Add Resident File             s');
  1775. writeln ('u ║HC║ [T]  Change File Titls');
  1776. writeln ('ue      ║ [W]  Delete File              s');
  1777. writeln ('u      ║HC║ [U]  Set Name Acs');
  1778. writeln ('ucess        ║ [*]  Change Active Sub-Bos');
  1779. writeln ('uard        ║HC╚═══════════════════════════s');
  1780. writeln ('u══║ [?]  View This Menu                s');
  1781. writeln ('u ║HC╚═════════════════════════════════════╝');
  1782. writeln;
  1783. pause;
  1784.            end;
  1785.  
  1786.       end
  1787.     until (q=9) or hungupon
  1788.   end;
  1789.  
  1790.   var beenaborted:boolean;
  1791.  
  1792.   function aborted:boolean;
  1793.   begin
  1794.     if beenaborted then begin
  1795.       aborted:=true;
  1796.       exit
  1797.     end;
  1798.     aborted:=xpressed or hungupon;
  1799.     if xpressed then begin
  1800.       beenaborted:=true;
  1801.       writeln (^B'Message Newscan Aborted!')
  1802.     end
  1803.   end;
  1804.  
  1805.   Function capfir(inString:STRING):char;
  1806.  begin
  1807.    capfir:=upcase(inString[1]);
  1808.  end;
  1809.  
  1810.  
  1811.   procedure newscanboard;
  1812.  
  1813.     function getnumnum(title:lstr):integer;
  1814. var reprep      :byte;
  1815.     startpoint  :byte;
  1816.     endpoint    :byte;
  1817.     a           :string[1];
  1818. begin
  1819.    reprep    :=79;
  1820.    startpoint:=0;
  1821.    endpoint  :=0;
  1822.    getnumnum :=0;
  1823.   repeat
  1824.    a:=copy (title,reprep,1);
  1825.    if a='#' then
  1826.      begin;
  1827.        startpoint:=reprep;
  1828.          repeat
  1829.            if valu(copy(title,reprep,1))>0 then endpoint:=reprep;
  1830.            inc(reprep);
  1831.          until (reprep>=79);
  1832.      end;
  1833.    if (startpoint>0) and (endpoint>0) then
  1834.       begin
  1835.         dec(endpoint,startpoint);
  1836.         getnumnum:=valu(copy(title,startpoint+1,endpoint));
  1837.         exit;
  1838.       end;
  1839.     dec(reprep);
  1840.   until reprep<=0
  1841. end;
  1842.  
  1843. function gettitle(title:lstr;reply:word):lstr;
  1844. var search   :boolean;
  1845.     srcstr   :sstr;
  1846.     cursrc   :word;
  1847.     tit      :lstr;
  1848. begin
  1849.  
  1850.    srcstr  :=' [Reply #';
  1851.    search  :=false;
  1852.    tit     :='';
  1853.    cursrc  :=0;
  1854.  
  1855.    repeat
  1856.     if copy(title,cursrc,length(srcstr))=srcstr then
  1857.       begin;
  1858.         tit:=copy(title,1,cursrc-1);
  1859.         gettitle:=tit+' [Reply #'+strr(reply)+']';
  1860.         exit;
  1861.       end;
  1862.  
  1863.     if cursrc=79 then
  1864.       begin
  1865.         gettitle:=title+' [Reply #'+strr(reply)+']';
  1866.         exit;
  1867.       end;
  1868.     inc(cursrc);
  1869.    until cursrc=80;
  1870. end;
  1871.  
  1872.     procedure shownewfiles;
  1873.     var cnt,first,numf:integer;
  1874.         f:filerec;
  1875.         nf:boolean;
  1876.     begin
  1877.       numf:=numfiles;
  1878.       cnt:=numf;
  1879.       nf:=true;
  1880.       while (cnt>0) and nf do begin
  1881.         seekffile (cnt);
  1882.         read (ffile,f);
  1883.         nf:=f.when>xlaston;
  1884.         if nf then cnt:=cnt-1
  1885.       end;
  1886.       first:=cnt+1;
  1887.       if first>numf then exit;
  1888.       writehdr ('New Files');
  1889.       if aborted or break then exit;
  1890.       for cnt:=first to numf do begin
  1891.         seekffile (cnt);
  1892.         read (ffile,f);
  1893.         writeln (^S,cnt,'. '^R,f.descrip);
  1894.         if aborted or break then exit
  1895.       end
  1896.     end;
  1897.  
  1898.   var newmsgs,oldb:boolean;
  1899.       q:anystr;
  1900.       wock:char;
  1901.       wock2:word;
  1902.       m,me:message;
  1903.       l,stonerslive,swash:integer;
  1904.       t:sstr;
  1905.       fcpiskool:mstr;
  1906.       repnumber:word;
  1907.       lameo    :string;
  1908.   begin
  1909.     beenaborted:=false;
  1910.     newmsgs:=false;
  1911.     curbul:=lastreadnum+1;
  1912.     while curbul<=numbuls do begin
  1913.       getbrec;
  1914.       if b.when>laston then begin
  1915.         readnum (curbul);
  1916.         newmsgs:=true;
  1917.       if (not cscan) then
  1918.       repeat
  1919.        wock:='N';
  1920.        writestr (^P'Message Newscan Command ['^S'?/Help'^P']['^S'CR/Next'^P']: *');
  1921.        if length(input)<1 then input:='N';
  1922.        wock:=upcase(input[1]);
  1923.        wock2:=valu(input);
  1924.        if wock2>0 then begin
  1925.         if wock2<=numbuls then begin
  1926.          curbul:=wock2;
  1927.          readnum (curbul);
  1928.         end;
  1929.        end else
  1930.         wock:=upcase(wock);
  1931.         case wock of
  1932.          '?':begin
  1933.               writeln;
  1934.               writeln (^S'                 -Newscan Help-'^R^M);
  1935.               writeln ('[N]: Next Message          [#]: Read that Message #');
  1936.               writeln ('[A]: Read Message Again    [R]: Reply to Message');
  1937.               writeln ('[D]: Delete Message        [P]: Post a Message');
  1938.               writeln ('[B]: Next Sub-board        [/]: Toggle Auto-Scan');
  1939.               if (match(unam,b.leftby)) or (issysop) or (sponsoron)
  1940.               then write ('[E]: Edit Message          ');
  1941.               writeln ('[Q]: Quit Newscan');
  1942.               writeln;
  1943.              end;
  1944.          'A':begin
  1945.               if checkcurbul then begin
  1946.                getbrec;
  1947.                if ((ansigraphics in urec.config) and (not cscan)) then begin
  1948.                 write (#27+'[2J');
  1949.                 clrscr;
  1950.                end;
  1951.                writeln (^R'[Current Board: '^S,curboard.boardname,^R']'^M);
  1952.                write   (^B^P'Message: '^S);
  1953.                fcpiskool:=^S+strr(curbul)+' of '+strr(numbuls);
  1954.                write (fcpiskool);
  1955.                for stonerslive:=1 to 25-(length(fcpiskool)) do
  1956.                write (' ');
  1957.                if issysop or (not b.anon) then
  1958.                writeln (^P'When: '^S,datestr(b.when),^P' at '^S,timestr(b.when),^R);
  1959.                writeln (^B^P'Subject: '^S,b.title);
  1960.                write   (^B^P'To:      '^S,b.leftto);
  1961.                if (b.recieved) then begin
  1962.                 for swash:=1 to 25-(length(b.leftto)+3) do
  1963.                 write (' ');
  1964.                 write (^P'-Recieved-'^R);
  1965.                end;
  1966.                writeln;
  1967.                q:=^P'From:    '^S;
  1968.                if b.anon
  1969.                  then
  1970.                    begin
  1971.                      q:=q+anonymousstr;
  1972.                      if (issysop) or (ulvl>=readanonlvl) then q:=q+' ['+b.leftby+']'
  1973.                    end
  1974.                  else
  1975.                    begin
  1976.                      if b.plevel=-1
  1977.                        then t:='Unknown'
  1978.                        else t:=strr(b.plevel);
  1979.                     q:=q+b.leftby+' (Level '+t+') '+b.status;
  1980.                    end;
  1981.                writeln (q);
  1982.                ansicolor (urec.regularcolor);
  1983.                if break then exit;
  1984.                printtext (b.line);
  1985.                end;
  1986.               end;
  1987.          'P':begin
  1988.               postbul;
  1989.              end;
  1990.          'D':begin
  1991.               reading:=true;
  1992.               killbul;
  1993.               curbul:=curbul-1;
  1994.               reading:=false;
  1995.              end;
  1996.          'R':begin
  1997.               if ulvl<postlevel then begin
  1998.                 reqlevel(postlevel);
  1999.                 exit
  2000.               end;
  2001.               emailing:=true;
  2002.               notitle:=true;
  2003.               l:=editor(m,true,'');
  2004.               lameo:=b.leftby;
  2005.               if l>=0 then
  2006.                 begin
  2007.                   inc(urec.nbu);
  2008.                   writeurec;
  2009.                   if messages>32760 then messages:=0;
  2010.                   inc(messages);
  2011.                   b.anon:=m.anon;
  2012.                   repnumber:=getnumnum(b.title);
  2013.                   inc(repnumber);
  2014.                   b.title:=gettitle(b.title,repnumber);
  2015.                   b.when:=now;
  2016.                   b.leftto:=lameo;
  2017.                   b.leftby:=unam;
  2018.                   b.status:='['+urec.note+']';
  2019.                   if sponsoron then b.status:=b.status+' [Sponsor]';
  2020.                   b.line:=l;
  2021.                   b.plevel:=ulvl;
  2022.                   addbul (b);
  2023.                   inc(newposts);
  2024.                    with curboard do
  2025.                     if autodel<=numbuls then autodelete
  2026.                 end
  2027.              end;
  2028.          'E':begin
  2029.               if checkcurbul then begin
  2030.               if (not match(b.leftby,unam)) and (not issysop) and (not sponsoron)
  2031.                 then begin
  2032.                   writeln ('You didn''t post that!');
  2033.                 end
  2034.               else begin
  2035.               reloadtext (b.line,me);
  2036.               me.title:=b.title;
  2037.               me.anon:=b.anon;
  2038.               if reedit (me,true) then begin
  2039.                 writelog (4,6,b.title);
  2040.                 deletetext (b.line);
  2041.                 b.line:=maketext (me);
  2042.                 if b.line<0 then begin
  2043.                   writestr (^M'Deleting message.');
  2044.                   delbul (curbul,false)
  2045.                 end else begin
  2046.                   seekbfile (curbul);
  2047.                   write (bfile,b)
  2048.                  end
  2049.                 end
  2050.                end;
  2051.               end;
  2052.              end;
  2053.          'B':exit;
  2054.          '/':togglecscan;
  2055.          'Q':begin
  2056.               quitmasterinc:=true;
  2057.               exit;
  2058.              end;
  2059.        end;
  2060.       until wock in ['N'];
  2061.       end;
  2062.       curbul:=curbul+1;
  2063.      if aborted then exit;
  2064.     end;
  2065.      shownewfiles;
  2066.     if (postprompts in urec.config) and newmsgs and (ulvl>=postlevel)
  2067.       then begin
  2068.         writestr (^M'Post on '^S+curboard.boardname+^P'? [Y/N]: *');
  2069.         writeln;
  2070.         if yes then postbul
  2071.       end
  2072.   end;
  2073.  
  2074.   procedure newscanall;
  2075.   var cb:integer;
  2076.   begin
  2077.     beenaborted:=false;
  2078.     writeln (^R'Newscanning All Boards.  ['^S'X'^R'] will abort.'^M);
  2079.     if aborted then exit;
  2080.     for cb:=0 to filesize(bdfile)-1 do begin
  2081.       if aborted then exit;
  2082.       if haveaccess(cb) and (not (cb in urec.newscanconfig)) then begin
  2083.         curboardname:=curboard.shortname;
  2084.         openbfile;
  2085.         if aborted then exit;
  2086.         writeln (^R+curboard.boardname+^P' ['^S+curboard.shortname+^P']');
  2087.         if aborted then exit;
  2088.         newscanboard;
  2089.         if quitmasterinc then begin
  2090.          quitmasterinc:=false;
  2091.      writeln (^B^M'Newscan aborted!'^G);
  2092.          exit;
  2093.         end
  2094.       end
  2095.     end;
  2096.     writeln (^B^M'Newscan complete!'^G);
  2097.     setfirstboard
  2098.   end;
  2099.  
  2100.   procedure getconpw;
  2101.   begin
  2102.       if (length(confmpw[1])>0) and (conn=1) and not (issysop) then begin
  2103.         echodot:=true;
  2104.         writestr (^M^P'['^R'Conference #1 Password'^P']: *');
  2105.         echodot:=false;
  2106.         if not (match(input,confmpw[1])) then begin exit; exit; end;
  2107.       end;
  2108.       if (length(confmpw[2])>0) and (conn=2) and not (issysop) then begin
  2109.         echodot:=true;
  2110.         writestr (^M^P'['^R'Conference #2 Password'^P']: *');
  2111.         echodot:=false;
  2112.         if not (match(input,confmpw[2])) then begin exit; exit; end;
  2113.       end;
  2114.       if (length(confmpw[3])>0) and (conn=3) and not (issysop) then begin
  2115.         echodot:=true;
  2116.         writestr (^M^P'['^R'Conference #3 Password'^P']: *');
  2117.         echodot:=false;
  2118.         if not (match(input,confmpw[3])) then begin exit; exit; end;
  2119.       end;
  2120.       if (length(confmpw[4])>0) and (conn=4) and not (issysop) then begin
  2121.         echodot:=true;
  2122.         writestr (^M^P'['^R'Conference #4 Password'^P']: *');
  2123.         echodot:=false;
  2124.         if not (match(input,confmpw[4])) then begin exit; exit; end;
  2125.       end;
  2126.       if (length(confmpw[5])>0) and (conn=5) and not (issysop) then begin
  2127.         echodot:=true;
  2128.         writestr (^M^P'['^R'Conference #5 Password'^P']: *');
  2129.         echodot:=false;
  2130.         if not (match(input,confmpw[5])) then begin exit; exit; end;
  2131.       end;
  2132.   end;
  2133.  
  2134.   procedure noboards;
  2135.   begin
  2136.     writeln ('No sub-boards exist!');
  2137.     if not issysop then exit;
  2138.     writestr ('Create the first sub-board now? [y/n]: *');
  2139.     if not yes then exit;
  2140.     writestr ('Enter its access name/number:');
  2141.     if not validbname(input) then writeln (^B'Invalid board name!') else begin
  2142.       curboardname:=input;
  2143.       makeboard
  2144.     end
  2145.   end;
  2146.  
  2147.   procedure togglenewscan;
  2148.   begin
  2149.     write ('Newscan this board: ');
  2150.     if curboardnum in urec.newscanconfig
  2151.       then
  2152.         begin
  2153.           writeln ('Yes');
  2154.           urec.newscanconfig:=urec.newscanconfig-[curboardnum]
  2155.         end
  2156.       else
  2157.         begin
  2158.           writeln ('No');
  2159.           urec.newscanconfig:=urec.newscanconfig+[curboardnum]
  2160.         end
  2161.   end;
  2162.  
  2163.   procedure nextsubboard;
  2164.   var cb:integer;
  2165.       obn:sstr;
  2166.   begin
  2167.     obn:=curboardname;
  2168.     cb:=curboardnum;
  2169.     while cb<filesize(bdfile)-1 do begin
  2170.       cb:=cb+1;
  2171.       if haveaccess (cb) then begin
  2172.         seek (bifile,cb);
  2173.         read (bifile,obn);
  2174.         setactive (obn,true);
  2175.         exit
  2176.       end
  2177.     end;
  2178.     writestr ('This is the last sub-board!');
  2179.     setactive (obn,true)
  2180.   end;
  2181.  
  2182.   procedure listusersaxis;
  2183.  
  2184.       procedure listacc (all:boolean);
  2185.       var cnt:integer;
  2186.           a:accesstype;
  2187.           u:userrec;
  2188.  
  2189.       begin
  2190.         seek (ufile,1);
  2191.         for cnt:=1 to numusers do begin
  2192.           read (ufile,u);
  2193.           a:=getuseraccflag (u,curboardnum);
  2194.           case a of
  2195.             letin:writeln (^S,u.handle,^R);
  2196.             bylevel:if u.level>=curboard.level then writeln (^S,u.handle,^R);
  2197.           end;
  2198.           if break then exit
  2199.         end
  2200.       end;
  2201.  
  2202.     begin
  2203.      if ulvl<listuserlvl then Begin reqlevel (listuserlvl); Exit; End;
  2204.      writehdr ('List Users with Board Access');
  2205.      writeln;
  2206.      writeln (^R'Users with access to ['^S+curboard.boardname+^R']:');
  2207.      writeln;
  2208.      listacc (true);
  2209.     end;
  2210.  
  2211.   procedure uploadbul;
  2212.   var l:integer;
  2213.       m:message;
  2214.       b:bulrec;
  2215.       pr:char;
  2216.       t,s:mstr;
  2217.       uf:text;
  2218.       ds:longint;
  2219.   begin
  2220.     if ulvl<postlevel then begin
  2221.       reqlevel(postlevel);
  2222.       exit
  2223.     end;
  2224.     ds:=diskfree(0);
  2225.     ds:=ds div 1000;
  2226.     if ds<10 then begin
  2227.      writeln;
  2228.      writeln ('There is only '+strr(ds)+'K disk space left.');
  2229.      writestr ('Are you sure you want to post? *');
  2230.      if not yes then exit else
  2231.     end;
  2232.     assign (uf,'receive.');
  2233.     if exist ('receive.') then erase(uf);
  2234.     writehdr ('Message Upload');
  2235.     writeln (^S'Message Upload: Zmodem/Ymodem-G Uploads Only!');
  2236.     writestr (^M'Subject: &');
  2237.     if length(input)=0 then exit;
  2238.     s:=input;
  2239.     t:='All';
  2240.     Writestr ('To [CR/All]: &');
  2241.     if length(input)>0 then t:=input;
  2242.         with curboard do
  2243.         if anony then begin
  2244.         buflen:=1;
  2245.     writestr ('Anonymous? [y/n]: *');
  2246.         b.anon:=yes
  2247.       end;
  2248.     writestr ('Zmodem or Ymodem-G [Z,Y  A,Q/Quit]: *');
  2249.     if upcase (input[1])='Z' then pr:='Z' else if upcase (input[1])='G'
  2250.     then pr:='G';
  2251.     if (upcase (input[1])='A') or (upcase(input[1])='Q') then exit;
  2252.     writeln (^M^S'Ready to receive Message Upload.');
  2253.     if pr='Z' then
  2254.     exec (GetEnv('COMSPEC'),'/C dsz port '+strr(usecom)+' speed '+strr(baudrate)+' rz receive.') else
  2255.     if pr='G' then
  2256.     exec (GetEnv('COMSPEC'),'/C dsz port '+strr(usecom)+' speed '+strr(baudrate)+' rb -g receive.');
  2257.     reset (uf);
  2258.     if ioresult<>0 then begin
  2259.      writeln (^M^S'Message upload error!'^M);
  2260.      textclose(uf);
  2261.      exit;
  2262.     end;
  2263.      m.numlines:=0;
  2264.       while not eof(uf) and (m.numlines<100) do begin
  2265.         inc(m.numlines);
  2266.         readln(uf,m.text[m.numlines]);
  2267.       end;
  2268.      if m.numlines<=1 then begin
  2269.       writeln (^M^S'Message upload error!'^M);
  2270.       textclose(uf);
  2271.       exit;
  2272.      end;
  2273.       begin
  2274.         inc(urec.nbu);
  2275.         writeurec;
  2276.         b.title:=s;
  2277.         b.when:=now;
  2278.         b.leftto:=t;
  2279.         b.leftby:=unam;
  2280.         b.status:=urec.note;
  2281.         b.plevel:=ulvl;
  2282.         b.recieved:=false;
  2283.         b.line:=maketext(m);
  2284.         if m.numlines>1 then addbul (b);
  2285.         inc(newposts);
  2286.         inc(messages);
  2287.         if messages>32767 then messages:=0;
  2288.         textclose (uf);
  2289.         erase (uf);
  2290.         writehdr ('Message Added!');
  2291.         writeln ('Total Lines: '^S,m.numlines);
  2292.         with curboard do
  2293.           if autodel<=numbuls then autodelete
  2294.       end;
  2295.   end;
  2296.  
  2297. var boo:boolean;
  2298. label exit1;
  2299. begin
  2300.   cursection:=bulletinsysop;
  2301.   reading:=false;
  2302.   quitmasterinc:=false;
  2303.   cscan:=false;
  2304.   getconpw;
  2305.   openbdfile;
  2306.   if filesize(bdfile)=0 then begin
  2307.     noboards;
  2308.     if filesize(bdfile)=0 then begin
  2309.       closebdfile;
  2310.       goto exit1
  2311.     end
  2312.   end;
  2313.   if not haveaccess(0)
  2314.     then
  2315.       begin
  2316.         writeln (^B'You do not have access to the first sub-board!');
  2317.         closebdfile;
  2318.         goto exit1
  2319.       end;
  2320.   if exist(textfiledir+'MSGNEWS.'+strr(conn)) then begin
  2321.   printfile (textfiledir+'MSGNEWS.'+strr(conn));
  2322. pause;
  2323.   end;
  2324.       if ansi then ansicls;
  2325.   setfirstboard;
  2326.   repeat
  2327.     boo:=checkcurbul;
  2328.     with curboard do
  2329.       {+' '+boardname,^R' ['^S,shortname,^R']: '}
  2330.       write (^B);
  2331.       writeln (^R'Conference #'^S+strr(conn)+' '+curboard.boardname+^P' ['^S+curboard.shortname+^P']');
  2332.     if sponsoron or issysop
  2333.       then writeln (^R'['^S'%'^R']:Board Sponsor Commands');
  2334.       writeln (^R'Bulletin '^S,curbul,^R' of '^S,numbuls);
  2335.     q:=menu ('Message Base <'+curboard.shortname+'-'+strr(curbul)+'/'+strr(numbuls)+
  2336.              '>','MSG','PRDFUKT*MQ#_%LNBAVCES+WG!Z?');
  2337.     case q of
  2338.       1:postbul;
  2339.       2:readbul;
  2340.       3:{downloadfile};
  2341.       4,22:sendmailto (curboard.sponsor,false);
  2342.       5:uploadbul{uploadfile};
  2343.       6:killbul;
  2344.       8,16,17:activeboard;
  2345.       7:listbuls;
  2346.       9:sendbreply;
  2347.       12:if not hungupon then readnextbul;
  2348.       13:boardsponsor;
  2349.       14:{listfiles};
  2350.       15:newscanall;
  2351.       18:newscanboard;
  2352.       19:togglenewscan;
  2353.       20:editbul;
  2354.       21:nextsubboard;
  2355.       22:readnum (lastreadnum+1);
  2356.       23:offfaq;
  2357.       24:listusersaxis;
  2358.       25:togglecscan;
  2359.       27:begin
  2360. writeln('C╔═════════════════════════════════════╗Hs');
  2361. writeln('uC║ Message Base Section                ║Hs');
  2362. writeln('uC╚═════════════════════════════════════╝HHC╔══s');
  2363. writeln('u═══════════════════════════════════╗HC║ [A]  s');
  2364. writeln('uChange Active Sub-Board        ║HC║ [Cs');
  2365. writeln('u]  Change Newscan on Sub          ║HC║ [s');
  2366. writeln('uE]  Edit Message                   ║Hs');
  2367. writeln('uC║ [G]  Log off BBS            ╔═════s');
  2368. writeln('u════════════════════════════════╗1HC║ [Ks');
  2369. writeln('u]  Kill Message           ║ [U]  s');
  2370. writeln('uUpload Text File               ║1HC║ s');
  2371. writeln('u[M]  Send Reply to Message  ║ [Vs');
  2372. writeln('u]  Newscan Current Sub-Board      ║1HCs');
  2373. writeln('u║ [N]  Newscan All Sub-Boards ║ [s');
  2374. writeln('uW]  Read Next Message              ║1Hs');
  2375. writeln('uC║ [P]  Post Message           s');
  2376. writeln('u║ [Z]  Change Auto-Scan               ');
  2377. writeln('1HC║ [Q]  Quit                   s');
  2378. writeln('u║ [#]  Read Message #                 ');
  2379. writeln('1HC║ [R]  Read Message(s)        s');
  2380. writeln('u║ [%]  Message Sponsor Section        ');
  2381. writeln('1HC║ [S]  Send Mail to Sponsor   s');
  2382. writeln('u║ [+]  Next Sub-Board                 ');
  2383. writeln('1HC║ [T]  List Messages          s');
  2384. writeln('u║ [!]  List Users with Access         ');
  2385. writeln('1HC╚═════════════════════════════║ [Cs');
  2386. writeln('uRRead Next Message              ║1HC║s');
  2387. writeln('u [?]  View This Menu                 ');
  2388. writeln('1HC╚═════════════════════════════════════╝');
  2389. writeln;
  2390. pause;
  2391.            end;
  2392.      else if q<0 then readnum (-q)
  2393.     end
  2394.   until (q=10) or hungupon or (filesize(bdfile)=0);
  2395.   exit1:
  2396.   close (bfile);
  2397.   close (ffile);
  2398.   closebdfile
  2399. end;
  2400.  
  2401. begin
  2402. end.
  2403.