home *** CD-ROM | disk | FTP | other *** search
/ The Devil's Doorknob BBS Capture (1996-2003) / devilsdoorknobbbscapture1996-2003.iso / Dloads / OTHERUTI / WWIV310S.ZIP / PART2.PAS < prev    next >
Pascal/Delphi Source File  |  1986-04-01  |  40KB  |  1,114 lines
  1. overlay function getuser:boolean;
  2. var tries:integer; pasw,phone:str; nu,ok:boolean;
  3. begin
  4.   macok:=false; nu:=false;
  5.   window(1,5,80,25);
  6.   echo:=true;nl;nl;nl;nl;nl;
  7.   pasw:='';
  8.   printfile('gfiles\welcome.msg');
  9.   tries:=0;
  10.   repeat
  11.     repeat
  12.       print('Enter number or name or "NEW"');
  13.       prompt('NN: '); finduser(usernum);
  14.       if usernum=0 then tries:=tries+1;
  15.     until (tries=3) or hangup or (usernum<>0);
  16.     if tries=3 then hangup:=true;
  17.     ok:=true;
  18.     if usernum=-1 then begin
  19.       if incom and systat.closedsystem then begin
  20.         printfile('gfiles\system.msg');
  21.         printfile('gfiles\nonewusr.msg');
  22.         if not hangup then delay(5000); pasw:='';
  23.         while not empty do pasw:=pasw+inkey;
  24. {        if pasw=#14+#21 then nu:=true else} hangup:=true;
  25.       end else
  26.         nu:=true;
  27.     end else begin
  28.       echo:=false; reset(uf); seek(uf,usernum); read(uf,thisuser);
  29.       topscr; mcursor;
  30.       prompt('PW: '); input(pasw,8);
  31.       prompt('PH: ###-###-'); input(phone,4); echo:=true;
  32.       if (thisuser.pw<>pasw) or (copy(thisuser.ph,9,4)<>phone) then begin
  33.         print(''); print(chr(7)+'ILLEGAL LOGON'+CHR(7)); PRINT('');
  34.         if (not hangup) and (usernum<>0) then sl1('### ILLEGAL LOGON USER #'+cstr(usernum));
  35.         thisuser.illegal:=thisuser.illegal+1; seek(uf,usernum);
  36.         write(uf,thisuser);
  37.         OK:=FALSE; tries:=tries+1; if tries=3 then hangup:=true;
  38.       end;
  39.       if (thisuser.sl=255) and ok and incom then begin echo:=false;
  40.         prompt(':'); input(pasw,8); echo:=true; if pasw<>systat.sysoppw then begin
  41.           nl;print(chr(7)+'ILLEGAL LOGON'+chr(7)); nl; ok:=false;
  42.           sl1('$$$$ ILLEGAL SYSOP SECOND PW $$$$');
  43.         end;
  44.       end;
  45.       close(uf);
  46.     end;
  47.   until hangup or ok or (tries=3);
  48.   if not nu then begin
  49.     if (rlogon in thisuser.ac) and (thisuser.laston=date) then begin
  50.       print('You can only log on once per day.');
  51.       hangup:=true; sl1(thisuser.name+' #'+cstr(usernum)+' tried logging on');
  52.     end;
  53.     if tries=3 then hangup:=true;
  54.   end;
  55.   getuser:=nu;
  56. end;
  57.  
  58. overlay procedure readmail;
  59. var pl,i,i1,mc,x,nmf:integer; c:char; abort,next:boolean; mr:mailrec; a:boolean;
  60.   filevar:file; ii,is:str;
  61. begin
  62.   nl; helpl:='M';
  63.   if thisuser.waiting=0 then print('You have no mail.') else begin
  64.     reset(mailfile);pl:=filesize(mailfile);
  65.     if thisuser.waiting>1 then begin
  66.       reset(uf);nl;
  67.       print('Mail summary: :'+cstr(thisuser.waiting)+': pieces:'); mc:=0;
  68.       i:=0; i1:=1; while (i<filesize(mailfile)) and not hangup do begin
  69.         seek(mailfile,i); read(mailfile,mr); if mr.destin=usernum then
  70.          if (mr.from<=0) and not (emailn in seclev[thisuser.sl].anst)
  71.           then begin print(cstr(i1)+': >UNKNOWN<'); mc:=mc+1; end else begin
  72.           seek(uf,abs(mr.from)); read(uf,user); print(''+cstr(i1)+' :'+user.name+
  73.           ' #'+cstr(abs(mr.from))); i1:=i1+1; mc:=mc+1;
  74.         end;
  75.         i:=i+1;
  76.       end;
  77.       close(uf);nl;nl;
  78.       print('Hit <ENTER> to read mail'); input(ii,2);nl;nl;
  79.       thisuser.waiting:=mc; if usernum=1 then fw:=mc;
  80.     end;
  81.     i:=0; nmf:=0;
  82.     repeat
  83.       abort:=false;
  84.       if i<=filesize(mailfile)-1 then begin seek(mailfile,i); read(mailfile,mr); end;
  85.       while (i<filesize(mailfile)-1) and (mr.destin<>usernum) do begin
  86.         i:=i+1; seek(mailfile,i); read(mailfile,mr);
  87.       end;
  88.       if (mr.destin=usernum) and (i<=filesize(mailfile)-1) then begin
  89.       nmf:=nmf+1;
  90.       repeat
  91.         a:=false; if emailn in seclev[thisuser.sl].anst then a:=true;
  92.         irt:='Your previous letter';
  93.         nl; if mr.title<>'' then print('Title: '+mr.title); irt:=mr.title;
  94.         if irt='' then irt:='Your previous letter';
  95.         readmsg(mr.msg,a,next); next:=false; tleft;
  96.         repeat
  97.           nl;prompt('Mail: D,I,R,A,? :');
  98.           if cs then onek(c,'ZDIRAV?') else onek(c,'DIRA?');
  99.           case c of
  100.             'I':next:=true;
  101.             '?':begin
  102.                   print('D:elete     I:gnore');
  103.                   print('R:e-read    A:uto-reply');
  104.                 end;
  105.             'A','D','Z':begin
  106.                       if c<>'Z' then ssm(abs(mr.from),nam+' read your letter on '+date);
  107.                       is:=rmail(i); next:=true; nmf:=nmf-1;
  108.                       thisuser.waiting:=thisuser.waiting-1;
  109.                       topscr;
  110.                     end;
  111.             'V':if cs then vallastuser;
  112.           end;
  113.           if c='A' then begin close(mailfile); autoreply; reset(mailfile); end;
  114.         until (C IN ['D','I','R','A','Z']) or hangup;
  115.       until next or hangup;
  116.       i:=i+1;
  117.     end else i:=i+1;
  118.     until (i>filesize(mailfile)-1) or hangup;
  119.     close(mailfile); if not hangup then thisuser.waiting:=nmf;
  120.   end;
  121. end;
  122.  
  123. overlay procedure vote;
  124. var vdata:file of vdatar; vd:vdatar; int,int2:integer; i,i1,ij:str; abort,next,done,lq:boolean;
  125.  
  126. procedure vote1(qnum:integer);
  127. var cv,tv,ii:integer; i,i1,i2:str; c:char;
  128. begin
  129.   i2:='                                  '; cls;
  130.   seek(vdata,qnum-1); read(vdata,vd);
  131.   if vd.numa=0 then print('Inactive question.') else begin
  132.     print('Question #'+cstr(qnum)+':');
  133.     print(vd.question);
  134.     tv:=0; for ii:=1 to vd.numa do tv:=tv+vd.answ[ii].numres;
  135.     print('Users voting: '+ctp(tv,systat.users)); if tv=0 then tv:=1;
  136.     nl; print('0:No Comment');
  137.     ij:='Q0';
  138.     for ii:=1 to vd.numa do begin
  139.       ij:=ij+cstr(ii);
  140.       i1:=copy(vd.answ[ii].ans,1,25);
  141.       i1:=i1+copy(i2,1,25-length(i1))+' :';
  142.       i:=copy(cstr(vd.answ[ii].numres),1,3);
  143.       i1:=i1+copy(i2,1,3-length(i))+i+' '+ctp(vd.answ[ii].numres,tv);
  144.       print(cstr(ii)+':'+i1);
  145.     end;
  146.     nl;nl;
  147.     i:='Your vote: '+vd.answ[thisuser.vote[qnum]].ans; print(i);
  148.     if not(rvoting in thisuser.ac) and (not hangup) and (thisuser.sl>10) then begin
  149.       prompt('Change it? '); if yn then begin
  150.         nl;prompt('Which number (0-'+cstr(vd.numa)+') ? '); onek(i[1],ij);
  151.         i[0]:=#1; ii:=value(i); if (i<>'') and (ii>=0) and (ii<=vd.numa) then begin
  152.           if thisuser.vote[qnum]<>0 then
  153.             vd.answ[thisuser.vote[qnum]].numres:=vd.answ[thisuser.vote[qnum]].numres-1;
  154.           thisuser.vote[qnum]:=ii;
  155.           if ii<>0 then vd.answ[ii].numres:=vd.answ[ii].numres+1;
  156.           seek(vdata,qnum-1); write(vdata,vd);
  157.           cls; print('Current Standings: '); nl; print(vd.question); nl;
  158.           tv:=0; for ii:=1 to vd.numa do tv:=tv+vd.answ[ii].numres;
  159.           print('Users voting: '+ctp(tv,systat.users)); nl; if tv=0 then tv:=1;
  160.           for ii:=1 to vd.numa do begin
  161.             i1:=copy(vd.answ[ii].ans,1,25);
  162.             i1:=i1+copy(i2,1,25-length(i1))+' :';
  163.             i:=copy(cstr(vd.answ[ii].numres),1,3);
  164.             i1:=i1+copy(i2,1,3-length(i))+i+' '+ctp(vd.answ[ii].numres,tv);
  165.             print(cstr(ii)+':'+i1);
  166.           end;
  167.         end;
  168.       end;
  169.     end;
  170.     dump;
  171.   end;
  172. end;
  173.  
  174. begin
  175.   i:=''; done:=false; lq:=true; helpl:='V';
  176.   assign(vdata,'gfiles\voting.dat');
  177.   {$I-} reset(vdata); {$I+}
  178.   if ioresult<>0 then print('No voting data found.') else
  179.   repeat
  180.     done:=false;
  181.     ij:='Q?';
  182.     abort:=false;
  183.     if lq then begin
  184.       cls; printacr('Current Questions:',abort,next); nl;
  185.     end;
  186.     int2:=0;
  187.     for int:=1 to 9 do begin
  188.       seek(vdata,int-1); read(vdata,vd);
  189.       if vd.numa<>0 then begin
  190.         int2:=int2+1;
  191.         if lq and not abort then begin
  192.           if thisuser.vote[int]=0 then i1:='* ' else i1:='  ';
  193.           i1:=i1+cstr(int)+': '+vd.question;
  194.           printacr(i1,abort,next);
  195.         end;
  196.         ij:=ij+cstr(int);
  197.       end;
  198.     end;
  199.     lq:=false;
  200.     if int2=0 then begin done:=true; print('No voting questions now.') end
  201.     else begin
  202.       nl; nl; prompt('Which question (#,Q,?) : '); onek(i[1],ij); i[0]:=#1;
  203.       int:=value(i); if i='Q' then done:=true; if i='?' then lq:=true;
  204.       if (int>0) and (int<10) then vote1(int);
  205.     end;
  206.   until done or hangup;
  207.   close(vdata);
  208. end;
  209.  
  210. overlay procedure logon;
  211. var fil:file of str; lo:array[1..8] of str; num:integer; i:str; ul:charfil; c:char;
  212.     abort:boolean;
  213. begin
  214.   realsl:=thisuser.sl; cls;nl;nl;
  215.   assign(fil,'gfiles\laston.fil');
  216.   reset(fil); for num:=1 to 8 do read(fil,lo[num]); close(fil);
  217.   print('Last few callers:');nl;
  218.   if cosysop in seclev[thisuser.sl].anst then for num:=1 to 8 do print(lo[num]) else
  219.     for num:=5 to 8 do print(lo[num]);
  220.   if realsl<>255 then begin
  221.     rewrite(fil); for num:=2 to 8 do write(fil,lo[num]);
  222.     i:=cstr(systat.callernum)+': '+nam;
  223.     write(fil,i); close(fil);
  224.   end;
  225.   print('You are caller #'+cstr(systat.callernum));
  226.   if thisuser.laston=date then thisuser.ontoday:=thisuser.ontoday+1
  227.     else thisuser.ontoday:=1;
  228.   if systat.lastdate<>date then begin
  229.     systat.lastdate:=date;
  230.     assign(ul,'gfiles\ysysop.log'); {$I-} erase(ul); {$I+} num:=ioresult; assign(ul,'gfiles\sysop.log');
  231.     rename(ul,'gfiles\ysysop.log');append(ul); writeln(ul,'Total Time On = '+
  232.       cstr(systat.activetoday)); writeln(ul,'Calls Today: '+cstr(systat.
  233.       callstoday)); writeln(ul,'Messages posted today: '+cstr(systat.
  234.       msgposttoday)); close(ul); rewrite(sysopf); writeln(sysopf); close(sysopf);
  235.     assign(ul,'gfiles\user.log'); rewrite(ul); writeln(ul); close(ul);
  236.     with systat do begin
  237.       activetoday:=0; callstoday:=0; msgposttoday:=0; emailtoday:=0;
  238.       fbacktoday:=0; uptoday:=0;
  239.     end;
  240.     enddayf:=true;
  241.   end;
  242.   if (realsl<>255) or incom then begin
  243.     append(sysopf);
  244.     writeln(sysopf,'');
  245.     writeln(sysopf,(cstr(systat.callernum)+': '+nam+' '+time+' '+date+'  '+spd+
  246.       '  - '+cstr(thisuser.ontoday))); close(sysopf);
  247.     if realsl<>255 then begin
  248.       assign(ul,'gfiles\user.log'); append(ul);
  249.       writeln(ul,cstr(systat.callernum)+': '+nam+'   '+spd+' - '+cstr(thisuser.ontoday)); close(ul);
  250.       systat.callernum:=systat.callernum+1; systat.callstoday:=systat.callstoday+1;
  251.     end;
  252.   end;
  253.   nl;nl; board:=1; expert:=false;
  254.   if thisuser.loggedon<2 then expert:=false else expert:=true;
  255.   mread:=0; extratime:=0; timeon:=timer; extramsgs:=0;
  256.   topscr; dump;
  257.   if incom then begin
  258.     printfile1('gfiles\logon.msg',abort);
  259.     if not abort then begin prompt('(-*-)'); getkey(c); end;
  260.   end;
  261.   readamsg;
  262.   reset(systatf); write(systatf,systat); close(systatf);
  263.   nl;nl;print('Name: '+nam);
  264.   print('Time allowed on: '+cstr(seclev[thisuser.sl].ttime));
  265.   if thisuser.waiting<>0 then print('Mail waiting   : '+cstr(thisuser.waiting));
  266.   if thisuser.illegal<>0 then print(chr(7)+'Illegal logons : '+cstr(thisuser.illegal));
  267.   if thisuser.laston<>date then print('Last on        : '+thisuser.laston)
  268.     else print('Times on today : '+cstr(thisuser.ontoday));
  269.   abort:=false;
  270.   for num:=1 to 9 do
  271.     if vqu[num] and (thisuser.vote[num]=0) then abort:=true;
  272.   if abort then print('You haven''t voted yet.');
  273.   nl;nl;mcursor;useron:=true; topscr;
  274.   if smw in thisuser.option then rsm;
  275.   thisuser.option:=thisuser.option-[smw];
  276.   if alert in thisuser.option then chatcall:=true;
  277.   if thisuser.waiting<>0 then begin
  278.     nl;nl;prompt('Read your mail now? ');
  279.     if yn then begin nl; readmail; end;
  280.     nl;nl;
  281.   end;
  282. end;
  283.  
  284. overlay procedure reqchat;
  285. begin
  286.   helpl:='C';
  287.   nl;nl; if (not sysop) or (rchat in thisuser.ac)
  288.   then begin
  289.     print('Sysop not available.');
  290.     print('Use Feedback instead.');
  291.     imail(1);
  292.   end else begin
  293.     if not chatcall then begin
  294.       prompt('Reason: '); inputl(i,70);
  295.       if i<>'' then begin
  296.         sysoplog('Chat: '+i);
  297.         print('Chat call now on.');
  298.         sound(440); delay(500); nosound;
  299.         chatr:=i; chatcall:=true;
  300.       end else chatr:='';
  301.     end else
  302.       begin chatcall:=false; print('Chat call turned off.'); chatr:='';end;
  303.   end;
  304.   nl;nl; topscr;
  305. end;
  306.  
  307. overlay procedure abbs;
  308. var filvar:charfil; i,i1:str; c:char; tf:text; there:boolean;
  309. begin
  310.   if not(ramsg in thisuser.ac) and (thisuser.sl>10) then begin
  311.     nl;prompt('Do you want to add to the bbs list? '); helpl:='A';
  312.     if yn then begin
  313.       repeat
  314.         print('Enter the phone number in the form:');
  315.         print(' ###-###-####');
  316.         prompt(':'); input(i1,12);
  317.       until (length(i1)=12) or (i1='') or hangup;
  318.       assign(tf,'gfiles\bbslist.msg'); there:=false;
  319.       {$I-} reset(tf); {$I+} if ioresult=0 then while not eof(tf) do begin
  320.         readln(tf,i); if copy(i,1,12)=i1 then there:=true;
  321.       end;
  322.       close(tf);
  323.       if there then begin nl;nl; print('It''s already in there.');
  324.         i1:=''; end;
  325.       i:=i1; if i<>'' then begin
  326.         print('Enter the name of the BBS:');
  327.         prompt(':'); inputl(i1,64);
  328.         i:=i+'  '+i1;
  329.         if i1<>'' then begin
  330.           nl;print(i); nl;prompt('Is this correct? ');
  331.           if yn then begin
  332.             assign(filvar,'gfiles\bbslist.msg'); {$I-} append(filvar); {$I+}
  333.             if ioresult<>0 then
  334.               rewrite(filvar);
  335.             writeln(filvar,i);
  336.             close(filvar);
  337.             sysoplog('Added "'+i+'"');
  338.           end;
  339.         end;
  340.       end;
  341.     end;
  342.   end;
  343. end;
  344.  
  345. overlay procedure yourinfo;
  346. begin
  347.   cls;
  348.   print('Your name      : '+nam);
  349.   print('Phone number   : '+thisuser.ph);
  350.   print('Mail waiting   : '+cstr(thisuser.waiting));
  351.   print('Sec Lev        : '+cstr(thisuser.sl));
  352.   print('Last on        : '+thisuser.laston);
  353.   print('Times on       : '+cstr(1+thisuser.loggedon));
  354.   print('On today       : '+cstr(thisuser.ontoday));
  355.   print('Messages posted: '+cstr(thisuser.msgpost));
  356.   print('E-mail sent    : '+cstr(thisuser.emailsent+thisuser.feedback));
  357.   prompt('Messages       : '); if rvalidate in thisuser.ac then
  358.     print('Unvalidated') else print('Validated');
  359.   prompt('Backspacing    : '); if rbackspace in thisuser.ac then
  360.     print('Off') else print('On');
  361. end;
  362.  
  363. overlay procedure prg(x:boolean);
  364. var q:boolean;
  365.  
  366. procedure purge(var quit:boolean);
  367. var pl,cn:integer; c:char; mr:messagerec; a,b:boolean;
  368. begin
  369.   quit:=false;
  370.   print('== Purge '+boards[board].name+' ==');
  371.   iscan(pl);
  372.   cn:=1;
  373.   while (cn<=pl) and (not quit) and (not hangup) do begin
  374.     seek(mf,cn); read(mf,mr);
  375.     if mr.owner<>usernum then cn:=cn+1 else begin
  376.       readm(cn,a,b,pl); nl;
  377.       prompt('D:elete, I:gnore, Q:uit :'); onek(c,'DIQ');
  378.       case c of
  379.         'D':begin deletem(pl,cn);
  380.               sysoplog('-'+mr.title+' purged off '+boards[board].name);
  381.             end;
  382.         'Q':begin quit:=true; cn:=pl+1; end;
  383.         'I':cn:=cn+1;
  384.       end;
  385.     end;
  386.   end;
  387.   close(mf);
  388.   print('== '+boards[board].name+' Purge Done ==');
  389. end;
  390.  
  391. procedure gpurge;
  392. var quit:boolean;
  393. begin
  394.   print('=== GLOBAL PURGE ===');
  395.   board:=1; repeat
  396.     if (thisuser.sl>=boards[board].sl) and
  397.       ((boards[board].ar='@') or (boards[board].ar in thisuser.ar)) then
  398.         purge(quit);
  399.     board:=board+1;
  400.   until (board>numboards) or hangup or quit;
  401.   board:=1;
  402.   print('=== GLOBAL PURGE DONE ===');
  403. end;
  404.  
  405. begin
  406.   helpl:='J';
  407.   if x then gpurge else purge(q);
  408. end;
  409.  
  410. overlay procedure wamsg;
  411. var filvar:text; i,n:str; ii:integer; li:array[1..3] of str;
  412. begin
  413.  readamsg; helpl:='W';
  414.  if not (ramsg in thisuser.ac) and (thisuser.sl>10) then begin
  415.   prompt('Change auto-message? ');
  416.   if yn then begin
  417.     nl;print('Enter three lines:'); nl;
  418.     for ii:=1 to 3 do begin
  419.       prompt(cstr(ii)+':'); inputl(li[ii],37);
  420.     end;
  421.     n:=nam; if pana in seclev[thisuser.sl].anst then begin
  422.       nl;prompt('Anonymous? ');
  423.       if yn then n:='@'+n;
  424.     end;
  425.     prompt('Is this alright? ');
  426.     if yn then begin
  427.       assign(filvar,'gfiles\auto.msg');
  428.       rewrite(filvar); writeln(filvar,n);
  429.       for ii:=1 to 3 do writeln(filvar,li[ii]);
  430.       close(filvar); print('Auto-message saved.');
  431.       if (realsl<>255) or incom then begin
  432.         append(sysopf); writeln(sysopf,'   Changed Auto-message');
  433.         for ii:=1 to 3 do writeln(sysopf,'      '+li[ii]); close(sysopf);
  434.       end;
  435.     end else prompt('Nothing saved.');
  436.   end;
  437.  end;
  438. end;
  439.  
  440. overlay procedure removem;
  441. var b:messagerec; pl,t:integer; i:str;
  442. begin
  443.   print('You have the following messages posted:');
  444.   iscan(pl); helpl:='R';
  445.   for t:=1 to pl do begin
  446.     seek(mf,t); read(mf,b);
  447.     if b.owner=usernum then
  448.       print(cstr(t)+': '+b.title);
  449.   end; prompt('Message to remove? ');
  450.   input(i,3); t:=value(i);
  451.   if t<>0 then
  452.     if (t<1) or (t>pl) then
  453.         print('Illegal number') else begin
  454.         seek(mf,t); read(mf,b); if (b.owner<>usernum) and
  455.         not lcs then
  456.           print('You didn''t write it.') else begin
  457.             print(cstr(t)+': '+b.title); prompt('Remove it? ');
  458.             if yn then begin
  459.               deletem(pl,t); print('Removed.');
  460.               sysoplog('-'+b.title+' deleted off of '+boards[board].name);
  461.             end;
  462.           end;
  463.         end;
  464.   close(mf);
  465. end;
  466.  
  467. overlay procedure boardlist;
  468. var b:integer; i:str; abort,next:boolean;
  469. begin
  470.   nl;nl; print('Boards available to you:'); print('');
  471.   b:=1; abort:=false;
  472.   while (b<=numboards) and (not abort) do begin
  473.     if boardac(b) then begin
  474.        if boards[b].key=' ' then i:=cstr(b)
  475.        else i:=boards[b].key;
  476.        if length(i)=1 then i:=' '+i;
  477.        i:=i+' : '+boards[b].name;
  478.        printacr(i,abort,next);
  479.     end;
  480.     b:=b+1;
  481.   end;
  482.   nl;nl;
  483. end;
  484.  
  485. overlay procedure newuser;
  486. var c:char; tries,i,ii,t:integer; s,s1,s2:str; tf:boolean; fi:text; pasw:str;
  487. begin
  488.  sl1('*** NEW USER *** '+time+' '+date);
  489. if systat.users>=maxusers then begin
  490.   print('Sorry, there are the maximum number');
  491.   print('of users already.');
  492.   hangup:=true;
  493. end else begin
  494.  if incom then begin
  495.    nl;nl;printfile('gfiles\system.msg');
  496.    nl;nl;printfile('gfiles\newuser.msg');
  497.    tries:=0; pasw:='';
  498.    while (systat.boardpw<>pasw) and (not hangup) do begin
  499.      prompt('Newuser password :'); input(pasw,38); tries:=tries+1;
  500.      if (pasw='OFF') or (pasw='BYE') then tries:=4;
  501.      if tries>=4 then hangup:=true;
  502.    end;
  503.  end;
  504.  repeat
  505.   t:=0;
  506.   repeat
  507.     print('Enter your full name, or your alias.');
  508.     prompt(':'); input(thisuser.name,25); tf:=false;
  509.     if (thisuser.name='BYE') or (thisuser.name='OFF') then hangup:=true; nl;
  510.     if (thisuser.name[1]<'A') or (thisuser.name='') then tf:=true;
  511.     for i:=1 to systat.users do if srl[i].name=thisuser.name then tf:=true;
  512.     assign(fi,'gfiles\trashcan.txt');{$I-} reset(fi); {$I+}
  513.     if ioresult=0 then begin
  514.       s2:=' '+thisuser.name+' ';
  515.       while not eof(fi) do begin
  516.         readln(fi,s1); if s1[length(s1)]=#1 then s1[length(s1)]:=' ' else s1:=s1+' ';
  517.         s1:=' '+s1; for i:=1 to length(s1) do s1[i]:=upcase(s1[i]);
  518.         if pos(s1,s2)<>0 then tf:=true;
  519.       end;
  520.       close(fi);
  521.     end;
  522.     if tf then begin print(chr(7)+'Sorry, can''t use that name.'); t:=t+1; end;
  523.     if t>=3 then hangup:=true;
  524.   until (tf=false) or hangup;
  525.   print('Enter your VOICE phone number in the');
  526.   print('form:');
  527.   print(' ###-###-####.'); prompt(':');
  528.   input(thisuser.ph,12);
  529.   nl; print('Enter your REAL first name.');
  530.   prompt (':');
  531.   inputl(thisuser.realname,14);
  532.   nl; print('Which computer type do you have?');
  533.   for i:=1 to 8 do
  534.     print(cstr(i)+'. '+comptyp[i]);
  535.   nl; prompt('Which? ');
  536.   onek(c,'12345678');
  537.   thisuser.comptype:=value(c); nl; nl;
  538.   print('['+thisuser.name+'] ['+thisuser.realname+']');
  539.   print('['+thisuser.ph+'] ['+comptyp[thisuser.comptype]+']');
  540.   c:='Y'; if (length(thisuser.ph)<>12) or (thisuser.ph[4]<>'-') or
  541.     (thisuser.ph[8]<>'-') then begin print('Enter the phone number right!'); c:='N'; end;
  542.   if thisuser.realname='' then c:='N';
  543.   nl; if c='Y' then begin dump; prompt('Is this correct? ');
  544.   if yn then c:='Y' else c:='N'; end else
  545.     print('Please use proper format.');
  546.  until (c='Y') or hangup;
  547.  if not hangup then begin
  548.  with thisuser do begin
  549.   deleted:=false; waiting:=0; laston:='Never.';loggedon:=0; msgpost:=0;
  550.   emailsent:=0; feedback:=0; linelen:=80; pagelen:=25;
  551.   defaults:=[onekey,wordwrap]; ontoday:=0; illegal:=0; cursor:='/>\<';
  552.   option:=[];dsl:=0; downloads:=0; uploads:=0; uk:=0; dk:=0;
  553.   if incom then sl:=10 else sl:=30;
  554.   ac:=[rvalidate]; ar:=[]; for i:=1 to 9 do vote[i]:=0; qscan[1].ext:=1;
  555.   qscan[1].ltr:='A'; qscan[1].number:=-32767;
  556.   for i:=2 to 19 do qscan[i]:=qscan[1];
  557.   for i:=1 to 19 do qscn[i]:=true;
  558.  end;
  559.  thisuser.macro[1]:='THIS IS THE CTRL-D MACRO';
  560.  thisuser.macro[2]:='THIS IS THE CTRL-F MACRO';
  561.  thisuser.sbn:=0;
  562.  randomize;
  563.  thisuser.pw:='';
  564.  for i:=1 to 6 do begin
  565.    ii:=random(36);
  566.    if ii<10 then c:=chr(ord('0')+ii)
  567.      else c:=chr(ord('A')+ii-10);
  568.    thisuser.pw:=thisuser.pw+c;
  569.  end;
  570.  reset(uf);
  571.  ii:=0; for i:=1 to filesize(uf)-1 do begin
  572.    seek(uf,i);
  573.    read(uf,user);
  574.    if user.deleted and (ii=0) then ii:=i;
  575.  end;
  576.  if ii=0 then usernum:=filesize(uf) else usernum:=ii;
  577.  seek(uf,usernum);
  578.  write(uf,thisuser);
  579.  close(uf);
  580.  isr(thisuser.name,usernum); nl; nl;
  581.  repeat
  582.    print('Your user number is '+cstr(usernum));
  583.    print('Your password is "'+thisuser.pw+'".');
  584.    print('Please write them down and re-type');
  585.    print('your password for verification.');
  586.    prompt('Password: '); input(s,8);
  587.  until (s=thisuser.pw) or hangup;
  588.  nl; nl;
  589.  if incom then begin
  590.    topscr;
  591.    print('You will now send a letter to the sysop');
  592.    print('asking for validation.  If you do not');
  593.    print('complete it, you will not be validated.');
  594.    irt:='New User Application';
  595.    nl; email(1);
  596.  end;
  597. end;
  598. end;
  599. end;
  600.  
  601. overlay procedure delmail;
  602. var tu,d,i,x:integer; mr:mailrec; f:file; u:userrec; c:char; abort,next,done:boolean;
  603. begin
  604.   helpl:='K';
  605.   prompt('Kill old E-mail? '); if yn then begin
  606.   nl;nl;d:=daynum(date); reset(uf); reset(mailfile);i:=0; done:=false;
  607.   while (i<filesize(mailfile)) and (not hangup) and (not done) do begin
  608.     seek(mailfile,i); read(mailfile,mr);
  609.     if (abs(mr.from)=usernum) and (mr.destin<>-1) then repeat
  610.       tu:=mr.destin; seek(uf,tu); read(uf,u);
  611.       nl;print('To   : '+u.name+' #'+cstr(tu));
  612.       print('Title: '+mr.title);
  613.       print('Sent : '+cstr(d-mr.date)+' days ago');
  614.       nl; prompt('R:ead, D:elete, N:ext, Q:uit : ');
  615.       onek(c,'QNDR');
  616.       case c of
  617.         'Q':done:=true;
  618.         'D':begin
  619.               close(uf); sysoplog('Deleted mail to '+rmail(i)); reset(uf);
  620.               if tu=usernum then thisuser.waiting:=thisuser.waiting-1;
  621.               print('Mail deleted.');
  622.             end;
  623.         'R':begin nl; nl; readmsg(mr.msg,abort,next);end;
  624.       end;
  625.     until hangup or (c<>'R');
  626.     i:=i+1;
  627.   end;
  628.   close(uf); close(mailfile); topscr;
  629.  end;
  630. end;
  631.  
  632. overlay procedure gfiles;
  633. var b:gft; f:file of gft; i:str; t,c:integer; deep,exit:boolean;
  634.     gftit:array[1..150] of record tit:string[80]; arn:integer; gfile:boolean;end;
  635.     lgftn,lgftnt,numgft:integer; titl:str;
  636.  
  637.   procedure gettit(n:integer);
  638.   var r:integer; b:gft;
  639.   begin
  640.     numgft:=0;
  641.     if n>0 then begin
  642.       seek(f,n); read(f,b); titl:='[ '+b.title+' ]';
  643.     end else titl:='[ Main Section ]';
  644.     r:=n+1;
  645.     if r<=t then begin
  646.       seek(f,r); read(f,b);
  647.       while (r<=t) and (b.filen[1]<>#1) do begin
  648.         if b.num<=thisuser.sl then begin
  649.           numgft:=numgft+1;
  650.           gftit[numgft].tit:=b.title;
  651.           gftit[numgft].arn:=r;
  652.           gftit[numgft].gfile:=true;
  653.         end;
  654.         r:=r+1;
  655.         if (r<=t) then begin seek(f,r); read(f,b); end;
  656.       end;
  657.     end;
  658.     if n=0 then
  659.       while (r<=t) do begin
  660.         seek(f,r); read(f,b);
  661.         if (b.filen[1]=#1) and (b.num<=thisuser.sl) then begin
  662.           numgft:=numgft+1;
  663.           gftit[numgft].tit:='[ '+b.title+' ]';
  664.           gftit[numgft].arn:=r;
  665.           gftit[numgft].gfile:=false;
  666.         end;
  667.         r:=r+1;
  668.       end;
  669.   end;
  670.  
  671.   procedure lgft;
  672.   var abort,next:boolean; c:integer;
  673.   begin
  674.     nl; print(titl); nl;
  675.     if numgft=0 then print('No G-files.') else begin
  676.       abort:=false; next:=false; c:=1;
  677.       while (c<=numgft) and (not abort) do begin
  678.         printacr(cstr(c)+': '+gftit[c].tit,abort,next);
  679.         c:=c+1;
  680.       end;
  681.     end;
  682.   end;
  683.  
  684. begin
  685.   nl;assign(f,'gfiles\gfiles.dat'); {$I-} reset(f); {$I+}
  686.   if ioresult<>0 then begin
  687.     rewrite(f); b.num:=0; write(f,b);
  688.   end;
  689.   seek(f,0); read(f,b); t:=b.num; helpl:='G';
  690.   if t=0 then print('No G-files yet.') else begin
  691.     gettit(0); exit:=false;
  692.     lgft; lgftn:=0; deep:=false; lgftnt:=0;
  693.     repeat
  694.       nl; nl; prompt('Gfiles: (1-'+cstr(numgft)+', ^'+cstr(lgftn)+'),?,Q : ');
  695.       input(i,3);
  696.       if i='' then if lgftn=numgft then i:='Q' else i:=cstr(lgftn+1);
  697.       if i='?' then lgft;
  698.       if i='Q' then
  699.         if deep then begin
  700.           deep:=false;
  701.           gettit(0);
  702.           lgft;
  703.           lgftn:=lgftnt;
  704.         end else exit:=true;
  705.       c:=value(i);
  706.       if (c>0) and (c<=numgft) then begin
  707.         if gftit[c].gfile=true then begin
  708.           seek(f,gftit[c].arn);
  709.           read(f,b);
  710.           printfile('gfiles\'+b.filen);
  711.           lgftn:=c;
  712.         end else begin
  713.           gettit(gftit[c].arn);
  714.           lgftn:=c;
  715.           if numgft>0 then begin
  716.             lgft;
  717.             lgftnt:=c; lgftn:=0;
  718.             deep:=true;
  719.           end else begin
  720.             gettit(0);
  721.             nl; print('No G-files there.');
  722.           end;
  723.         end;
  724.       end;
  725.     until exit or hangup;
  726.   end;
  727.   close(f);
  728.   nl;nl;
  729. end;
  730.  
  731. overlay procedure chpw;
  732. var i:str;
  733. begin
  734.   cls; print('Your current password is "'+thisuser.pw+'"');
  735.   print('If you change it, it must be between');
  736.   print('three and eight characters. Do you want');
  737.   helpl:='Z';
  738.   prompt('To change it? ');
  739.   if yn then begin
  740.    repeat
  741.     print('Enter new password:'); print(' (-!----)'); prompt(':');
  742.     input(i,8);
  743.    until (length(i)>2) or hangup;
  744.    print('New password="'+i+'"');
  745.    if not hangup then thisuser.pw:=i;
  746.    sysoplog('Changed password.');
  747.   end;
  748.   topscr;
  749. end;
  750.  
  751. overlay procedure mmacro;
  752. var i:str; c,mc:char; mcn,n,n1,mn:integer; done:boolean;
  753. begin
  754.   done:=false; helpl:='H';
  755.   repeat
  756.     nl; prompt('Macros: M,L,Q,? :'); onek(c,'MLQ?');
  757.     case c of
  758.       '?':begin
  759.             print('M:ake macro    L:ist macros');
  760.             print('Q:uit          ?:this');
  761.           end;
  762.       'Q':done:=true;
  763.       'L':begin
  764.             nl; print('Current Macros:');
  765.             for n:=1 to 2 do begin nl;
  766.               if n=1 then print('Ctrl-D:') else print('Ctrl-F:');
  767.               prompt('"');
  768.               for n1:=1 to length(thisuser.macro[n]) do
  769.                 if thisuser.macro[n][n1]>=' ' then
  770.                   prompt(thisuser.macro[n][n1])
  771.                 else
  772.                   prompt('^'+chr(64+ord(thisuser.macro[n][n1])));
  773.               print('"');
  774.             end;
  775.           end;
  776.       'M':begin
  777.             nl; prompt('Which (D,F,Q=Quit) :'); onek(c,'DFQ');
  778.             if c<>'Q' then begin
  779.               nl;nl; mc:=c; print('Enter your macro now, Ctrl-'+mc);
  780.               print('to end macro.'); nl;if mc='D' then mcn:=4 else mcn:=6;
  781.               n:=1; i:=''; macok:=false; if mc='D' then mn:=1 else mn:=2;
  782.               helpl:=#0;
  783.               repeat
  784.                 getkey(c);
  785.                 if ord(c)>127 then c:=chr(0);
  786.                 if (ord(c)<32) then
  787.                   if not((c=#8) or (c=#10) or (c=#13) or (c=#14) or (c=#9) or
  788.                          (c=#24) or (c=chr(mcn))) then c:=chr(0);
  789.                   if c=#8 then if n<2 then c:=#0 else begin
  790.                     bs; oc(#8); n:=n-1; c:=#0;
  791.                   end;
  792.                 if (c<>#0) and (c<>chr(mcn)) then begin
  793.                   if (c=#21) or (c=#14) or (c=#9) or (c=#24) then prompt('^'+chr(ord(c)+64))
  794.                   else oc(c);
  795.                   i[n]:=c; n:=n+1;
  796.                   if c=#13 then oc(chr(10));
  797.                 end;
  798.               until (c=chr(mcn)) or (n=80) or hangup;
  799.               nl; helpl:='H';
  800.               if n=80 then begin
  801.                 print('Macro limit is 79 chars.');
  802.                 print('That much saved.');
  803.               end;
  804.               i[0]:=chr(n-1);
  805.               print('Ctrl-'+mc+' macro is now:'); prompt('"');
  806.               for n1:=1 to length(i) do
  807.                 if i[n1]>=' ' then
  808.                   prompt(i[n1])
  809.                 else
  810.                   prompt('^'+chr(64+ord(i[n1])));
  811.               print('"'); dump;
  812.               prompt('Is this what you want? ');
  813.               if yn then begin thisuser.macro[mn]:=i; print('Macro saved.') end
  814.               else print('Macro not saved, then.');
  815.               macok:=true;
  816.             end;
  817.           end;
  818.     end;
  819.   until done or hangup;
  820. end;
  821.  
  822. overlay procedure default;
  823. var c:char; i:str; i1,ii:integer;
  824. begin
  825.  c:='?';
  826.  repeat
  827.  if c='?' then begin
  828.   print(chr(12)+'Your defaults:');nl;
  829.   print('1. Screen size    : '+cstr(thisuser.linelen)+'X'+cstr(thisuser.pagelen));
  830.   prompt('2. Cursor         : ');
  831.     if spcsr in thisuser.defaults then print(thisuser.cursor) else
  832.       print('Standard');
  833.   prompt('3. Input          : ');
  834.     if onekey in thisuser.defaults then print('One key') else print('Line');
  835.   prompt('4. Wordwrap       : ');
  836.     if wordwrap in thisuser.defaults then print('On') else print('Off');
  837.   prompt('5. Pause on screen: '); if pause in thisuser.defaults then
  838.     print('On') else print('Off');
  839.   prompt('6. Mailbox        : '); if nomail in thisuser.option then begin
  840.     print('Closed'); print('   You can not receive mail'); end else print('Open');
  841.   print('7. Configured Q-scan');
  842.  end;
  843.   nl;nl; helpl:='D'; prompt('Enter number to change, Q or ? :');
  844.   onek(c,'Q1234567?');nl;
  845.   case c of
  846.     '1':begin
  847.           nl;nl;prompt('Number of characters per line? ');
  848.           input(i,2); if i<>'' then thisuser.linelen:=value(i);
  849.           if thisuser.linelen>80 then thisuser.linelen:=80;
  850.           if thisuser.linelen<32 then thisuser.linelen:=32;
  851.           prompt('Number of lines per page? ');
  852.           input(i,2); if i<>'' then thisuser.pagelen:=value(i);
  853.           if thisuser.pagelen>25 then thisuser.pagelen:=25;
  854.           if thisuser.pagelen<4 then thisuser.pagelen:=4;
  855.         end;
  856.     '2':begin
  857.           nl;nl; prompt('Do you want a spinning cursor? ');
  858.           if yn then thisuser.defaults:=thisuser.defaults+[spcsr]
  859.           else thisuser.defaults:=thisuser.defaults-[spcsr];
  860.           if spcsr in thisuser.defaults then begin
  861.             print('Current Cursor: '+thisuser.cursor);
  862.             print('Enter new cursor, or <CR> to leave it.');
  863.             print(' (--------)');
  864.             prompt(':'); inputl(i,10); if i<>'' then thisuser.cursor:=i;
  865.             mcursor;
  866.           end;
  867.         end;
  868.     '3':begin
  869.           if not (onekey in thisuser.defaults) then begin
  870.             thisuser.defaults:=thisuser.defaults+[onekey]; print('Turned on.'); end
  871.           else begin
  872.             thisuser.defaults:=thisuser.defaults-[onekey]; print('Turned off.'); end
  873.         end;
  874.     '4':begin
  875.           if not (wordwrap in thisuser.defaults) then begin
  876.             thisuser.defaults:=thisuser.defaults+[wordwrap]; print('Turned on.'); end
  877.           else begin
  878.             thisuser.defaults:=thisuser.defaults-[wordwrap]; print('Turned off.'); end;
  879.         end;
  880.     '5':if pause in thisuser.defaults then
  881.            begin thisuser.defaults:=thisuser.defaults-[pause];
  882.            print('Turned off.'); end else
  883.            begin thisuser.defaults:=thisuser.defaults+[pause];
  884.            print('Turned on.'); end;
  885.     '6':if nomail in thisuser.option then begin
  886.            thisuser.option:=thisuser.option-[nomail];
  887.            print('Mailbox now open.'); print('You can receive mail now.');
  888.          end else begin
  889.            thisuser.option:=thisuser.option+[nomail];
  890.            print('Mailbox now closed.'); print('You >CAN NOT< recieve mail now.');
  891.          end;
  892.     '7':repeat
  893.           helpl:='I';
  894.           nl;nl;print('boards to Q-scan marked with ''*''');
  895.           nl; for ii:=1 to numboards do if boardac(ii) then begin
  896.             if thisuser.qscn[ii] then prompt('*  ') else prompt('   ');
  897.             if boards[ii].key=' ' then i:=cstr(ii) else i:=boards[ii].key;
  898.             if length(i)=1 then i:=' '+i;
  899.             i:=i+' : '+boards[ii].name;print(i);
  900.           end;
  901.           repeat
  902.            prompt('Enter board #, Q, or ? :'); input(i,2);
  903.            ii:=value(i);
  904.            if (ii>0) and (ii<=numboards) then
  905.              if (boards[ii].key=' ') and boardac(ii) then thisuser.qscn[ii]:=
  906.                not thisuser.qscn[ii]
  907.              else
  908.            else begin
  909.              i1:=0;
  910.              for ii:=1 to numboards do if boards[ii].key=i then i1:=ii;
  911.              if (i1<>0) and (i<>' ') then if boardac(ii) then
  912.                thisuser.qscn[ii]:=not thisuser.qscn[ii];
  913.            end;
  914.           until (i='Q') or (i='?') or hangup;
  915.         until (i='Q') or hangup;
  916.   end;
  917.  until hangup or (c='Q');
  918.  topscr;
  919. end;
  920.  
  921. overlay procedure logoff;
  922. var s,d:integer; mr:mailrec; x:smr;
  923. begin
  924.   term_ready(false);
  925.   thisuser.laston:=systat.lastdate;
  926.   thisuser.loggedon:=thisuser.loggedon+1;
  927.   thisuser.sl:=realsl;
  928.   thisuser.illegal:=0;
  929.   reset(uf); seek(uf,usernum); write(uf,thisuser); close(uf);
  930.   systat.activetoday:=systat.activetoday+trunc((timer-timeon+30)/60);
  931.   systat.fbacktoday:=systat.fbacktoday+ftoday;
  932.   systat.emailtoday:=systat.emailtoday+etoday;
  933.   reset(systatf); write(systatf,systat); close(systatf);
  934.   window(1,1,80,25);clrscr;
  935.   if hungup then sysoplog('*** HUNG UP ***');
  936.   sysoplog('Read: '+cstr(mread)+'   Time on: '+cstr(trunc((timer-timeon+30)/60)));
  937.   {$I-}  reset(mailfile) {$I+}; if ioresult=0 then
  938.    if filesize(mailfile)>1 then begin
  939.     s:=0; d:=0;
  940.     while s<filesize(mailfile) do begin
  941.       seek(mailfile,s); read(mailfile,mr);
  942.       if (mr.destin<>-1) then
  943.         if s=d then d:=d+1 else begin
  944.           seek(mailfile,d); write(mailfile,mr); d:=d+1;
  945.         end;
  946.       s:=s+1;
  947.     end;
  948.     mr.destin:=-1; mr.from:=-1;
  949.     for s:=d to filesize(mailfile)-1 do begin
  950.       seek(mailfile,s); write(mailfile,mr);
  951.     end;
  952.   end;
  953.   close(mailfile);
  954.   {$I-}  reset(smf) {$I+}; if ioresult=0 then
  955.    if filesize(smf)>1 then begin
  956.     s:=0; d:=0;
  957.     while s<filesize(smf) do begin
  958.       seek(smf,s); read(smf,x);
  959.       if x.destin<>-1 then
  960.         if s=d then d:=d+1 else begin
  961.           seek(smf,d); write(smf,x); d:=d+1;
  962.         end;
  963.       s:=s+1;
  964.     end;
  965.     x.destin:=-1;
  966.     for s:=d to filesize(smf)-1 do begin
  967.       seek(smf,s); write(smf,x);
  968.     end;
  969.   end;
  970.   close(smf);
  971. end;
  972.  
  973. overlay procedure endday;
  974. var cn,pl,d,i,tu,fu:integer; mr:mailrec; f:file; u:userrec; b:messagerec; is:str;
  975. begin
  976.   d:=daynum(date); reset(mailfile);
  977.   for i:=0 to filesize(mailfile)-1 do begin
  978.     seek(mailfile,i); read(mailfile,mr);
  979.     if (d-mr.date>mr.mage) and (mr.destin<>-1) then begin
  980.       fu:=abs(mr.from);
  981.       is:=rmail(i);
  982.       ssm(fu,is+' never got your letter.');
  983.     end;
  984.   end;
  985.   close(mailfile);
  986.   reset(uf);
  987.   for board:=1 to numboards do begin
  988.     iscan(pl);
  989.     cn:=1;
  990.     while cn<=pl do begin
  991.       seek(mf,cn); read(mf,b);
  992.       if ((d-b.date>b.mage) or (b.messagestat=deleted)) and (b.date>0) then
  993.         deletem(pl,cn)
  994.       else
  995.         cn:=cn+1;
  996.     end;
  997.     close(mf);
  998.   end;
  999.   close(uf);
  1000. end;
  1001.  
  1002. overlay procedure smail(tf:boolean);
  1003. var ix,c1,c2,c3,c4:integer; c:char;
  1004.     mr:mailrec; t,e,cp:integer; f:messages; a:anontyp; i:str; us:userrec;
  1005.     na:array[1..20] of integer; ok:boolean;
  1006. begin
  1007.   if tf=false then begin
  1008.     irt:=''; helpl:='Q';
  1009.     print('Enter user name or number.'); prompt(':');
  1010.     finduser(ix);
  1011.     if ix>0 then
  1012.       imail(ix);
  1013.   end else if not((remail in thisuser.ac) or
  1014.     ((etoday>=seclev[thisuser.sl].emails) and (thisuser.sl<55))) then begin
  1015.     reset(uf); helpl:='E';
  1016.     repeat
  1017.       nl; nl; print('Send mail to more than one user.'); ok:=false;
  1018.       print('Enter user NUMBERS, separated by commas, max 20.');
  1019.       prompt(':'); input(i,78);
  1020.       for c1:=1 to 20 do na[c1]:=0;
  1021.       c1:=1; c2:=1;
  1022.       while i<>'' do begin
  1023.         c3:=pos(',',i);
  1024.         if c3=0 then c3:=length(i)+1;
  1025.         c4:=value(copy(i,1,c3-1));
  1026.         i:=copy(i,c3+1,length(i)-c3);
  1027.         if (c4<1) or (c4>maxusers) or (c4>=filesize(uf)) then c4:=0;
  1028.         if c4<>0 then begin
  1029.           seek(uf,c4); read(uf,us);
  1030.           if us.deleted or ((c4=1) and (us.waiting>50)) or ((c4<>1) and
  1031.             (us.waiting>15)) or ((nomail in us.option) and not cs) or
  1032.             ((c4=usernum) and (realsl<>255)) then
  1033.               c4:=0;
  1034.           if not cs then
  1035.             for c2:=1 to 20 do
  1036.               if na[c2]=c4 then
  1037.                 c4:=0;
  1038.           if (c4<>0) and (c1<=20) then begin
  1039.             na[c1]:=c4;
  1040.             c1:=c1+1;
  1041.           end;
  1042.         end;
  1043.       end;
  1044.       nl; print('Users marked:');
  1045.       c1:=1;
  1046.       while (na[c1]<>0) and (c1<=20) do begin
  1047.         seek(uf,na[c1]); read(uf,us); print('  '+us.name+' #'+cstr(na[c1]));
  1048.         c1:=c1+1;
  1049.       end;
  1050.       if na[1]=0 then print('  None');
  1051.       nl; prompt('Is this correct? ');  ok:=yn;
  1052.     until ok;
  1053.     if na[1]<>0 then begin
  1054.       a:=no; if sanm in seclev[thisuser.sl].anst then a:=yes;
  1055.       inmsg(f,a,i,false,true);
  1056.       if f.ext<>0 then begin
  1057.         {$I-} reset(mailfile); {$I+}
  1058.         if (ioresult<>0) then
  1059.           rewrite(mailfile);
  1060.         e:=filesize(mailfile);
  1061.         if e=0 then cp:=0 else begin
  1062.           cp:=-1; t:=e-1;
  1063.           seek(mailfile,t); read(mailfile,mr);
  1064.           while (t>0) and (mr.destin=-1) do begin
  1065.             t:=t-1; seek(mailfile,t); read(mailfile,mr);
  1066.           end;
  1067.           cp:=t+1;
  1068.         end;
  1069.         seek(mailfile,cp);
  1070.         if (realsl<>255) or incom then begin
  1071.           assign(sysopf,'gfiles\sysop.log'); {$I-} append(sysopf);{$I+}
  1072.           if ioresult<>0 then
  1073.             rewrite(sysopf);
  1074.         end;
  1075.         mr.msg:=f; if lan then mr.from:=-usernum else mr.from:=usernum;
  1076.         mr.title:=i; mr.date:=daynum(date);
  1077.         mr.mage:=maxage(thisuser.sl);
  1078.         c1:=1; nl; print('Sending mail to:');
  1079.         while (na[c1]<>0) and (c1<=20) do begin
  1080.           mr.destin:=na[c1];
  1081.           write(mailfile,mr);
  1082.           if na[c1]=1 then begin
  1083.             thisuser.feedback:=thisuser.feedback+1;
  1084.             ftoday:=ftoday+1;
  1085.             fw:=fw+1;
  1086.           end else begin
  1087.             thisuser.emailsent:=thisuser.emailsent+1;
  1088.             etoday:=etoday+1;
  1089.           end;
  1090.           seek(uf,na[c1]); read(uf,us);
  1091.           us.waiting:=us.waiting+1; seek(uf,na[c1]); write(uf,us);
  1092.           if na[c1]=usernum then thisuser.waiting:=thisuser.waiting+1;
  1093.           i:=us.name+' #'+cstr(na[c1]);
  1094.           if (realsl<>255) or incom then
  1095.             writeln(sysopf,'   Mult-mail sent to '+i);
  1096.           print('  '+i);
  1097.           c1:=c1+1;
  1098.         end;
  1099.         close(sysopf); close(mailfile); topscr;
  1100.       end;
  1101.     end;
  1102.     close(uf);
  1103.   end;
  1104. end;
  1105.  
  1106. overlay procedure ulist;
  1107. var inte:integer; abort,next:boolean;
  1108. begin
  1109.   inte:=0; abort:=false; while (not abort) and (inte<systat.users) do begin
  1110.     inte:=inte+1;
  1111.     printacr(srl[inte].name+' #'+cstr(srl[inte].number),abort,next);
  1112.   end;
  1113. end;
  1114.