Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/FAQ-S.ZIP/MSG.PAS

Pascal/Delphi Source File | 1991-05-04 | 67.2 KB | 2,403 lines

{$R-,S-,I-,D-,F+,V-,B-,N-,O+ }
{$M 65500,0,0 }

unit msg;

interface

uses crt,dos,overlay,
     gentypes,configrt,statret,gensubs,subs1,subs2,subs3,
     userret,textret,mainr1,mainr2,overret1,flags,mainmenu,modem;

procedure messagemenu;

implementation

procedure messagemenu;
var q,curbul,lastreadnum:integer;
    b:bulrec;
    reading,quitmasterinc,cscan:boolean;

  procedure togglecscan;
  begin
   if cscan then cscan:=false else
    cscan:=true;
   writeln;
   write (^R'Auto-Scan is now: '^S);
   if cscan then writeln ('On') else writeln ('Off');
   writeln;
  end;

  procedure makeboard; forward;

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

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

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

    procedure doone;
    var cnt,q:integer;
        ns,a1,a2:set of byte;
    begin
      fillchar (ns,32,0);
      fillchar (a1,32,0);
      fillchar (a2,32,0);
      for cnt:=0 to 255 do begin
        q:=bo[cnt];
        if q 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 setfirstboard; forward;

  procedure seekffile (n:integer);
  begin
    seek (ffile,n-1)
  end;

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

  procedure assignffile;
  begin
    assign (ffile,datadir+copy(curboardname,1,8)+'.FI'+strr(conn));
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;
      b:bulrec;
      lr:word;
  begin
    lastreadnum:=numbuls;
    oldb:=false;
    lr:=urec.lastread[curboardnum];
    if lr=0
      then lastreadnum:=0
      else
        while (lastreadnum>0) and (not oldb) do begin
          seekbfile (lastreadnum);
          read (bfile,b);
          oldb:=b.id=lr;
          if not oldb then lastreadnum:=lastreadnum-1
        end
  end;

  procedure assignbfile;
  begin
    assign (bfile,datadir+copy(curboardname,1,8)+'.MS'+strr(conn));
  end;

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

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

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

  procedure addbul (var b:bulrec);
  var b2:bulrec;
  begin
    if numbuls=0 then b.id:=1 else begin
      seekbfile (numbuls);
      read (bfile,b2);
      if b2.id=65535
        then b.id:=1
        else b.id:=b2.id+1
    end;
    seekbfile (numbuls+1);
    write (bfile,b)
  end;

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

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

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

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

  procedure sendfile (fn:integer);
  var f:filerec;
      cnt:integer;
      k:char;
      q:file of byte;
  label exit;
  begin
    seekffile (fn);
    read (ffile,f);
    assign (q,f.fname);
    reset (q);
    iocode:=ioresult;
    if iocode<>0 then begin
      fileerror (f.fname,'SENDFILE (Ascii download)');
      goto exit
    end;
    writelog (4,1,f.descrip);
    writeln ('File:        '^S,f.descrip);
    writeln ('Uploaded by: '^S,f.sentby);
    writeln ('Downloaded:  '^s,f.downloaded);
    writeln ('File size:   '^S,filesize(q),' characters'^M);
    writeln (^B'Press [Space] when you are ready, or [X] to abort.');
    repeat
      repeat until charready;
      k:=readchar;
      if hungupon then goto exit;
      if upcase(k)='X' then goto exit
    until k=' ';
    if not hungupon
      then
        begin
          printfile (f.fname);
          f.downloaded:=f.downloaded+1;
          seekffile (fn);
          write (ffile,f);
          writeln (^B^M+asciidownload+^M'Press a key.');
          repeat until charready;
          k:=readchar
        end;
    exit:
    close (q)
  end;

  procedure receivefile (f:filerec);
  var fn:lstr;
      cnt,timeul:integer;
      k:char;
      done:boolean;
      fff:text;
      last3:array [1..3] of char;

    procedure putchar (k:char);
    begin
      write (fff,k);
      write (usr,k)
    end;

  begin
    fn:='';
    cnt:=1;
    timeul:=timer;
    repeat
      if cnt<=length(f.descrip) then begin
        k:=upcase(f.descrip[cnt]);
        if k in ['A'..'Z'] then fn:=fn+k
      end;
      cnt:=cnt+1
    until cnt>length(f.descrip);
    if fn='' then fn:='Noname';
    fn:=copy(fn,1,8);
    while devicename(fn) do fn:=fn+chr(random(26)+64);
    fn:=uploaddir+fn+'.';
    cnt:=0;
    repeat
      cnt:=cnt+1
    until (cnt=1000) or (not exist(fn+strr(cnt)));
    if cnt=1000 then begin
      writeln ('Please try another description!');
      exit
    end;
    fn:=fn+strr(cnt);
    assign (fff,fn);
    rewrite (fff);
    iocode:=ioresult;
    if iocode<>0 then begin
      error ('%I opening %1 in RECEIVEFILE (ASCII upload)','',fn);
      exit
    end;
    f.fname:=fn;
    f.sentby:=unam;
    f.downloaded:=0;
    f.when:=now;
    writeln (^B'ASCII receive ready.'^M,
             'Press [CR] and /E to end, /X to abort.'^M);
    textcolor (outlockcolor);
    repeat
      repeat until charready;
      if hungupon
        then done:=true
        else
          begin
            k:=chr(ord(readchar) and 127);
            last3[1]:=last3[2];
            last3[2]:=last3[3];
            last3[3]:=upcase(k);
            done:=((last3[1]=^M) or (last3[1]=^J))
                  and (last3[2]='/') and ((last3[3]='E') or (last3[3]='X'));
            if not done then begin
              if (last3[2]=^M) and (k<>^J) then putchar (^J);
              if last3[2]='/' then putchar ('/');
              if k<>'/'
                then putchar (k)
            end
          end
    until done;
    textclose (fff);
    textcolor (normbotcolor);
    if last3[3]='E' then begin
      addfile (f);
      timeul:=timer-timeul;
      if timeul<0 then timeul:=timeul+1440;
      writeln (^B^M'That upload took ',timeul,' minutes.');
      logontime:=logontime+timeul;
      writelog (4,2,f.descrip)
    end else begin
      writestr (^M^M'Upload aborted!');
      erase (fff);
      iocode:=ioresult
    end
  end;

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

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

  procedure autodelete;
  begin
    writeln (^R'Erasing first post '^P'-'^R' Please wait.');
    delbul (1,true)
  end;

  function wipe(amount:byte):string;
  var z:integer;
      gee:string[80];
   begin
   for z:=1 to amount do gee:=gee+' ';
   wipe:=gee;
   end;

  procedure postbul;
  var l:integer;
      m:message;
      b:bulrec;
      ds:longint;
  begin
    if ulvl<postlevel then begin
      reqlevel(postlevel);
      exit
    end;
    l:=editor(m,true,'');
    if l>=0 then
      begin
        inc(urec.nbu);
        writeurec;
        if messages>32760 then messages:=0;
        inc(messages);
        b.anon:=m.anon;
        b.title:=m.title;
        b.when:=now;
        b.leftby:=unam;
        b.status:='['+urec.note+']';
        if sponsoron then b.status:=b.status+' [Sponsor]';
        b.recieved:=false;
        b.leftto:=m.leftto;
        b.line:=l;
        b.plevel:=ulvl;
        b.id:=curboard.net;
        if (curboard.net>0) and (usenet) and (featurea) then begin b.where:=^R+'CelerityNet V'+netver+' - '+longname;
        b.where2:=^R+netcomment; end;
        addbul (b);
        inc(newposts);
        with curboard do
          if autodel<=numbuls then autodelete;
      if (curboard.net>0) and (usenet) and (featurea) then
      writeln(^R'This post will be visible in all CelerityNet Boards.')
    end
  end;

  procedure readcurbul;
  var q:anystr;
      t:sstr;
      cnt,emusux,anarkyamerika:integer;
      oligarch:mstr;
  begin
    q:=wipe(80);
    if checkcurbul then begin
      getbrec;
      if (ansi and not cscan) then begin
        clearscr;
      end;
      write   (^B^M^R'Message'^P': '^S);
      oligarch:=^S+strr(curbul)+^R' of '^S+strr(numbuls);
      write (oligarch);
      for emusux:=1 to 32-(length(oligarch)) do
      write (' ');
      write  (^R'Posted '^P': ');
      if issysop or (not b.anon) then
      write(^S,datestr(b.when),' at ',timestr(b.when),^R) else writeln (^S'Unknown');
      writeln;
      write{ln}   (^B^R'Subject'^P': ');
      write(^S,b.title);
      for emusux:=1 to 29-(length(b.title)) do
      write (' ');
      write   (^R'To     '^P': '^S,b.leftto);
      if (b.recieved) then begin
       write (' ');
       write (^P'[Received]'^R);
      end;
      writeln;
      q:=^R'From   '^P': '^S;
      if b.anon then
          begin
            q:=q+anonymousstr;
            if (issysop) or (ulvl>=readanonlvl) then q:=q+' ['+b.leftby+']'
          end
        else
          begin
            if b.plevel=-1
              then t:='unknown'
              else t:=strr(b.plevel);
           q:=q+b.leftby+' [Level '+t+'] '+b.status;
          end;
      writeln (q);
      if break then exit;
      printtext (b.line);
      if (curboard.net>0) and (usenet) and (featurea) then
      write (^M+b.where+^M+b.where2);
      if match (b.leftto,unam) then begin
       b.recieved:=true;
       seekbfile (curbul);
       write (bfile,b);
      end;
      ansicolor (urec.regularcolor);
    end;
  { if curbul>lastreadnum then }
    begin
      lastreadnum:=curbul;
      urec.lastread[curboardnum]:=b.id
    end
  end;

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

  procedure readbul;
  begin
    getbnum ('Read');
    readcurbul
  end;

  procedure readnextbul;
  var t:integer;
  begin
    t:=curbul;
    inc(curbul);
    readcurbul;
    if curbul=0 then curbul:=t
  end;

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

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

   procedure setanon;
   begin
     writestr ('Allow Anonymous Posts? [Y/N]: *');
     if (yes) then curboard.anony:=true;
     if not yes then curboard.anony:=false;
     writecurboard;
   end;

   procedure setnet;
   begin
     writestr ('CelerityNet ID # [0]: *');
     if (valu(input)>0) then curboard.net:=valu(input);
     if (valu(input)<1) and (valu(input)>-1) then curboard.net:=0;
     writecurboard;
   end;

  {procedure makeboard;
  begin
    formatbfile;
    formatffile;
    with curboard do begin
      shortname:=curboardname;
      buflen:=30;
      writestr (^M'Board Name: &');
      boardname:=input;
      buflen:=30;
      writestr ('Sponsor [CR/'+unam+']:');
      if input='' then input:=unam;
      sponsor:=input;
      writestr ('Minimum Level for entry:');
      level:=valu(input);
      setnet;
      writestr ('Autodelete after [CR/100]:');
      if length(input)<1 then input:='100';
      autodel:=valu(input);
      if autodel<10 then begin
        writeln ('Must be at least 10!');
        autodel:=10
      end;
      setanon;
      setallflags (curboardnum,bylevel);
      writecurboard;
      writeln ('Board created.');
      writelog (4,4,boardname+' ['+shortname+']')
    end
  end;}

  Procedure makeboard;
    Begin
      formatbfile;
      With curboard Do Begin
        if ansigraphics in urec.config then begin
        clearscr;
        WriteLn(^R'         ┌───────────'^P'['^S' FAQ Sub-Board Installation '^P']'^R'────────────┐');
        WriteLn(^R'         │                                                     │');
        WriteLn(^R'         │                                                     │');
        WriteLn(^R'         │                                                     │');
        WriteLn(^R'         │                                                     │');
        WriteLn(^R'         │                                                     │');
        WriteLn(^R'         │                                                     │');
        WriteLn(^R'         │                                                     │');
        WriteLn(^R'         │                                                     │');
        WriteLn(^R'         └─────────────────────────────────────────────────────┘');
        PrintXy(12,8,^P'Allow Anonymous [CR/No]: ');
        PrintXy(12,7,^P'CelerityNet ID# [CR/0]: ');
        PrintXy(12,6,^P'Maximum Number of Messages: ');
        PrintXy(12,5,^P'Co-SysOp/Sponsor ['+^S+unam+^P+']: ');
        PrintXy(12,4,^P'Minimum Access Entry: ');
        PrintXy(12,3,^P'Message Area Name: ');
        shortname:=curboardname;
        BufLen:=29;
        movexy(12,3);
        writestr(^P'Message Area Name: &');
        if input='' then EXiT;
        boardname:=Input;
        BufLen:=30;
        {movexy(12,5);
        writestr(^P'Access Type [G]roup [L]evel [B]oth [CR/L]: *');
        If Input='' Then Input:='L';
        Area_Type:=UpCase(Input[1]);
        if not ( area_type[1] in [ 'B' , 'G' , 'L' ] ) then
          area_type := 'L' ;
        if area_type[1] in [ 'G' , 'B' ] then
          begin
            movexy(12,7);
            writestr(^P'Group File list [CR/None]: *');
            If Input='' Then Input:='None';
            File_List:=Input;
          end
        else
          File_List := 'None';
        if area_type[1] in [ 'L' , 'B' ] then}
          begin
            movexy(12,4);
            writestr(^P'Minimum Access Entry: *');
            level:=valu(Input);
          end
        {else
          level := maxint};
        movexy(12,5);
        writestr(^P'Co-Sysop/Sponsor ['+^S+unam+^P+']: *');
        If Input='' Then Input:=unam;
        sponsor:=Input;
        movexy(12,6);
        writestr(^P'Maximum Number of Messages: *');
        autodel:=valu(Input);
        If autodel<10 Then Begin
          WriteLn('Must be at least 10!');
          autodel:=50
        End;
        movexy(12,7);
        writestr(^P'CelerityNet ID# [CR/0]: *');
        if input='' then begin input:='0'; printxy2 (36,7,^U+'0'); end;
        net:=valu(input);
        movexy(12,8);
        writestr(^P'Allow Anonymous [CR/No]: *');
        if input='' then begin anony:=false; printxy2 (37,8,^U+'No '); end;
        if yes then begin anony:=true; printxy2 (37,8,^U+'Yes'); end;
        end else begin
      shortname:=curboardname;
      buflen:=30;
      writestr (^M'Board Name: &');
      boardname:=input;
      buflen:=30;
      writestr ('Sponsor [CR/'+unam+']:');
      if input='' then input:=unam;
      sponsor:=input;
      writestr ('Minimum Level for entry:');
      level:=valu(input);
      setnet;
      writestr ('Autodelete after [CR/100]:');
      if length(input)<1 then input:='100';
      autodel:=valu(input);
      if autodel<10 then begin
        writeln ('Must be at least 10!');
        autodel:=10
      end;
      setanon;
        end;
        setallflags(curboardnum,bylevel);
        writecurboard;
        writeln (^M^M^R'Message Base Created');
        writelog(4,4,boardname+' ['+shortname+']')
      End
    End;

  procedure setactive (nn:sstr; showinfo:boolean);

    procedure doswitch;
    begin
      openbfile;
      curbul:=lastreadnum;
      with curboard do
      begin
       writeln;
       if showinfo then begin
       if asciigraphics in urec.config then begin
       clearscr;
       writeln (^R'┌─────────────┬────────────────────────────────┐');
       write (^R'│ '^S'Sub-board:'^R'  │ '^S);
       tab (boardname,31);
       writeln (^R'│');
       write (^R'│ '^S'Messages:'^R'   │ '^S);
       tab (strr(numbuls),31);
       writeln (^R'│');
       write (^R'│ '^S'Last read:'^R'  │ '^S);
       tab (strr(lastreadnum),31);
       writeln (^R'│');
       write (^R'│ '^S'Sponsor:'^R'    │ '^S);
       tab(sponsor,31);
       writeln (^R'│');
       write (^R'│ '^S'Files:'^R'      │ '^S);
       tab (strr(numfiles),31);
       writeln (^R'│');
       write (^R'│ '^S'CelerityNet:'^R'│ '^S);
       if net>0 then begin
       tab ('Yes',31);
       end else
       tab ('No ',31);
       writeln (^R'│');
       writeln (^R'└─────────────┴────────────────────────────────┘');
       end else begin
       clearscr;
       writeln (^R'+-------------+--------------------------------+');
       write (^R'| '^S'Sub-board:'^R'  | '^S);
       tab (boardname,31);
       writeln (^R'|');
       write (^R'| '^S'Messages:'^R'   | '^S);
       tab (strr(numbuls),31);
       writeln (^R'|');
       write (^R'| '^S'Last read:'^R'  | '^S);
       tab (strr(lastreadnum),31);
       writeln (^R'|');
       write (^R'| '^S'Sponsor:'^R'    | '^S);
       tab(sponsor,31);
       writeln (^R'|');
       write (^R'| '^S'Files:'^R'      | '^S);
       tab (strr(numfiles),31);
       writeln (^R'|');
       write (^R'| '^S'CelerityNet:'^R'| '^S);
       if net>0 then begin
       tab ('Yes',31);
       end else
       tab ('No ',31);
       writeln (^R'|');
       writeln (^R'+-------------+--------------------------------+');
        end;
       end;
       writeln;
      end;
    end;

    procedure tryswitch;
    var n,s:integer;

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

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

  var b:bulrec;
  begin
    curbul:=0;
    close (bfile);
    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 (upstring(curboardname),true)
                end
              else setfirstboard
          end
        else setfirstboard
    end
  end;

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

  procedure listboards;
    procedure spacelen(le:byte);
   var aaa:byte;
   begin
    for aaa:=1 to le do
    write(' ');
   end;

  var cnt,oldcurboard:integer;
      printed:boolean;
  begin
    oldcurboard:=curboardnum;
    if exist (textfiledir+'Msgarea.'+strr(conn)) then
     printfile (textfiledir+'Msgarea.'+strr(conn)) else
   begin
   writehdr ('Message Area List');
   if asciigraphics in urec.config then begin
   writeln (^R'┌────────────────┬───────────────────────────────────────┬───────┬─────┬─────┐');
   writeln (^R'│ '^S'Name'^R'           │ '^S'Subboard Name'^R'                         │ '^S'Level'^R' │ '^S'A/A'^R' │ '^S+
   'Net'^R' │');
   writeln (^R'├────────────────┼───────────────────────────────────────┼───────┼─────┼─────┤');
    end else begin
   writeln (^R'+----------------+---------------------------------------+-------+-----+-----+');
   writeln (^R'| '^S'Name'^R'           | '^S'Subboard Name'^R'                         | '^S'Level'^R' | '^S'A/A'^R' | '^S+
   'Net'^R' |');
   writeln (^R'|----------------|---------------------------------------|-------|-----|-----|');
    end;
          if (asciigraphics in urec.config) then begin
    if break then exit;
    for cnt:=0 to filesize(bdfile)-1 do
      if haveaccess(cnt) then
        with curboard do begin
          write (^R'│ '^S,shortname,^R);
          spacelen(15-length(shortname));
          write (^R'│ '^S,boardname,^R);
          spacelen(38-length(boardname));
          write (^R'│ '^S,level,^R);
          spacelen(6-length(strr(level)));
       if anony then
          write (^R'│ '^S'Yes'^R' │')
       else
          write (^R'│ '^S'No'^R'  │');
       if net>0 then
          writeln (^R' '^S'Yes'^R' │')
       else
          writeln (^R' '^S'No'^R'  │');
          if break then exit
        end;
    end;
  end;
  if not (asciigraphics in urec.config) then begin
    if break then exit;
    for cnt:=0 to filesize(bdfile)-1 do
      if haveaccess(cnt) then
        with curboard do begin
          write (^R'| '^S,shortname,^R);
          spacelen(15-length(shortname));
          write (^R'| '^S,boardname,^R);
          spacelen(38-length(boardname));
          write (^R'| '^S,level,^R);
          spacelen(6-length(strr(level)));
       if anony then
          write (^R'| '^S'Yes'^R' |')
       else
          write (^R'| '^S'No'^R'  |');
       if net>0 then
          writeln (^R' '^S'Yes'^R' |')
       else
          writeln (^R' '^S'No'^R'  |');
          if break then exit
        end;
    end;
   if asciigraphics in urec.config then
   writeln (^R'└────────────────┴───────────────────────────────────────┴───────┴─────┴─────┘') else
   writeln (^R'+----------------+---------------------------------------+-------+-----+-----+');
    writeln;
    curboardnum:=oldcurboard;
    seekbdfile (curboardnum);
    read (bdfile,curboard)
  end;

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

  procedure setfirstboard; { FORWARD }
  var fbn:sstr;
  begin
    if filesize(bdfile)=0 then exit;
    if not haveaccess(0)
      then error ('User can''t access first board','','');
    seek (bifile,0);
    read (bifile,fbn);
    setactive (fbn,true)
  end;

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

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


  procedure sendbreply;
  begin
    if checkcurbul then begin
      getbrec;
      sendmailto (b.leftby,b.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;
    writeln;
  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;

  procedure boardsponsor;

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

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

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

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

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

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

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

    procedure listaccess;

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

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

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

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

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

   procedure getautodel;
    var b:bulrec;
    begin
      with curboard do begin
        getbint ('auto-delete',autodel);
        if autodel<10
          then
            begin
              writeln (^B'HEY!  It can''t be less than ten!');
              autodel:=numbuls+1;
              if autodel<10 then autodel:=10;
              writeln (^B'Setting autodelete to ',autodel);
              writecurboard
            end
          else
            if autodel<=numbuls
              then
                begin
                  writeln (^B'Deleting message.');
                  while autodel<=numbuls do delbul (2,true)
                end
      end;
      writelog (5,11,strr(curboard.autodel))
    end;

    procedure getfiletitle;
    var fn:integer;
        f:filerec;
    begin
      fn:=getfilenumber ('change the title of');
      if fn<>0 then begin
        seekffile (fn);
        read (ffile,f); che;
        writeln (^B'Old description: ',f.descrip);
        writestr ('New description [or CR]:');
        if length(input)>0 then begin
          f.descrip:=input;
          seekffile (fn);
          write (ffile,f);
          writelog (5,9,f.descrip)
        end
      end
    end;

    procedure movefile;
    var f:filerec;
        tcb:boardrec;
        tcbn,dbn,fn:integer;
        tcbname:sstr;
    begin
      writehdr ('File Move');
      fn:=getfilenumber ('move');
      if fn=0 then exit;
      seekffile (fn);
      read (ffile,f);
      writestr ('Move "'+f.descrip+'" to which board? *');
      if length(input)=0 then exit;
      tcb:=curboard;
      tcbn:=curboardnum;
      tcbname:=curboardname;
      dbn:=searchboard(input);
      if dbn=-1 then begin
        writeln ('No such board!');
        exit
      end;
      writeln ('Moving.');
      delfile (fn);
      close (bfile);
      close (ffile);
      seek (bdfile,dbn);
      read (bdfile,curboard);
      curboardnum:=dbn;
      curboardname:=curboard.shortname;
      openbfile;
      addfile (f);
      close (bfile);
      close (ffile);
      curboard:=tcb;
      curboardname:=tcbname;
      curboardnum:=tcbn;
      openbfile;
      writelog (5,6,f.descrip);
      writeln (^B'Done!')
    end;

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

    procedure wipeoutfile;
    var un,fn:integer;
        f:filerec;
        q:file;
        n:mstr;
        u:userrec;
    begin
      writehdr ('File Wipe-out');
      fn:=getfilenumber ('wipe out');
      if fn=0 then exit;
      seekffile (fn);
      read (ffile,f);
      writestr ('Wipe out: "'+f.descrip+'" ? *');
      if not yes then exit;
      writestr ('Erase disk file '+f.fname+'? *');
      if yes then begin
        assign (q,f.fname);
        erase (q);
        un:=ioresult
      end;
      delfile (fn);
      writelog (5,7,f.descrip);
      n:=f.sentby;
      un:=lookupuser(n);
      if un<>0
        then
          begin
            seek (ufile,un);
            read (ufile,u);
            u.nup:=u.nup-1;
            writeln (n,' now has ',u.nup,' uploads.');
            seek (ufile,un);
            write (ufile,u)
          end
    end;

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

{$I rename.pas}
    procedure killboard;
    var cnt:integer;
        f:file;
        fr:filerec;
        bd:boardrec;
    begin
      writestr ('Kill Board - You sure? [y/n]: *');
      if not yes then exit;
      writelog (5,10,'');
      writeln (^B^M'Deleting messages.');
      for cnt:=numbuls downto 1 do
        begin
          delbul(cnt,true);
          write (cnt,' ');
          messages:=messages-1;
          urec.lastmessages:=urec.lastmessages-1
        end;
      if messages<1 then messages:=1;
      if urec.lastmessages<1 then urec.lastmessages:=1;
      writeln (^B^M'Deleting files.');
      for cnt:=numfiles downto 1 do
        begin
          seekffile (cnt);
          read (ffile,fr);
          assign (f,fr.fname);
          erase (f);
          if ioresult<>0 then writeln (^B'Error erasing ',fr.fname);
          delfile (cnt);
          write (cnt,' ')
        end;
      writeln (^B^M'Deleting sub-board files.');
      close (bfile);
      assignbfile;
      erase (bfile);
      if ioresult<>0 then writeln (^B'Error erasing board file.');
      close (ffile);
      assignffile;
      erase (ffile);
      if ioresult<>0 then writeln (^B'Error erasing file directory file.');
      writeln (^M'Removing sub-board.');
      delboard (curboardnum);
      writeln (^B'Sub-board erased!');
      setfirstboard;
      q:=9
    end;

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

(* {$I netmail.pas}

procedure netmailprocess;

var ib,ib2,ib3:integer;
    fit:bulrec;
    f5:file of bulrec;
    hardf:file of message;
    textf:message;
    filename:mstr;
    filename2:mstr;
    fl1,fl2:sstr;
    curb:boardrec;
    f1,f2:text;

begin
      if (curboard.net>0) and (usenet) and (featurea) then
begin writeln (^R'Subboard doesn''t support CelerityNet!');
exit;
end;
      if (curboard.net>0) and (usenet) and (featurea) then
begin writeln (^R'Configuration doesn''t use CelerityNet!');
exit;
end;
{writestr('Have you switched to the proper area to receive? *');
if yes then
  begin}
    writeln ('Current Bulletin :'^S,curbul);
    writeln ('Last Bulletin    :'^S,numbuls);
    writeln;
   {buflen:=7;
    writestr('Enter FAQpaket filename to process : *');
    if (length(input)>0) then}
         {filename:='C'+strr(conn)+copy(curboardname,1,6);}
          filename:=strr(conn)+'NET'+curboard.shortname;
          filename2:='NETRECV'+strr(conn);
          begin
              writeln('Please wait - removing compression/encosion on file');
              extractzip(networkdir+filename2+'.ZIP','','');
              fl1:=networkdir+filename+'.SQ'+strr(conn);
              fl2:=networkdir+filename+'.ME'+strr(conn);
              assign(f5,networkdir+filename+'.SQ'+strr(conn));
              assign(hardf,networkdir+filename+'.ME'+strr(conn));
                 {$i-}
                 if exist(fl1) then erase(f5);
                 reset(f5);
                 {$i+}

                 if ioresult<>0 then
                  begin
                   writeln('File not found.');
                   exit;
                  end;
                  {$i-}
                  if exist(fl2) then erase(hardf);
                  reset(hardf);
                  {$i+}
                  if ioresult<>0 then
                  begin
                   writeln('File not found.');
                   exit;
                  end;
                 writeln(^R'Please wait - Processing FAQNet-paket for Sub '^P'['^S+curboard.shortname+^P']'^R'.');
                 while not eof(f5) do
                   begin
                    read(f5,b);
                    read(hardf,textf);
                    b.line:=maketext(textf);
                    addbul(b);
                   end;
                 close(f5);
                 close(hardf);
                 writeln(^R'FAQNet package for Sub '^P'['^S+curboardname+^P']'^R' processed.');
                 assign (f1,networkdir+filename+'.SQ'+strr(conn));
                 assign (f2,networkdir+filename+'.ME'+strr(conn));
                 reset (f1);
                 reset (f2);
                 rewrite (f1);
                 rewrite (f2);
                 erase (f1);
                 erase (f2);
                 textclose (f1);
                 textclose (f2);
               Writestr('Do you wish to remove the FAQpaket file from your system? *');
               if yes then
            begin
               assign (f1,networkdir+filename2+'.ZIP');
               reset (f1);
               rewrite (f1);
               erase (f1);
               textclose (f1);
            end;
          end;
 {end
  else writeln('FAQpaket processing stopped.');}
end;

{procedure netmail;

var ch:char;

begin
writehdr ('Netmail');
writeln (^P'['^S'1'^P']'^R' Process a FAQ-Paket netmail package to transmit.');
writeln (^P'['^S'2'^P']'^R' Process a FAQ-Paket netmail package already recieved.');
writeln (^P'['^S'3'^P']'^R' FAQ-Packet System Update.');
writeln;
writestr('Please make your choice [C/R]:*');
if (length(input)>0) then
 begin
  if (not sponsoron) and (not issysop) then begin
  writeln('Invalid Command.');
  exit;
  end;
 ch:=upcase(input[1]);
 case ch of
        '1':netmailsend;
        '2':netmailprocess;
        '3':systemlist;
       end;
 end;
end;} *)

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

    procedure addresident;
    var f:filerec;
    begin
      writestr ('Filename (including path):');
      if hungupon or (length(input)=0) then exit;
      if devicename(input) then begin
        writeln ('That''s a DOS device name!!');
        exit
      end;
      if not exist(input) then begin
        writeln ('File not found.');
        exit
      end;
      f.sentby:=unam;
      f.fname:=input;
      writestr ('Description:');
      if length(input)=0 then exit;
      f.descrip:=input;
      f.downloaded:=0;
      f.when:=now;
      addfile (f);
      writelog (5,15,f.fname)
    end;

  begin
    if (not sponsoron) and (not issysop) then begin
      writeln ('Nice try, but you aren''t the sponsor.');
      exit
    end;
    writelog (4,3,curboard.boardname+' ['+curboard.shortname+']');
    repeat
      q:=menu ('Message Base Sponsor','SPONSOR','DLSTMWUEQRKCNBOVF[]PYZ*?');
      case q of                                               (* |  |  *)
      {  1:getautodel;
        2:getblevel;
        3:setsponsor; }
        4:getfiletitle;
        5:movefile;
        6:wipeoutfile;
        7:setnameaccess;
        8:setallaccess;
        10:modboard; {renameboard;}
        11:killboard;
        12:sortboards;
        13:movebulletin;
        14:orderboards;
        15:listaccess;
        16:addresident;
        17:begin
            writestr ('Current Posts ['+strr(urec.nbu)+']: &');
            if length(input)>0 then urec.nbu:=valu(input);
            writeurec;
           end;
       {18:netmailsend;
        19:netmailprocess;
        20:systemlist;}
       {21:setanon;
        22:setnet;}
        23:activeboard;
        24:begin
writeln ('C╔═════════════════════════════════════╗Hs');
writeln ('uC║ Message Base Sponsor Section        ║Hs');
writeln ('uC╚═════════════════════════════════════╝HHC╔═════s');
writeln ('u════════════════════════════════╗HC║ [B]  s');
writeln ('uRe-Order Sub-Boards            ║HC║ [Cs');
writeln ('u]  Sort Sub-Boards                ║HC║ [s');
writeln ('uE]  Set All Access                 ║Hs');
writeln ('uC║ [F]  Change # of Posts              s');
writeln ('u║HC║ [K]  Kill Sub-Boards               s');
writeln ('u ║HC║ [M]  Move a File             s');
writeln ('u       ║HC║ [N]  Move Message      s');
writeln ('u             ║HC║ [O]  List Sub-Boas');
writeln ('urd Access          ║HC║ [Q]  Quit  s');
writeln ('u                 ╔════════════════════════════════════s');
writeln ('u═╗HC║ [R]  Re-Configure Sub-Boars');
writeln ('ud ║ [V]  Add Resident File             s');
writeln ('u ║HC║ [T]  Change File Titls');
writeln ('ue      ║ [W]  Delete File              s');
writeln ('u      ║HC║ [U]  Set Name Acs');
writeln ('ucess        ║ [*]  Change Active Sub-Bos');
writeln ('uard        ║HC╚═══════════════════════════s');
writeln ('u══║ [?]  View This Menu                s');
writeln ('u ║HC╚═════════════════════════════════════╝');
writeln;
pause;
           end;

      end
    until (q=9) or hungupon
  end;

  var beenaborted:boolean;

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

  Function capfir(inString:STRING):char;
 begin
   capfir:=upcase(inString[1]);
 end;


  procedure newscanboard;

    function getnumnum(title:lstr):integer;
var reprep      :byte;
    startpoint  :byte;
    endpoint    :byte;
    a           :string[1];
begin
   reprep    :=79;
   startpoint:=0;
   endpoint  :=0;
   getnumnum :=0;
  repeat
   a:=copy (title,reprep,1);
   if a='#' then
     begin;
       startpoint:=reprep;
         repeat
           if valu(copy(title,reprep,1))>0 then endpoint:=reprep;
           inc(reprep);
         until (reprep>=79);
     end;
   if (startpoint>0) and (endpoint>0) then
      begin
        dec(endpoint,startpoint);
        getnumnum:=valu(copy(title,startpoint+1,endpoint));
        exit;
      end;
    dec(reprep);
  until reprep<=0
end;

function gettitle(title:lstr;reply:word):lstr;
var search   :boolean;
    srcstr   :sstr;
    cursrc   :word;
    tit      :lstr;
begin

   srcstr  :=' [Reply #';
   search  :=false;
   tit     :='';
   cursrc  :=0;

   repeat
    if copy(title,cursrc,length(srcstr))=srcstr then
      begin;
        tit:=copy(title,1,cursrc-1);
        gettitle:=tit+' [Reply #'+strr(reply)+']';
        exit;
      end;

    if cursrc=79 then
      begin
        gettitle:=title+' [Reply #'+strr(reply)+']';
        exit;
      end;
    inc(cursrc);
   until cursrc=80;
end;

    procedure shownewfiles;
    var cnt,first,numf:integer;
        f:filerec;
        nf:boolean;
    begin
      numf:=numfiles;
      cnt:=numf;
      nf:=true;
      while (cnt>0) and nf do begin
        seekffile (cnt);
        read (ffile,f);
        nf:=f.when>xlaston;
        if nf then cnt:=cnt-1
      end;
      first:=cnt+1;
      if first>numf then exit;
      writehdr ('New Files');
      if aborted or break then exit;
      for cnt:=first to numf do begin
        seekffile (cnt);
        read (ffile,f);
        writeln (^S,cnt,'. '^R,f.descrip);
        if aborted or break then exit
      end
    end;

  var newmsgs,oldb:boolean;
      q:anystr;
      wock:char;
      wock2:word;
      m,me:message;
      l,stonerslive,swash:integer;
      t:sstr;
      fcpiskool:mstr;
      repnumber:word;
      lameo    :string;
  begin
    beenaborted:=false;
    newmsgs:=false;
    curbul:=lastreadnum+1;
    while curbul<=numbuls do begin
      getbrec;
      if b.when>laston then begin
        readnum (curbul);
        newmsgs:=true;
      if (not cscan) then
      repeat
       wock:='N';
       writestr (^P'Message Newscan Command ['^S'?/Help'^P']['^S'CR/Next'^P']: *');
       if length(input)<1 then input:='N';
       wock:=upcase(input[1]);
       wock2:=valu(input);
       if wock2>0 then begin
        if wock2<=numbuls then begin
         curbul:=wock2;
         readnum (curbul);
        end;
       end else
        wock:=upcase(wock);
        case wock of
         '?':begin
              writeln;
              writeln (^S'                 -Newscan Help-'^R^M);
              writeln ('[N]: Next Message          [#]: Read that Message #');
              writeln ('[A]: Read Message Again    [R]: Reply to Message');
              writeln ('[D]: Delete Message        [P]: Post a Message');
              writeln ('[B]: Next Sub-board        [/]: Toggle Auto-Scan');
              if (match(unam,b.leftby)) or (issysop) or (sponsoron)
              then write ('[E]: Edit Message          ');
              writeln ('[Q]: Quit Newscan');
              writeln;
             end;
         'A':begin
              if checkcurbul then begin
               getbrec;
               if ((ansigraphics in urec.config) and (not cscan)) then begin
                write (#27+'[2J');
                clrscr;
               end;
               writeln (^R'[Current Board: '^S,curboard.boardname,^R']'^M);
               write   (^B^P'Message: '^S);
               fcpiskool:=^S+strr(curbul)+' of '+strr(numbuls);
               write (fcpiskool);
               for stonerslive:=1 to 25-(length(fcpiskool)) do
               write (' ');
               if issysop or (not b.anon) then
               writeln (^P'When: '^S,datestr(b.when),^P' at '^S,timestr(b.when),^R);
               writeln (^B^P'Subject: '^S,b.title);
               write   (^B^P'To:      '^S,b.leftto);
               if (b.recieved) then begin
                for swash:=1 to 25-(length(b.leftto)+3) do
                write (' ');
                write (^P'-Recieved-'^R);
               end;
               writeln;
               q:=^P'From:    '^S;
               if b.anon
                 then
                   begin
                     q:=q+anonymousstr;
                     if (issysop) or (ulvl>=readanonlvl) then q:=q+' ['+b.leftby+']'
                   end
                 else
                   begin
                     if b.plevel=-1
                       then t:='Unknown'
                       else t:=strr(b.plevel);
                    q:=q+b.leftby+' (Level '+t+') '+b.status;
                   end;
               writeln (q);
               ansicolor (urec.regularcolor);
               if break then exit;
               printtext (b.line);
               end;
              end;
         'P':begin
              postbul;
             end;
         'D':begin
              reading:=true;
              killbul;
              curbul:=curbul-1;
              reading:=false;
             end;
         'R':begin
              if ulvl<postlevel then begin
                reqlevel(postlevel);
                exit
              end;
              emailing:=true;
              notitle:=true;
              l:=editor(m,true,'');
              lameo:=b.leftby;
              if l>=0 then
                begin
                  inc(urec.nbu);
                  writeurec;
                  if messages>32760 then messages:=0;
                  inc(messages);
                  b.anon:=m.anon;
                  repnumber:=getnumnum(b.title);
                  inc(repnumber);
                  b.title:=gettitle(b.title,repnumber);
                  b.when:=now;
                  b.leftto:=lameo;
                  b.leftby:=unam;
                  b.status:='['+urec.note+']';
                  if sponsoron then b.status:=b.status+' [Sponsor]';
                  b.line:=l;
                  b.plevel:=ulvl;
                  addbul (b);
                  inc(newposts);
                   with curboard do
                    if autodel<=numbuls then autodelete
                end
             end;
         'E':begin
              if checkcurbul then begin
              if (not match(b.leftby,unam)) and (not issysop) and (not sponsoron)
                then begin
                  writeln ('You didn''t post that!');
                end
              else begin
              reloadtext (b.line,me);
              me.title:=b.title;
              me.anon:=b.anon;
              if reedit (me,true) then begin
                writelog (4,6,b.title);
                deletetext (b.line);
                b.line:=maketext (me);
                if b.line<0 then begin
                  writestr (^M'Deleting message.');
                  delbul (curbul,false)
                end else begin
                  seekbfile (curbul);
                  write (bfile,b)
                 end
                end
               end;
              end;
             end;
         'B':exit;
         '/':togglecscan;
         'Q':begin
              quitmasterinc:=true;
              exit;
             end;
       end;
      until wock in ['N'];
      end;
      curbul:=curbul+1;
     if aborted then exit;
    end;
     shownewfiles;
    if (postprompts in urec.config) and newmsgs and (ulvl>=postlevel)
      then begin
        writestr (^M'Post on '^S+curboard.boardname+^P'? [Y/N]: *');
        writeln;
        if yes then postbul
      end
  end;

  procedure newscanall;
  var cb:integer;
  begin
    beenaborted:=false;
    writeln (^R'Newscanning All Boards.  ['^S'X'^R'] will abort.'^M);
    if aborted then exit;
    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 (^R+curboard.boardname+^P' ['^S+curboard.shortname+^P']');
        if aborted then exit;
        newscanboard;
        if quitmasterinc then begin
         quitmasterinc:=false;
     writeln (^B^M'Newscan aborted!'^G);
         exit;
        end
      end
    end;
    writeln (^B^M'Newscan complete!'^G);
    setfirstboard
  end;

  procedure getconpw;
  begin
      if (length(confmpw[1])>0) and (conn=1) and not (issysop) then begin
        echodot:=true;
        writestr (^M^P'['^R'Conference #1 Password'^P']: *');
        echodot:=false;
        if not (match(input,confmpw[1])) then begin exit; exit; end;
      end;
      if (length(confmpw[2])>0) and (conn=2) and not (issysop) then begin
        echodot:=true;
        writestr (^M^P'['^R'Conference #2 Password'^P']: *');
        echodot:=false;
        if not (match(input,confmpw[2])) then begin exit; exit; end;
      end;
      if (length(confmpw[3])>0) and (conn=3) and not (issysop) then begin
        echodot:=true;
        writestr (^M^P'['^R'Conference #3 Password'^P']: *');
        echodot:=false;
        if not (match(input,confmpw[3])) then begin exit; exit; end;
      end;
      if (length(confmpw[4])>0) and (conn=4) and not (issysop) then begin
        echodot:=true;
        writestr (^M^P'['^R'Conference #4 Password'^P']: *');
        echodot:=false;
        if not (match(input,confmpw[4])) then begin exit; exit; end;
      end;
      if (length(confmpw[5])>0) and (conn=5) and not (issysop) then begin
        echodot:=true;
        writestr (^M^P'['^R'Conference #5 Password'^P']: *');
        echodot:=false;
        if not (match(input,confmpw[5])) then begin exit; exit; end;
      end;
  end;

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

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

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

  procedure listusersaxis;

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

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

    begin
     if ulvl<listuserlvl then Begin reqlevel (listuserlvl); Exit; End;
     writehdr ('List Users with Board Access');
     writeln;
     writeln (^R'Users with access to ['^S+curboard.boardname+^R']:');
     writeln;
     listacc (true);
    end;

  procedure uploadbul;
  var l:integer;
      m:message;
      b:bulrec;
      pr:char;
      t,s:mstr;
      uf:text;
      ds:longint;
  begin
    if ulvl<postlevel then begin
      reqlevel(postlevel);
      exit
    end;
    ds:=diskfree(0);
    ds:=ds div 1000;
    if ds<10 then begin
     writeln;
     writeln ('There is only '+strr(ds)+'K disk space left.');
     writestr ('Are you sure you want to post? *');
     if not yes then exit else
    end;
    assign (uf,'receive.');
    if exist ('receive.') then erase(uf);
    writehdr ('Message Upload');
    writeln (^S'Message Upload: Zmodem/Ymodem-G Uploads Only!');
    writestr (^M'Subject: &');
    if length(input)=0 then exit;
    s:=input;
    t:='All';
    Writestr ('To [CR/All]: &');
    if length(input)>0 then t:=input;
        with curboard do
        if anony then begin
        buflen:=1;
    writestr ('Anonymous? [y/n]: *');
        b.anon:=yes
      end;
    writestr ('Zmodem or Ymodem-G [Z,Y  A,Q/Quit]: *');
    if upcase (input[1])='Z' then pr:='Z' else if upcase (input[1])='G'
    then pr:='G';
    if (upcase (input[1])='A') or (upcase(input[1])='Q') then exit;
    writeln (^M^S'Ready to receive Message Upload.');
    if pr='Z' then
    exec (GetEnv('COMSPEC'),'/C dsz port '+strr(usecom)+' speed '+strr(baudrate)+' rz receive.') else
    if pr='G' then
    exec (GetEnv('COMSPEC'),'/C dsz port '+strr(usecom)+' speed '+strr(baudrate)+' rb -g receive.');
    reset (uf);
    if ioresult<>0 then begin
     writeln (^M^S'Message upload error!'^M);
     textclose(uf);
     exit;
    end;
     m.numlines:=0;
      while not eof(uf) and (m.numlines<100) do begin
        inc(m.numlines);
        readln(uf,m.text[m.numlines]);
      end;
     if m.numlines<=1 then begin
      writeln (^M^S'Message upload error!'^M);
      textclose(uf);
      exit;
     end;
      begin
        inc(urec.nbu);
        writeurec;
        b.title:=s;
        b.when:=now;
        b.leftto:=t;
        b.leftby:=unam;
        b.status:=urec.note;
        b.plevel:=ulvl;
        b.recieved:=false;
        b.line:=maketext(m);
        if m.numlines>1 then addbul (b);
        inc(newposts);
        inc(messages);
        if messages>32767 then messages:=0;
        textclose (uf);
        erase (uf);
        writehdr ('Message Added!');
        writeln ('Total Lines: '^S,m.numlines);
        with curboard do
          if autodel<=numbuls then autodelete
      end;
  end;

var boo:boolean;
label exit1;
begin
  cursection:=bulletinsysop;
  reading:=false;
  quitmasterinc:=false;
  cscan:=false;
  getconpw;
  openbdfile;
  if filesize(bdfile)=0 then begin
    noboards;
    if filesize(bdfile)=0 then begin
      closebdfile;
      goto exit1
    end
  end;
  if not haveaccess(0)
    then
      begin
        writeln (^B'You do not have access to the first sub-board!');
        closebdfile;
        goto exit1
      end;
  if exist(textfiledir+'MSGNEWS.'+strr(conn)) then begin
  printfile (textfiledir+'MSGNEWS.'+strr(conn));
pause;
  end;
      if ansi then ansicls;
  setfirstboard;
  repeat
    boo:=checkcurbul;
    with curboard do
      {+' '+boardname,^R' ['^S,shortname,^R']: '}
      write (^B);
      writeln (^R'Conference #'^S+strr(conn)+' '+curboard.boardname+^P' ['^S+curboard.shortname+^P']');
    if sponsoron or issysop
      then writeln (^R'['^S'%'^R']:Board Sponsor Commands');
      writeln (^R'Bulletin '^S,curbul,^R' of '^S,numbuls);
    q:=menu ('Message Base <'+curboard.shortname+'-'+strr(curbul)+'/'+strr(numbuls)+
             '>','MSG','PRDFUKT*MQ#_%LNBAVCES+WG!Z?');
    case q of
      1:postbul;
      2:readbul;
      3:{downloadfile};
      4,22:sendmailto (curboard.sponsor,false);
      5:uploadbul{uploadfile};
      6:killbul;
      8,16,17:activeboard;
      7:listbuls;
      9:sendbreply;
      12:if not hungupon then readnextbul;
      13:boardsponsor;
      14:{listfiles};
      15:newscanall;
      18:newscanboard;
      19:togglenewscan;
      20:editbul;
      21:nextsubboard;
      22:readnum (lastreadnum+1);
      23:offfaq;
      24:listusersaxis;
      25:togglecscan;
      27:begin
writeln('C╔═════════════════════════════════════╗Hs');
writeln('uC║ Message Base Section                ║Hs');
writeln('uC╚═════════════════════════════════════╝HHC╔══s');
writeln('u═══════════════════════════════════╗HC║ [A]  s');
writeln('uChange Active Sub-Board        ║HC║ [Cs');
writeln('u]  Change Newscan on Sub          ║HC║ [s');
writeln('uE]  Edit Message                   ║Hs');
writeln('uC║ [G]  Log off BBS            ╔═════s');
writeln('u════════════════════════════════╗1HC║ [Ks');
writeln('u]  Kill Message           ║ [U]  s');
writeln('uUpload Text File               ║1HC║ s');
writeln('u[M]  Send Reply to Message  ║ [Vs');
writeln('u]  Newscan Current Sub-Board      ║1HCs');
writeln('u║ [N]  Newscan All Sub-Boards ║ [s');
writeln('uW]  Read Next Message              ║1Hs');
writeln('uC║ [P]  Post Message           s');
writeln('u║ [Z]  Change Auto-Scan               ║');
writeln('1HC║ [Q]  Quit                   s');
writeln('u║ [#]  Read Message #                 ║');
writeln('1HC║ [R]  Read Message(s)        s');
writeln('u║ [%]  Message Sponsor Section        ║');
writeln('1HC║ [S]  Send Mail to Sponsor   s');
writeln('u║ [+]  Next Sub-Board                 ║');
writeln('1HC║ [T]  List Messages          s');
writeln('u║ [!]  List Users with Access         ║');
writeln('1HC╚═════════════════════════════║ [Cs');
writeln('uR] Read Next Message              ║1HC║s');
writeln('u [?]  View This Menu                 ║');
writeln('1HC╚═════════════════════════════════════╝');
writeln;
pause;
           end;
     else if q<0 then readnum (-q)
    end
  until (q=10) or hungupon or (filesize(bdfile)=0);
  exit1:
  close (bfile);
  close (ffile);
  closebdfile
end;

begin
end.