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 / EMAIL.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-13  |  35KB  |  1,222 lines

  1.  
  2. {$R-,S-,I-,D-,F+,V-,B-,N-,O+ }
  3. {$M 65500,0,0 }
  4.  
  5. unit email;
  6.  
  7. interface
  8.  
  9. uses gentypes,configrt,gensubs,subs1,subs2,textret,flags,overlay,
  10.      mailret,userret,overret1,mainr1,mainr2,statret,modem;
  11.  
  12. procedure emailmenu;
  13.  
  14. implementation
  15.  
  16. procedure emailmenu;
  17. var lastread:integer;
  18.     m:mailrec;
  19.     incoming,outgoing:catalogrec;
  20.  
  21.   procedure addcatalog (var c:catalogrec; var m:mailrec; fpos:integer);
  22.   begin
  23.     m.fileindex:=fpos;
  24.     if c.nummail=maxcatalogsize
  25.       then c.additional:=c.additional+1
  26.       else begin
  27.         c.nummail:=c.nummail+1;
  28.         c.mail[c.nummail]:=m
  29.       end
  30.   end;
  31.  
  32.   procedure writenummail (var c:catalogrec; txt:mstr);
  33.   begin
  34.     writeln (^B^M'You have '^S,c.nummail+c.additional,^R' ',txt,
  35.              ' E-Mail',s(c.nummail),^R);
  36.     if c.additional>0
  37.       then writeln ('   Note: Of those, ',
  38.                      numthings (c.additional,'is','are'),' uncataloged.')
  39.   end;
  40.  
  41.   procedure readcatalogs;
  42.   var m:mailrec;
  43.       cnt:integer;
  44.   begin
  45.     seek (mfile,1);
  46.     incoming.nummail:=0;
  47.     incoming.additional:=0;
  48.     outgoing.nummail:=0;
  49.     outgoing.additional:=0;
  50.     for cnt:=1 to filesize(mfile)-1 do begin
  51.       read (mfile,m);
  52.       if m.sentto=unum
  53.         then addcatalog (incoming,m,cnt);
  54.       if match(m.sentby,unam)
  55.         then addcatalog (outgoing,m,cnt)
  56.     end
  57.   end;
  58.  
  59.   procedure readit (var m:mailrec);
  60.   begin
  61.     write (^B^M'Title:   '^S,m.title,^M'Sent by: '^S);
  62.     if m.anon
  63.       then
  64.         begin
  65.           write (anonymousstr);
  66.           if issysop then write (' (',m.sentby,')')
  67.         end
  68.       else write (m.sentby);
  69.     writeln (^M'Sent at: '^S,datestr(m.when),' at ',timestr(m.when));
  70.     writeln;
  71.     if not break then printtext (m.line)
  72.   end;
  73.  
  74.   procedure readincoming (n:integer);
  75.   var m:^mailrec;
  76.       cnt:integer;
  77.   begin
  78.     m:=addr(incoming.mail[n]);
  79.     readit (m^);
  80.     if not (m^.read) then begin
  81.       m^.read:=true;
  82.       seek (mfile,m^.fileindex);
  83.       write (mfile,m^)
  84.     end;
  85.     for cnt:=n+1 to incoming.nummail do
  86.       if match(incoming.mail[cnt].sentby,m^.sentby) then begin
  87.         writeln (^B^M'There''s more mail from ',m^.sentby,'!');
  88.         exit
  89.       end
  90.   end;
  91.  
  92.   procedure listmail (var c:catalogrec);
  93.   var n:integer;
  94.       u:userrec;
  95.       cnt:integer;
  96.       m:mailrec;
  97.   begin
  98.     write ('Num  ');
  99.     tab ('Title',30);
  100.     write ('New  Sent ');
  101.     if ofs(c)=ofs(incoming) then writeln ('by'^M) else writeln ('to'^M);
  102.     if break then exit;
  103.     for cnt:=1 to c.nummail do if not break then begin
  104.       m:=c.mail[cnt];
  105.       write (cnt:2,'.  ');
  106.       if not break then tab (m.title,30);
  107.       if not break then if m.read then write ('     ') else write ('New  ');
  108.       if match(m.sentby,unam)
  109.         then writeln (lookupuname (m.sentto))
  110.         else writeln (m.sentby)
  111.     end
  112.   end;
  113.  
  114.   procedure writemail (var c:catalogrec; num:integer);
  115.   begin
  116.     seek (mfile,c.mail[num].fileindex);
  117.     write (mfile,c.mail[num])
  118.   end;
  119.  
  120.   function checklastread:boolean;
  121.   begin
  122.     if (lastread<0) or (lastread>incoming.nummail) then lastread:=0;
  123.     checklastread:=lastread=0
  124.   end;
  125.  
  126.   function getmsgnumber (var c:catalogrec; txt:sstr):integer;
  127.   var n:integer;
  128.       inc:boolean;
  129.   begin
  130.     inc:=ofs(c)=ofs(incoming);
  131.     getmsgnumber:=0;
  132.     if c.nummail=0 then begin
  133.       if c.additional>0 then readcatalogs;
  134.       if c.nummail=0 then writestr (^M'Sorry, no mail!');
  135.       if inc then lastread:=0;
  136.       exit
  137.     end;
  138.     input:=copy(input,2,255);
  139.     if length(input)=0
  140.       then if inc
  141.         then n:=lastread
  142.         else n:=0
  143.       else n:=valu(input);
  144.     if (n<1) or (n>c.nummail) then begin
  145.       repeat
  146.         writestr (^M'E-Mail Number to '+txt+' [?/List]:');
  147.         if length(input)=0 then exit;
  148.         if input='?' then listmail (c)
  149.       until input<>'?';
  150.       n:=valu(input);
  151.       if (n<1) or (n>c.nummail) then n:=0
  152.     end;
  153.     getmsgnumber:=n
  154.   end;
  155.  
  156.   procedure deletemail (var c:catalogrec; n:integer);
  157.   begin
  158.     delmail (c.mail[n].fileindex);
  159.     writeln (c.mail[n].title,' by ',c.mail[n].sentby,' deleted.');
  160.     readcatalogs
  161.   end;
  162.  
  163.   procedure nextmail;
  164.   begin
  165.     lastread:=lastread+1;
  166.     if lastread>incoming.nummail
  167.       then
  168.         begin
  169.           lastread:=0;
  170.           if incoming.additional>0
  171.             then writeln ('You must delete some old mail first!')
  172.             else writeln ('Sorry, no more mail!')
  173.         end
  174.       else readincoming (lastread)
  175.   end;
  176.  
  177.   procedure readnum (n:integer);
  178.   begin
  179.     if (n<1) or (n>incoming.nummail) then begin
  180.       lastread:=0;
  181.       exit
  182.     end;
  183.     lastread:=n;
  184.     readincoming (n)
  185.   end;
  186.  
  187.   procedure readmail;
  188.   begin
  189.     readnum (getmsgnumber (incoming,'read'))
  190.   end;
  191.  
  192.   procedure listallmail;
  193.   begin
  194.     if incoming.nummail>0 then begin
  195.       writehdr ('incoming E-Mail');
  196.       listmail (incoming)
  197.     end;
  198.     if outgoing.nummail>0 then begin
  199.       writehdr ('outgoing E-Mail');
  200.       listmail (outgoing)
  201.     end
  202.   end;
  203.  
  204.   procedure newmail;
  205.   begin
  206.     lastread:=0;
  207.     repeat
  208.       lastread:=lastread+1;
  209.       if lastread>incoming.nummail then begin
  210.         writeln ('No (more) new mail.');
  211.         lastread:=0;
  212.         exit
  213.       end;
  214.       if not incoming.mail[lastread].read then begin
  215.         readincoming (lastread);
  216.         exit
  217.       end
  218.     until hungupon
  219.   end;
  220.  
  221.   procedure deleteincoming;
  222.   var n:integer;
  223.   begin
  224.     if checklastread then begin
  225.       n:=getmsgnumber (incoming,'delete');
  226.       if n=0 then exit;
  227.       lastread:=n
  228.     end;
  229.     deletemail (incoming,lastread);
  230.     lastread:=lastread-1
  231.   end;
  232.  
  233.   procedure killoutgoing;
  234.   var n:integer;
  235.   begin
  236.     n:=getmsgnumber (outgoing,'Kill');
  237.     if n<>0 then deletemail (outgoing,n)
  238.   end;
  239.  
  240.   procedure autoreply;
  241.   var n,un,line:integer;
  242.       me:message;
  243.       u:userrec;
  244.       uname:mstr;
  245.   begin
  246.     if checklastread then begin
  247.       n:=getmsgnumber (incoming,'Reply to');
  248.       if n=0 then exit;
  249.       lastread:=n
  250.     end;
  251.     with incoming.mail[lastread] do
  252.     begin
  253.      uname:=sentby;
  254.      if length(uname)=0 then exit;
  255.      un:=lookupuser (uname);
  256.      if un=0 then writeln ('User not found.') else begin
  257.        if anon and (ulvl<sysoplevel) then uname:=anonymousstr;
  258.        seek (ufile,un);
  259.        system.read (ufile,u);
  260.        if u.emailannounce>-1 then begin
  261.          writehdr (u.handle+'''s Announcement');
  262.          printtext (u.emailannounce)
  263.        end;
  264.        writehdr ('Sending E-Mail to '+uname);
  265.        emailing:=true;  {true}
  266.        writestr('Subject: *');
  267.        If Length(Input)=0 then exit;
  268.        Title:=Input;
  269.        line:=editor (me,false,'Re: '+title);
  270.        emailing:=false;
  271.        if line>=0 then addmail (un,line,me)
  272.      end
  273.     end;
  274.     readcatalogs
  275.   end;
  276.  
  277.   procedure viewoutgoing;
  278.   var n:integer;
  279.   begin
  280.     n:=getmsgnumber (outgoing,'view');
  281.     if n=0 then exit;
  282.     readit (outgoing.mail[n])
  283.   end;
  284.  
  285.   procedure showinfos;
  286.   var n:integer;
  287.   begin
  288.     if checklastread then begin
  289.       n:=getmsgnumber (incoming,'delete');
  290.       if n=0 then exit;
  291.       lastread:=n
  292.     end;
  293.     showinfoforms (incoming.mail[lastread].sentby)
  294.   end;
  295.  
  296.   procedure editmailuser;
  297.   var n:integer;
  298.       m:mstr;
  299.   begin
  300.     if checklastread then begin
  301.       n:=getmsgnumber (incoming,'edit the sender');
  302.       if n=0 then exit;
  303.       lastread:=n
  304.     end;
  305.     m:=incoming.mail[lastread].sentby;
  306.     n:=lookupuser (m);
  307.     if n=0 then begin
  308.       writeln (^B^R'User ',m,' not found!');
  309.       exit
  310.     end;
  311.     edituser (n)
  312.   end;
  313.  
  314.   procedure writecurmsg;
  315.   var b:boolean;
  316.   begin
  317.     b:=checklastread;
  318.     write (^B^M^R'Current Message: '^S);
  319.     if lastread=0
  320.       then writeln ('None'^R)
  321.       else with incoming.mail[lastread] do
  322.         writeln (^R'#'^S,lastread,^R': '^S,title,^R' sent by '^S,sentby,^R)
  323.   end;
  324.  
  325.   procedure showannouncement (un:integer);
  326.   var u:userrec;
  327.   begin
  328.     seek (ufile,un);
  329.     read (ufile,u);
  330.     if u.emailannounce>-1 then begin
  331.       writehdr (u.handle+'''s Announcement');
  332.       printtext (u.emailannounce)
  333.     end
  334.   end;
  335.  
  336.   procedure copymsg (var m:mailrec; un:integer);
  337.   var me:message;
  338.       line:integer;
  339.       b:boolean;
  340.   begin
  341.     me.anon:=m.anon;
  342.     me.title:='Was from '+m.sentby;
  343.     reloadtext (m.line,me);
  344.     showannouncement (un);
  345.     writestr ('Add a prologue? [A/Abort]: *');
  346.     if match(input,'a') then exit;
  347.     if yes then b:=reedit (me,true);
  348.     line:=maketext (me);
  349.     addmail (un,line,me);
  350.     readcatalogs
  351.   end;
  352.  
  353.   procedure copymail;
  354.   var n,un,line:integer;
  355.   begin
  356.     if checklastread then begin
  357.       n:=getmsgnumber (incoming,'copy');
  358.       if n=0 then exit;
  359.       lastread:=n
  360.     end;
  361.     n:=lastread;
  362.     writestr ('User to copy it to:');
  363.     if length(input)=0 then exit;
  364.     un:=lookupuser (input);
  365.     if un=0 then exit;
  366.     copymsg (incoming.mail[n],un)
  367.   end;
  368.  
  369.   procedure forwardmail;
  370.   var n,un:integer;
  371.   begin
  372.     if checklastread then begin
  373.       n:=getmsgnumber (incoming,'forward');
  374.       if n=0 then exit;
  375.       lastread:=n
  376.     end;
  377.     n:=lastread;
  378.     writestr ('User to forward it to:');
  379.     if length(input)=0 then exit;
  380.     un:=lookupuser (input);
  381.     if un=0 then exit;
  382.     copymsg (incoming.mail[n],un);
  383.     deletemail (incoming,n)
  384.   end;
  385.  
  386.   const groupclassstr:array [groupclass] of string[8]=
  387.           ('Public','Private','Personal');
  388.  
  389.   procedure opengfile;
  390.   begin
  391.     assign (gfile,bbsdatadir+'groups.dat');
  392.     reset (gfile);
  393.     if ioresult<>0 then begin
  394.       close (gfile);
  395.       rewrite (gfile)
  396.     end
  397.   end;
  398.  
  399.   procedure seekgfile (n:integer);
  400.   begin
  401.     seek (gfile,n-1)
  402.   end;
  403.  
  404.   function ismember (var g:grouprec; n:integer):boolean;
  405.   var cnt:integer;
  406.   begin
  407.     ismember:=true;
  408.     for cnt:=1 to g.nummembers do
  409.       if g.members[cnt]=n then exit;
  410.     ismember:=false
  411.   end;
  412.  
  413.   function groupaccess (var g:grouprec):boolean;
  414.   begin
  415.     if issysop then begin
  416.       groupaccess:=true;
  417.       exit
  418.     end;
  419.     groupaccess:=false;
  420.     case g.class of
  421.       publicgroup:groupaccess:=true;
  422.       personalgroup:groupaccess:=g.creator=unum;
  423.       privategroup:groupaccess:=ismember (g,unum)
  424.     end
  425.   end;
  426.  
  427.   function lookupgroup (nm:mstr):integer;
  428.   var cnt:integer;
  429.       g:grouprec;
  430.   begin
  431.     lookupgroup:=0;
  432.     seekgfile (1);
  433.     for cnt:=1 to filesize(gfile) do begin
  434.       read (gfile,g);
  435.       if groupaccess(g)
  436.         then if match(g.name,nm)
  437.           then begin
  438.             lookupgroup:=cnt;
  439.             exit
  440.           end
  441.     end
  442.   end;
  443.  
  444.   procedure listgroups;
  445.   var g:grouprec;
  446.       cnt:integer;
  447.   begin
  448.     writestr (^M'Name                          Class'^M);
  449.     if break then exit;
  450.     seekgfile (1);
  451.     for cnt:=1 to filesize(gfile) do begin
  452.       read (gfile,g);
  453.       if groupaccess(g) then begin
  454.         tab (g.name,30);
  455.         writeln (groupclassstr[g.class]);
  456.         if break then exit
  457.       end
  458.     end
  459.   end;
  460.  
  461.   function getgroupclass:groupclass;
  462.   var k:char;
  463.   begin
  464.     repeat
  465.       input[1]:=#0;
  466.       writestr ('Group class p(U)blic, p(R)ivate, p(E)rsonal:');
  467.       k:=upcase(input[1]);
  468.       if k in ['U','R','E'] then begin
  469.         case k of
  470.           'U':getgroupclass:=publicgroup;
  471.           'R':getgroupclass:=privategroup;
  472.           'E':getgroupclass:=personalgroup
  473.         end;
  474.         exit
  475.       end
  476.     until hungupon;
  477.     getgroupclass:=publicgroup
  478.   end;
  479.  
  480.   procedure addmember (var g:grouprec; n:integer);
  481.   begin
  482.     if ismember (g,n) then begin
  483.       writestr ('That person is already a member!');
  484.       exit
  485.     end;
  486.     if g.nummembers=maxgroupsize then begin
  487.       writestr ('Sorry, group is full!');
  488.       exit
  489.     end;
  490.     g.nummembers:=g.nummembers+1;
  491.     g.members[g.nummembers]:=n
  492.   end;
  493.  
  494.   procedure addgroup;
  495.   var g:grouprec;
  496.       un:integer;
  497.   begin
  498.     writestr ('Group name:');
  499.     if (length(input)=0) or (input='?') then exit;
  500.     g.name:=input;
  501.     if lookupgroup (g.name)<>0 then begin
  502.       writestr (^M'Group already exists!');
  503.       exit
  504.     end;
  505.     g.class:=getgroupclass;
  506.     g.creator:=unum;
  507.     g.nummembers:=0;
  508.     writestr ('Include yourself in the group? *');
  509.     if yes then addmember (g,unum);
  510.     writestr (^M'Enter names of members, CR when done'^M);
  511.     repeat
  512.       writestr ('Member:');
  513.       if length(input)>0 then begin
  514.         un:=lookupuser (input);
  515.         if un=0
  516.           then writestr ('User not found!')
  517.           else addmember (g,un)
  518.       end
  519.     until hungupon or (length(input)=0) or (g.nummembers=maxgroupsize);
  520.     seek (gfile,filesize (gfile));
  521.     write (gfile,g);
  522.     writestr (^M'Group created!');
  523.     writelog (13,1,g.name)
  524.   end;
  525.  
  526.   function maybecreategroup (nm:mstr):integer;
  527.   begin
  528.     writestr ('Create group '+nm+'? *');
  529.     if yes then begin
  530.       addtochain (nm);
  531.       addgroup;
  532.       maybecreategroup:=lookupgroup (nm)
  533.     end else maybecreategroup:=0
  534.   end;
  535.  
  536.   function getgroupnum:integer;
  537.   var groupname:mstr;
  538.       gn:integer;
  539.       g:grouprec;
  540.   begin
  541.     getgroupnum:=0;
  542.     groupname:=copy(input,2,255);
  543.     repeat
  544.       if length(groupname)=0 then begin
  545.         writestr (^M'  Group name [?/List]:');
  546.         if length(input)=0 then exit;
  547.         if input[1]='/' then delete (input,1,1);
  548.         if length(input)=0 then exit;
  549.         groupname:=input
  550.       end;
  551.       if groupname='?' then begin
  552.         listgroups;
  553.         groupname:=''
  554.       end
  555.     until length(groupname)>0;
  556.     gn:=lookupgroup (groupname);
  557.     if gn=0 then begin
  558.       writestr ('Group not found!');
  559.       gn:=maybecreategroup (groupname);
  560.       if gn=0 then exit
  561.     end;
  562.     seekgfile (gn);
  563.     read (gfile,g);
  564.     if not groupaccess(g)
  565.       then writestr ('Sorry, you may not access that group!')
  566.       else getgroupnum:=gn
  567.   end;
  568.  
  569.   procedure sendmail;
  570.   var g:grouprec;
  571.  
  572.     procedure sendit (showeach:boolean);
  573.     var un,line,cnt:integer;
  574.         me:message;
  575.  
  576.       procedure addit (n:integer);
  577.       begin
  578.         if n<>unum then begin
  579.           if showeach then writeln (lookupuname(n));
  580.           addmail (n,line,me)
  581.         end else deletetext (line)
  582.       end;
  583.  
  584.     begin
  585.       if g.nummembers<1 then exit;
  586.       writehdr ('Sending E-Mail to '+g.name);
  587.       sendstr:=g.name;
  588.       nosendprompt:=true;
  589.       line:=editor (me,true,'Sending E-Mail to '+g.name);
  590.       nosendprompt:=false;
  591.       sendstr:='';
  592.       if line<0 then exit;
  593.       addit (g.members[1]);
  594.       if g.nummembers=1 then exit;
  595.       writeln (^B^M);
  596.       for cnt:=2 to g.nummembers do begin
  597.     un:=g.members[cnt];
  598.         if un<>unum then begin
  599.       line:=maketext (me);
  600.           if line<0 then begin
  601.             writeln (cnt,' of ',g.nummembers,' completed.');
  602.             exit
  603.           end;
  604.           addit (un);
  605.           if emails>32760 then emails:=0;
  606.           emails:=emails+1;
  607.         end
  608.       end;
  609.  
  610.       readcatalogs
  611.     end;
  612.  
  613.     procedure sendtogroup;
  614.     var gn:integer;
  615.     begin
  616.       gn:=getgroupnum;
  617.       if gn=0 then exit;
  618.       seekgfile (gn);
  619.       read (gfile,g);
  620.       sendit (true)
  621.     end;
  622.  
  623.     procedure sendtousers;
  624.     var cnt,un:integer;
  625.     begin
  626.       g.name:=input;
  627.       un:=lookupuser (g.name);
  628.       if un=0 then begin
  629.         writestr (^M'User not found.');
  630.         exit
  631.       end;
  632.       g.nummembers:=1;
  633.       g.members[1]:=un;
  634.       cnt:=1;
  635.       showannouncement (un);
  636.       repeat
  637.         writestr ('Carbon copy #'+strr(cnt)+' to:');
  638.         if length(input)>0 then begin
  639.           un:=lookupuser (input);
  640.           if un=0
  641.             then writestr (^M'User not found!'^M)
  642.             else if ismember (g,un)
  643.               then writestr (^M'User is already receiving a copy!')
  644.               else begin
  645.                 cnt:=cnt+1;
  646.                 g.nummembers:=cnt;
  647.                 g.members[cnt]:=un;
  648.                 showannouncement (un)
  649.               end
  650.         end
  651.       until (length(input)=0) or (cnt=maxgroupsize);
  652.       sendit (g.nummembers>1)
  653.     end;
  654.  
  655.   begin
  656.     writestr ('User to send E-Mail to [''/'' for Group]:');
  657.     if length(input)<>0
  658.       then if input[1]='/'
  659.         then sendtogroup
  660.         else sendtousers
  661.   end;
  662.  
  663.   procedure zippymail;
  664.   var un:integer;
  665.       me:message;
  666.       l:integer;
  667.   begin
  668.     writestr ('Send mail to:');
  669.     if length(input)=0 then exit;
  670.     un:=lookupuser (input);
  671.     if un=0 then begin
  672.       writestr ('No such user!');
  673.       exit
  674.     end;
  675.     titlestr:='Zippy Mail';
  676.     l:=editor (me,false,'Zippy Mail');
  677.     if l<0 then exit;
  678.     me.title:='-----';
  679.     me.anon:=false;
  680.     addmail (un,l,me);
  681.     readcatalogs
  682.   end;
  683.  
  684.   {overlay} procedure sysopmail;
  685.  
  686.     function sysopreadnum (var n:integer):boolean;
  687.     var m:mailrec;
  688.         k:char;
  689.         done:boolean;
  690.  
  691.       procedure showit;
  692.       begin
  693.         writeln (^B^N^M'Number  '^S,n,
  694.                      ^M'Sent by '^S,m.sentby,
  695.                      ^M'Sent to '^S,lookupuname (m.sentto),
  696.                      ^M'Sent on '^S,datestr(m.when),' at ',timestr(m.when),
  697.                      ^M'Title:  '^S,m.title,^M);
  698.         printtext (m.line);
  699.       end;
  700.  
  701.       procedure changen (m:integer);
  702.       var r2:integer;
  703.       begin
  704.         r2:=filesize(mfile)-1;
  705.         if (m<1) or (m>r2) then begin
  706.           writestr ('Continue scan at [1-'+strr(r2)+']:');
  707.           m:=valu(input)
  708.         end;
  709.         if (m>=1) and (m<=r2) then begin
  710.           n:=m-1;
  711.           done:=true
  712.         end
  713.       end;
  714.  
  715.     var q:integer;
  716.     begin
  717.       sysopreadnum:=false;
  718.       seek (mfile,n);
  719.       read (mfile,m);
  720.       showit;
  721.       repeat
  722.         done:=false;
  723.         q:=menu ('Electronic-Mail Scan','ESCAN','QSERDNAC_#?');
  724.         if q<0
  725.           then changen (-q)
  726.           else case q of
  727.             1:sysopreadnum:=true;
  728.             2:sendmail;
  729.             3:edituser(lookupuser(m.sentby));
  730.             4:edituser(m.sentto);
  731.             5:delmail(n);
  732.             6,9:done:=true;
  733.             7:showit;
  734.             8:changen (0);
  735.             10:begin
  736. writeln ('C╔═════════════════════════════════════╗Hs');
  737. writeln ('uC║ Electronic-Mail Scan Section        ║Hs');
  738. writeln ('uC╚═════════════════════════════════════╝HHC╔════s');
  739. writeln ('u═════════════════════════════════╗HC║ [A]  s');
  740. writeln ('uDisplay Mail                   ║HC║ [Cs');
  741. writeln ('u]  Edit Mail                      ║HC║ [s');
  742. writeln ('uD]  Delete Mail                    ║Hs');
  743. writeln ('uC║ [E]  Edit User Sent from            s');
  744. writeln ('u║HC║ [N]  Next Mail               s');
  745. writeln ('u       ║HC║ [O]  Edit User Sent tos');
  746. writeln ('u              ║HC║ [Q]  Quit      s');
  747. writeln ('u                     ║HC║ [R]  Reas');
  748. writeln ('ud Mail                      ║HC║ [S]  s');
  749. writeln ('uSend Mail                      ║HC║ [#s');
  750. writeln ('u]  Read Mail #                    ║HC║ s');
  751. writeln ('u[CRNext Mail                      ║Hs');
  752. writeln ('uC║ [?]  View This Menu                 s');
  753. writeln ('u║HC╚═════════════════════════════════════╝');
  754. writeln;
  755. pause;
  756.            end;
  757.           end
  758.       until (q=1) or done or hungupon
  759.     end;
  760.  
  761.     procedure someoneelse;
  762.     var t,last:integer;
  763.     begin
  764.       writestr (^M'User name to look at:');
  765.       if (length(input)=0) or hungupon then exit;
  766.       writeln;
  767.       t:=lookupuser (input);
  768.       if t=0 then begin
  769.         writestr ('No such user!');
  770.         exit
  771.       end;
  772.       writelog (14,1,input);
  773.       writestr ('Looking in mailbox...');
  774.       last:=searchmail(0,t);
  775.       if last=0 then writestr ('No mail.');
  776.       while last<>0 do begin
  777.         seek (mfile,last);
  778.         read (mfile,m);
  779.         if sysopreadnum (last) or hungupon then exit;
  780.         last:=searchmail(last,t)
  781.       end;
  782.       writeln (^B^M'No more mail!')
  783.     end;
  784.  
  785.     procedure scanall;
  786.     var r1,r2:integer;
  787.         u:userrec;
  788.         n:mstr;
  789.     begin
  790.       r2:=filesize(mfile)-1;
  791.       writestr ('Start scanning at [1-'+strr(r2)+']:');
  792.       if length(input)=0 then r1:=1 else r1:=valu(input);
  793.       if (r1<1) or (r1>r2) then exit;
  794.       writelog (14,2,'');
  795.       while r1<filesize(mfile) do begin
  796.         seek (mfile,r1);
  797.         read (mfile,m);
  798.         if m.sentto<>0 then
  799.           if sysopreadnum (r1) then exit;
  800.         r1:=r1+1
  801.       end;
  802.       writeln (^B^M'No more mail!')
  803.     end;
  804.  
  805.     procedure groupflags;
  806.     var gn,bn,un,cnt:integer;
  807.         bname:sstr;
  808.         ac:accesstype;
  809.         g:grouprec;
  810.         u:userrec;
  811.     begin
  812.       writestr ('Grant all group members access to a sub-board'^M);
  813.       gn:=getgroupnum;
  814.       if gn=0 then exit;
  815.       writestr ('  Sub-board access name/number:');
  816.       writeln;
  817.       bname:=input;
  818.       opentempbdfile;
  819.       bn:=searchboard(bname);
  820.       closetempbdfile;
  821.       if bn=-1 then begin
  822.         writeln ('No such board!');
  823.         exit
  824.       end;
  825.       writelog (14,3,bname);
  826.       for cnt:=1 to g.nummembers do begin
  827.         un:=g.members[cnt];
  828.         writeln (lookupuname(un));
  829.         seek (ufile,un);
  830.         read (ufile,u);
  831.         setuseraccflag (u,bn,letin);
  832.         seek (ufile,un);
  833.         write (ufile,u)
  834.       end
  835.     end;
  836.  
  837.     procedure deleterange;
  838.     var first,last,num,cnt:integer;
  839.     begin
  840.       writehdr ('Mass Mail Delete');
  841.       parserange (filesize(mfile)-1,first,last);
  842.       if first=0 then exit;
  843.       num:=last-first;
  844.       if num<>1 then begin
  845.         writeln ('Warning! ',num,' pieces of mail will be deleted!');
  846.         writestr ('Are you sure? *');
  847.         if not yes then exit
  848.       end;
  849.       for cnt:=last downto first do begin
  850.         delmail (cnt);
  851.         write (cnt,' ');
  852.         if break then begin
  853.           writestr (^B^M'Aborted!');
  854.           exit
  855.         end
  856.       end;
  857.       writeln
  858.     end;
  859.  
  860.   var q:integer;
  861.   begin
  862.     repeat
  863.       q:=menu ('Electronic-Mail Sysop','ESYSOP','QLSGD?');
  864.       case q of
  865.         2:someoneelse;
  866.         3:scanall;
  867.         4:groupflags;
  868.         5:deleterange;
  869.         6:begin
  870. writeln ('C╔═════════════════════════════════════╗Hs');
  871. writeln ('uC║ Electronic-Mail Sysop Section       ║Hs');
  872. writeln ('uC╚═════════════════════════════════════╝HHC╔════s');
  873. writeln ('u═════════════════════════════════╗HC║ [D]  s');
  874. writeln ('uDelete Range of Mail           ║HC║ [Gs');
  875. writeln ('u]  Use Group for Sub-Board Access ║HC║ [s');
  876. writeln ('uL]  Look in Someone''s Mailbox     ║Hs');
  877. writeln ('uC║ [Q]  Quit                           s');
  878. writeln ('u║HC║ [S]  Scan All Mail           s');
  879. writeln ('u       ║HC║ [?]  View This Menu   s');
  880. writeln ('u              ║HC╚═══════════════════════════════A');
  881. writeln ('C══════╝');
  882. writeln;
  883. pause;
  884.            end;
  885.       end
  886.     until (q=1) or hungupon;
  887.     readcatalogs
  888.   end;
  889.  
  890.   {overlay} procedure announcement;
  891.  
  892.     procedure delannouncement;
  893.     begin
  894.       if urec.emailannounce=-1 then begin
  895.         writestr (^M'You don''t HAVE an announcement.');
  896.         exit
  897.       end;
  898.       deletetext (urec.emailannounce);
  899.       urec.emailannounce:=-1;
  900.       writeurec;
  901.       writestr (^M'Deleted.')
  902.     end;
  903.  
  904.     procedure createannouncement;
  905.     var me:message;
  906.     begin
  907.       if urec.emailannounce>=0 then deletetext (urec.emailannounce);
  908.       titlestr:='User Announcement';
  909.       urec.emailannounce:=editor (me,false,'User Announcement');
  910.       writeurec
  911.     end;
  912.  
  913.   var k:char;
  914.   begin
  915.     if urec.emailannounce>=0
  916.       then showannouncement (unum)
  917.       else writestr ('You don''t have an announcement right now.');
  918.     writestr (^M'[C]reate/replace, [D]elete, or [Q]uit:');
  919.     if length(input)=0 then exit;
  920.     k:=upcase(input[1]);
  921.     case k of
  922.       'D':delannouncement;
  923.       'C':createannouncement
  924.     end
  925.   end;
  926.  
  927.   {overlay} procedure groupediting;
  928.   var curgroup:integer;
  929.       cg:grouprec;
  930.  
  931.     procedure selectgroup;
  932.     var n:integer;
  933.         g:grouprec;
  934.     begin
  935.       delete (input,1,1);
  936.       repeat
  937.         if length(input)=0 then writestr ('Select group [?/List]:');
  938.         if length(input)=0 then exit;
  939.         if input='?' then begin
  940.           listgroups;
  941.           n:=0;
  942.           input[0]:=#0
  943.         end else begin
  944.           n:=lookupgroup (input);
  945.           if n=0 then begin
  946.             writestr ('Group not found!');
  947.             exit
  948.           end
  949.         end
  950.       until n>0;
  951.       seekgfile (n);
  952.       read (gfile,g);
  953.       if groupaccess(g) then begin
  954.         curgroup:=n;
  955.         cg:=g
  956.       end else writestr ('You can''t access that group.')
  957.     end;
  958.  
  959.     function nocurgroup:boolean;
  960.     begin
  961.       nocurgroup:=curgroup=0;
  962.       if curgroup=0 then writestr ('No group as been S)elected!')
  963.     end;
  964.  
  965.     function notcreator:boolean;
  966.     var b:boolean;
  967.     begin
  968.       if nocurgroup then b:=true else begin
  969.         b:=(unum<>cg.creator) and (not issysop);
  970.         if b then writestr ('You aren''t the creator of this group!')
  971.       end;
  972.       notcreator:=b;
  973.     end;
  974.  
  975.     procedure writecurgroup;
  976.     begin
  977.       seekgfile (curgroup);
  978.       write (gfile,cg)
  979.     end;
  980.  
  981.     procedure deletegroup;
  982.     var cnt:integer;
  983.         g:grouprec;
  984.     begin
  985.       if notcreator then exit;
  986.       writestr ('Delete group '+cg.name+': Are you sure? *');
  987.       if not yes then exit;
  988.       writelog (13,2,cg.name);
  989.       for cnt:=curgroup to filesize(gfile)-1 do begin
  990.         seekgfile (cnt+1);
  991.         read (gfile,g);
  992.         seekgfile (cnt);
  993.         write (gfile,g)
  994.       end;
  995.       seek (gfile,filesize(gfile)-1);
  996.       truncate (gfile);
  997.       curgroup:=0
  998.     end;
  999.  
  1000.     procedure listmembers;
  1001.     var cnt:integer;
  1002.     begin
  1003.       if nocurgroup then exit;
  1004.       writeln ('Creator:           '^S,lookupuname (cg.creator));
  1005.       writeln ('Number of members: '^S,cg.nummembers,^M);
  1006.       for cnt:=1 to cg.nummembers do begin
  1007.         if break then exit;
  1008.         writeln (cnt:2,'. ',lookupuname (cg.members[cnt]))
  1009.       end
  1010.     end;
  1011.  
  1012.     procedure readdmember;
  1013.     var n:integer;
  1014.     begin
  1015.       if notcreator then exit;
  1016.       writestr ('User to add:');
  1017.       if length(input)=0 then exit;
  1018.       n:=lookupuser (input);
  1019.       if n=0
  1020.         then writestr ('User not found!')
  1021.         else begin
  1022.           addmember (cg,n);
  1023.           writecurgroup
  1024.         end
  1025.     end;
  1026.  
  1027.     procedure removemember;
  1028.  
  1029.       procedure removemembernum (n:integer);
  1030.       var cnt:integer;
  1031.       begin
  1032.         cg.nummembers:=cg.nummembers-1;
  1033.         for cnt:=n to cg.nummembers do cg.members[cnt]:=cg.members[cnt+1];
  1034.         writecurgroup;
  1035.         writestr ('Member removed.')
  1036.       end;
  1037.  
  1038.     var cnt,n:integer;
  1039.     begin
  1040.       if notcreator then exit;
  1041.       repeat
  1042.         writestr ('User to remove [?/List]:');
  1043.         if length(input)=0 then exit;
  1044.         if input='?' then begin
  1045.           input[0]:=#0;
  1046.           listmembers
  1047.         end
  1048.       until length(input)>0;
  1049.       n:=lookupuser (input);
  1050.       if n=0 then begin
  1051.         writestr ('User not found!');
  1052.         exit
  1053.       end;
  1054.       for cnt:=1 to cg.nummembers do if cg.members[cnt]=n then begin
  1055.         removemembernum (cnt);
  1056.         exit
  1057.       end;
  1058.       writestr ('User isn''t in the group!')
  1059.     end;
  1060.  
  1061.     procedure setclass;
  1062.     begin
  1063.       if notcreator then exit;
  1064.       writeln ('Current class: '^S,groupclassstr [cg.class],^M);
  1065.       cg.class:=getgroupclass;
  1066.       writecurgroup
  1067.     end;
  1068.  
  1069.     procedure setcreator;
  1070.     var m:mstr;
  1071.         n:integer;
  1072.     begin
  1073.       if notcreator then exit;
  1074.       writeln ('Current creator: '^S,lookupuname(cg.creator),^M);
  1075.       writestr ('Enter new creator:');
  1076.       if length(input)=0 then exit;
  1077.       n:=lookupuser(input);
  1078.       if n=0 then begin
  1079.         writestr ('User not found!');
  1080.         exit
  1081.       end;
  1082.       cg.creator:=n;
  1083.       writecurgroup;
  1084.       if (n<>unum) and (not issysop) then curgroup:=0
  1085.     end;
  1086.  
  1087.     procedure addbylevel;
  1088.     var n,cnt:integer;
  1089.         u:userrec;
  1090.     begin
  1091.       if notcreator then exit;
  1092.       writestr ('Let in all people over level:');
  1093.       n:=valu(input);
  1094.       if n=0 then exit;
  1095.       seek (ufile,1);
  1096.       for cnt:=1 to numusers do begin
  1097.         read (ufile,u);
  1098.         if (length(u.handle)>0) and (u.level>=n) then begin
  1099.           if cg.nummembers=maxgroupsize then begin
  1100.             writestr ('Sorry, group is full!');
  1101.             exit
  1102.           end;
  1103.           addmember (cg,cnt)
  1104.         end
  1105.       end
  1106.     end;
  1107.  
  1108.   var q:integer;
  1109.   begin
  1110.     curgroup:=0;
  1111.     repeat
  1112.       write (^B^M^M^R'Group selected: '^S);
  1113.       if curgroup=0
  1114.         then writeln ('None')
  1115.         else writeln (cg.name);
  1116.       q:=menu ('Group Editing','GROUP','QS*LGDVMRCAE?');
  1117.       case q of
  1118.         2,3:selectgroup;
  1119.         4:listgroups;
  1120.         5:addgroup;
  1121.         6:deletegroup;
  1122.         7:listmembers;
  1123.         8:readdmember;
  1124.         9:removemember;
  1125.         10:setcreator;
  1126.         11:setclass;
  1127.         12:addbylevel;
  1128.         13:begin
  1129. writeln ('C╔═════════════════════════════════════╗Hs');
  1130. writeln ('uC║ Group Editing Section               ║Hs');
  1131. writeln ('uC╚═════════════════════════════════════╝HHC╔════s');
  1132. writeln ('u═════════════════════════════════╗HC║ [A]  s');
  1133. writeln ('uSet Class                      ║HC║ [Cs');
  1134. writeln ('u]  Change Creator                 ║HC║ [s');
  1135. writeln ('uD]  Delete Group                   ║Hs');
  1136. writeln ('uC║ [E]  Add by Level                   s');
  1137. writeln ('u║HC║ [G]  Add Group               s');
  1138. writeln ('u       ║HC║ [L]  List Group       s');
  1139. writeln ('u              ║HC║ [M]  Read Groups');
  1140. writeln ('u Mail                ║HC║ [Q]  Quis');
  1141. writeln ('ut                           ║HC║ [R]  s');
  1142. writeln ('uRemove Member                  ║HC║ [Ss');
  1143. writeln ('u]  Select Group                   ║HC║ s');
  1144. writeln ('u[V]  List Members                   ║Hs');
  1145. writeln ('uC║ [*]  Select Group                   s');
  1146. writeln ('u║HC║ [?]  View This Menu          s');
  1147. writeln ('u       ║HC╚═════════════════════════════════════╝');
  1148. writeln;
  1149. pause;
  1150.            end;
  1151.       end
  1152.     until hungupon or (q=1)
  1153.   end;
  1154.  
  1155. var q:integer;
  1156. begin
  1157.   cursection:=emailsysop;
  1158.   writehdr ('FAQ Electronic-Mail Service');
  1159.   opengfile;
  1160.   readcatalogs;
  1161.   writenummail (incoming,'incoming');
  1162.   writenummail (outgoing,'outgoing');
  1163.   lastread:=0;
  1164.   repeat
  1165.     writecurmsg;
  1166.     q:=menu ('Electronic-Mail','EMAIL','QRSLN_%@DKAV#E@CFGI@Z?');
  1167.     if q<0
  1168.       then readnum (abs(q))
  1169.       else case q of
  1170.         2:autoreply;
  1171.         3:sendmail;
  1172.         4:listallmail;
  1173.         5:newmail;
  1174.         6:nextmail;
  1175.         7:sysopmail;
  1176.         8:deleteincoming;
  1177.         9:killoutgoing;
  1178.         10:announcement;
  1179.         11:viewoutgoing;
  1180.         13:editmailuser;
  1181.         14:copymail;
  1182.         15:forwardmail;
  1183.         16:groupediting;
  1184.         17:showinfos;
  1185.         18:zippymail;
  1186.         19:begin
  1187. writeln ('C╔═════════════════════════════════════╗Hs');
  1188. writeln ('uC║ Electronic-Mail Section             ║Hs');
  1189. writeln ('uC╚═════════════════════════════════════╝HHC╔════s');
  1190. writeln ('u═════════════════════════════════╗HC║ [A]  s');
  1191. writeln ('uEdit/Create Announcement       ║HC║ [Cs');
  1192. writeln ('u]  Copy Mail                      ║HC║ [s');
  1193. writeln ('uD]  Delete Incoming                ║Hs');
  1194. writeln ('uC║ [E]  Edit User Sent from            s');
  1195. writeln ('u║HC║ [F]  Forward Mail            s');
  1196. writeln ('u       ║HC║ [G]  Group Edit       s');
  1197. writeln ('u              ║HC║ [I]  Infoforms s');
  1198. writeln ('ufor Sent from User   ║HC║ [K]  Kils');
  1199. writeln ('ul Outgoing                  ║HC║ [L]  s');
  1200. writeln ('uList Mail     ╔══════════════════════════════════s');
  1201. writeln ('u═══╗HC║ [N]  New Mail      s');
  1202. writeln ('u║ [S]  Send Mail                      ');
  1203. writeln ('HC║ [Q]  Quit          ║ [s');
  1204. writeln ('uV]  View Outgoing                  ║Hs');
  1205. writeln ('uC║ [R]  Read Mail     ║ [s');
  1206. writeln ('uZ]  Zippy Mail                     ║Hs');
  1207. writeln ('uC╚════════════════════║ [#]  s');
  1208. writeln ('uRead Mail #                    ║HC║ [CRs');
  1209. writeln ('uRead Next Mail                 ║HC║ [s');
  1210. writeln ('u?]  View This Menu                 ║HA');
  1211. writeln ('C╚═════════════════════════════════════╝');
  1212. writeln;
  1213. pause;
  1214.            end;
  1215.       end
  1216.   until hungupon or (q=1);
  1217.   close (gfile)
  1218. end;
  1219.  
  1220. begin
  1221. end.
  1222.