home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 153.img / TELES.ZIP / UNIT0.PAS < prev    next >
Pascal/Delphi Source File  |  1988-07-24  |  33KB  |  1,006 lines
  1. {$R-}    {Range checking off}
  2. {$B+}    {Boolean complete evaluation on}
  3. {$S+}    {Stack checking on}
  4. {$I+}    {I/O checking on}
  5. {$N-}    {No numeric coprocessor}
  6. {$V-}
  7.  
  8.  
  9. Unit Unit0;
  10.  
  11. Interface
  12.  
  13. Uses
  14.   Crt,
  15.   Dos,
  16.   Common,
  17.   Qwik;
  18.  
  19. procedure star;
  20. procedure tcenter(i:astr);
  21. procedure ansig(x:integer; y:integer);
  22. procedure ansic(c:integer);
  23. procedure savebase;
  24. procedure updateuser;
  25. procedure beephim;
  26. function mln(i:astr; l:integer):astr;
  27. procedure inu(var i:integer);
  28. procedure ini(var i:byte);
  29. procedure movemsg(var cn:integer);
  30. function mn(i,l:integer):astr;
  31. procedure titles(var cn:integer);
  32. function forwardm(n:integer):integer;
  33. procedure imail(i:integer);
  34. procedure autoreply;
  35. procedure email(touser:integer; xx:boolean);
  36. procedure deletem(ntd:integer);
  37. procedure readm(cn:integer; var next:boolean; var unvali:boolean);
  38. function tnum:integer;
  39. procedure iscan;
  40. procedure inmsg(var mrec:messages;an:anontyp;var title:astr;tr,mp:boolean);
  41. function filename(mrec:messages):astr;
  42. procedure printfile1(fn:astr; var abort:boolean);
  43. procedure wfcmenu;
  44. procedure mmkey(var i:astr);
  45. function greater(mrec:messages):boolean;
  46. function maxage(x:integer):integer;
  47. function boardacpw(nb:integer):boolean;
  48. function boardac(nb:integer):boolean;
  49. procedure isr(uname:astr;usernum:integer);
  50. function ctp(t,b:integer):astr;
  51. procedure inli(var i:astr);
  52. procedure readmsg(mrec:messages;rname:boolean; var next:boolean);
  53.  
  54. Implementation
  55.  
  56. var
  57.   msgval:boolean;
  58.  
  59. procedure star;
  60. begin
  61.   textbackground(0);
  62.   tc(9);write('■ ');tc(11);
  63. end;
  64.  
  65. procedure tcenter(i:astr);
  66. var p,x,y:integer;
  67. begin
  68.   p:=40-(length(i) div 2);
  69.   x:=wherex; y:=wherey;
  70.   x:=p;
  71.   gotoxy(x,y);
  72.   writeln(i);
  73. end;
  74.  
  75. procedure ansig(x:integer; y:integer);
  76. begin
  77.   pr1(#27+'['+cstr(y)+';'+cstr(x)+'H');
  78.   gotoxy(x,y);
  79. end;
  80.  
  81. procedure ansic(c:integer);
  82. begin
  83.   cl(c);
  84. end;
  85.  
  86. procedure savebase;
  87. var f:file;
  88. begin
  89.   if (bread>0) and bchanged then begin
  90.     assign(f,systat.gfilepath+''+boards[bread].filename+'.BRD');
  91.     reset(f,sizeof(messagerec));
  92.     blockwrite(f,mary[0],mary[0].message.number+1);
  93.     truncate(f);
  94.     close(f);
  95.     bchanged:=false;
  96.   end;
  97. end;
  98.  
  99. procedure updateuser;
  100. var s:astr;
  101. begin
  102.   repeat
  103.     nl;
  104.     print('Enter your city & state seperated by a comma');
  105.     prompt(':');
  106.     inputl(thisuser.citystate,26);
  107.   until (pos(',',thisuser.citystate)<>0) or (hangup);
  108.   repeat
  109.     print('Enter your mailing address: <House number> <Street> [APT#]');
  110.     prt(':');mpl(30);inputl(thisuser.street,30);
  111.   until (thisuser.street<>'') or (hangup);
  112.   repeat
  113.     print('Enter your zipcode (9 digit if available)');
  114.     print('  ##### or #####-####');
  115.     prt(':');mpl(10);input(thisuser.zipcode,10);
  116.   until (thisuser.zipcode<>'') or (hangup);
  117.   repeat
  118.     print('Enter your occupation:');
  119.     prt(':');mpl(40);inputl(thisuser.occupation,40);
  120.   until (thisuser.occupation<>'') or (hangup);
  121.   repeat
  122.     print('Where did you hear about this BBS?');
  123.     prt(':');mpl(40);inputl(thisuser.wherebbs,40);
  124.   until (thisuser.wherebbs<>'') or (hangup);
  125. end;
  126.  
  127. procedure beephim;
  128. var rl,rl1:real; ch:char;
  129. begin
  130.   beepend:=false;
  131.   rl:=timer;
  132.   repeat
  133.     sound(900);delay(20);sound(500);delay(20);sound(200);delay(20);nosound;
  134.     rl1:=timer;
  135.     while (abs(rl1-timer)<0.9) and (not keypressed) do;
  136.   until (abs(rl-timer)>30.0) or keypressed;
  137. end;
  138.  
  139. function mln(i:astr; l:integer):astr;
  140. begin
  141.   while length(i)<l do i:=i+' ';
  142.   mln:=i;
  143. end;
  144.  
  145. procedure inu(var i:integer);
  146. var s:astr;
  147. begin
  148.   input(s,5); i:=value(s);
  149. end;
  150.  
  151. procedure ini(var i:byte);
  152. var s:astr;
  153. begin
  154.   input(s,3); i:=value(s);
  155. end;
  156.  
  157. procedure movemsg(var cn:integer);
  158. var mr:messagerec; i:astr; c1,c2,c3,ob:integer; done:boolean;
  159. begin
  160.   nl; nl; if (cn>0) and (cn<=tnum) then begin
  161.     print('Move message'); c1:=0; done:=false;
  162.     repeat
  163.       prt('To which board (1-'+cstr(numboards)+') ?=list, Q=Quit :');
  164.       input(i,3);
  165.       if (i='') or (i='Q') then done:=true;
  166.       if i='?' then begin
  167.         nl;
  168.         for c2:=1 to numboards do begin
  169.           cl(3);prompt(cstr(c2));cl(4);prompt(': ');cl(1);
  170.           print(boards[c2].name);
  171.         end;
  172.         nl;
  173.       end;
  174.       c1:=value(i);
  175.       if (c1>0) and (c1<=numboards) then done:=true;
  176.     until done or hangup;
  177.     if (c1>0) and (c1<=numboards) then begin
  178.       mr:=mary[cn];
  179.       mary[0].message.number:=tnum-1;
  180.       for c2:=cn+1 to tnum+1 do
  181.         mary[c2-1]:=mary[c2];
  182.       bchanged:=true;
  183.       savebase;
  184.       ob:=board;
  185.       board:=c1;
  186.       iscan;
  187.       if tnum>=boards[board].maxmsgs then deletem(1);
  188.       mary[0].message.number:=tnum+1;
  189.       mary[tnum]:=mr;
  190.       bchanged:=true;
  191.       savebase;
  192.       board:=ob;
  193.       iscan;
  194.       if cn>tnum then cn:=tnum;
  195.       print('Moved.');
  196.     end;
  197.   end;
  198. end;
  199.  
  200. function mn(i,l:integer):astr;
  201. begin
  202.   mn:=mln(cstr(i),l);
  203. end;
  204.  
  205. procedure titles(var cn:integer);
  206. var abort,next:boolean; nl:integer; i:astr;
  207. begin
  208.   nl:=0;
  209.   abort:=false;
  210.   while (not hangup) and (not abort) and (nl<10) and (cn<=tnum) do begin
  211.     if mary[cn].owner=usernum then i:='['+cstr(cn)+']' else
  212.      i:='('+cstr(cn)+')';
  213.     while length(i)<8 do i:=' '+i; i:=i+' '+mary[cn].title;
  214.     if greater(mary[cn].message) then i[1]:='*';
  215.     if mary[cn].messagestat<>validated then if lcs
  216.       then begin
  217.         i[1]:='N'; i[2]:='V';
  218.       end else
  219.         i:=copy(i,1,9)+'<<< NOT VALIDATED YET >>>';
  220.     printacr(i,abort,next);
  221.     nl:=nl+1;cn:=cn+1;
  222.   end;
  223.   cn:=cn-1;
  224. end;
  225.  
  226. function forwardm(n:integer):integer;
  227. var chk:array[1..maxusers] of boolean; cur:integer; u:userrec; done:boolean;
  228. begin
  229.   for cur:=1 to maxusers do chk[cur]:=false;
  230.   cur:=n; done:=false;
  231.   while not done do
  232.     if chk[cur] then begin
  233.       done:=true;
  234.       cur:=0;
  235.     end else
  236.       if (cur<filesize(uf)) and (cur>0) then begin
  237.         seek(uf,cur); read(uf,u);
  238.         if u.deleted then begin
  239.           done:=true;
  240.           cur:=0;
  241.         end else begin
  242.           if u.forusr=0 then begin
  243.             done:=true;
  244.             if ((nomail in u.option) and not cs) or ((n=1) and (u.waiting>50))
  245.                or ((n<>1) and (u.waiting>15)) or ((cur=usernum) and not so) then
  246.                  cur:=0;
  247.           end else begin
  248.             chk[cur]:=true;
  249.             cur:=u.forusr;
  250.           end;
  251.         end;
  252.       end else begin
  253.         done:=true;
  254.         cur:=0;
  255.       end;
  256.   forwardm:=cur;
  257. end;
  258.  
  259. procedure email(touser:integer; xx:boolean);
  260. var mr:mailrec; t,e,cp:integer; f:messages; a:anontyp; i:astr; us:userrec; ok:boolean;
  261.   procedure nope(i:astr);
  262.   begin
  263.     if ok then print(i);
  264.     ok:=false;
  265.   end;
  266. begin
  267.   ok:=not xx;
  268.   reset(uf);
  269.   if (touser>0) and (touser<filesize(uf)) then begin
  270.     seek(uf,touser); read(uf,user); close(uf);
  271.     if ((remail in thisuser.ac) or (thisuser.sl<=10)) and (user.sl<>255) then
  272.       nope('Your access privledges don''t include sending mail.');
  273.     if (etoday>=seclev[thisuser.sl].emails) and (thisuser.sl<55) and (user.sl<>255) then
  274.       nope('Too much E-mail sent today.');
  275.     if (user.sl=255) and (ftoday>=5) and (not so) then
  276.       nope('Too much feedback sent today.');
  277.     if (touser=usernum) and (not so) then
  278.       nope('Can''t E-mail yourself');
  279.     if (((user.sl=255) and (user.waiting>50)) or ((user.sl<>255) and
  280.       (user.waiting>15))) and (not so) then
  281.       nope('Mailbox full.');
  282.     if (nomail in user.option) and (not cs) then
  283.       nope('Mailbox closed.');
  284.     if user.deleted then
  285.       nope('Deleted user.');
  286.     if xx then ok:=true;
  287.     if ok then begin
  288.       a:=no; if sanm in seclev[thisuser.sl].anst then a:=yes;
  289.       inmsg(f,a,i,false,false);
  290.       if f.ext<>0 then begin
  291.         {$I-} reset(mailfile); {$I+}
  292.         if (ioresult<>0) then
  293.           rewrite(mailfile);
  294.         e:=filesize(mailfile);
  295.         if e=0 then cp:=0 else begin
  296.           cp:=-1; t:=e-1;
  297.           seek(mailfile,t); read(mailfile,mr);
  298.           while (t>0) and (mr.destin=-1) do begin
  299.             t:=t-1; seek(mailfile,t); read(mailfile,mr);
  300.           end;
  301.           cp:=t+1;
  302.         end;
  303.         seek(mailfile,cp);
  304.         mr.msg:=f; if lan then mr.from:=-usernum else mr.from:=usernum;
  305.         mr.destin:=touser;
  306.         mr.title:=i; mr.date:=daynum(date);
  307.         mr.mage:=maxage(thisuser.sl);
  308.         write(mailfile,mr);
  309.         if touser=1 then begin thisuser.feedback:=thisuser.feedback+1;
  310.           ftoday:=ftoday+1; fw:=fw+1; end else begin thisuser.emailsent:=
  311.           thisuser.emailsent+1; etoday:=etoday+1; end;
  312.         close(mailfile); reset(uf); seek(uf,touser); read(uf,user);
  313.         user.waiting:=user.waiting+1; seek(uf,touser); write(uf,user);
  314.         if touser=usernum then thisuser.waiting:=thisuser.waiting+1;
  315.         i:=user.name+' #'+cstr(touser);
  316.         close(uf); topscr;
  317.         if useron then sysoplog('Mail sent to '+i);
  318.         print('Mail sent to '+i);
  319.       end;
  320.     end;
  321.   end;
  322. end;
  323.  
  324.  
  325. procedure imail(i:integer);
  326. var user:userrec; ori:integer;
  327. begin
  328.   ori:=i;
  329.   if i>0 then begin
  330.     reset(uf); seek(uf,i); read(uf,user);
  331.     if user.deleted then begin
  332.       print('That user is deleted.');
  333.       close(uf);
  334.     end else begin
  335.       if user.forusr<>0 then begin
  336.         i:=forwardm(i);
  337.         if i>0 then begin
  338.           seek(uf,i); read(uf,user); close(uf);
  339.           print('That user is forwarding his mail to '+user.name+'.');
  340.           ynq('Confirm Email ['+user.name+' #'+cstr(i)+'] ? ');
  341.           if yn then
  342.             if ori=1 then
  343.               email(i,true)
  344.             else
  345.               email(i,false);
  346.         end else begin
  347.           print('Can''t E-mail that user.');
  348.           close(uf);
  349.         end;
  350.       end else begin
  351.         close(uf);
  352.         ynq('Confirm E-mail ['+user.name+' #'+cstr(i)+'] ? ');
  353.         if yn then email(i,false);
  354.       end;
  355.     end;
  356.   end;
  357. end;
  358.  
  359. procedure autoreply;
  360. var i:integer; c:char;
  361. begin
  362.   if lastname='' then print('Can''t Auto-reply now.') else begin
  363.     i:=length(lastname);
  364.     while (lastname[i]<>'#') and (i>1) do i:=i-1;
  365.     i:=value(copy(lastname,i+1,5));
  366.     if i=0 then print('It seems I can''t do that now.') else imail(i);
  367.   end;
  368. end;
  369.  
  370. procedure deletem(ntd:integer);
  371. var filvar:file; t:integer;
  372. begin
  373.   assign(filvar,filename(mary[ntd].message));
  374.   {$I-} erase(filvar); {$I+} t:=ioresult;
  375.   for t:=ntd+1 to tnum do begin
  376.     mary[t-1]:=mary[t];
  377.   end;
  378.   mary[0].message.number:=tnum-1;
  379.   bchanged:=true;
  380. end;
  381.  
  382. procedure readm(cn:integer; var next:boolean; var unvali:boolean);
  383. var i:astr; ratall,rname:boolean; x:integer; s:astr;
  384. begin
  385.   nl;nl;
  386.   ratall:=true; next:=false;unvali:=false; msgval:=true;
  387.   if mary[cn].messagestat<>validated then begin unvali:=true; msgval:=false; end;
  388. (*  if mary[cn].messagestat<>validated then begin  unvali:=true;
  389.     msgval:=false;
  390.     if systat.clearmsg then cls;
  391.     prompt('   Title: '); cl(3); prompt(mary[cn].title);
  392.     for i:=1 to (31-length(mary[cn].title)) do prompt(' ');
  393.     cl(0); print('Msg# '+cstr(cn)+' of '+cstr(tnum));
  394.     {I:=cstr(cn)+'/'+cstr(tnum);while length(I)<7 do I:=I+' ';I:=I+':';
  395.     prompt(i);cl(8);print(' <[ Not Validated ]>');}
  396.     lastname:='';
  397.     if not lcs then ratall:=false;
  398.   end;     *)
  399.   if ratall then begin
  400.     if systat.clearmsg then cls;
  401.     prompt('  Title: '); cl(3); prompt(mary[cn].title);
  402.     for x:=1 to (31-length(mary[cn].title)) do prompt(' ');
  403.     cl(1); print('Msg# '+cstr(cn)+' of '+cstr(tnum));
  404.     {I:=cstr(cn)+'/'+cstr(tnum);while length(I)<7 do I:=I+' ';I:=I+':';
  405.     prompt(I);cl(3);print(' '+mary[cn].title);}
  406.     irt:=mary[cn].title;
  407.     if postn in seclev[thisuser.sl].anst then rname:=true else rname:=false;
  408.     readmsg(mary[cn].message,rname,next); tleft;
  409.     if greater(mary[cn].message) then thisuser.qscan[board]:=mary[cn].message;
  410.   end;
  411. end;
  412.  
  413. function tnum:integer;
  414. begin
  415.   tnum:=mary[0].message.number;
  416. end;
  417.  
  418. procedure iscan;
  419. var f:file; n:integer;
  420. begin
  421.   if bread<>board then begin
  422.     assign(f,systat.gfilepath+boards[board].filename+'.BRD');
  423.     {$I-} reset(f,sizeof(messagerec)); {$I+}
  424.     if (ioresult=0) then begin
  425.       blockread(f,mary[0],1);
  426.       blockread(f,mary[1],mary[0].message.number);
  427.     end else begin
  428.       rewrite(f);
  429.       mary[0].message.number:=0;
  430.       blockwrite(f,mary[0],1);
  431.     end;
  432.     close(f);
  433.     bread:=board;
  434.     bchanged:=false;
  435.   end;
  436. end;
  437.  
  438.  
  439. procedure inmsg(var mrec:messages;an:anontyp;var title:astr;tr,mp:boolean);
  440. var li:array[1..120] of astr; t1,t,maxli,lc:integer; filler,spc,ti,i:astr;
  441. saveline,exit,save,abortit,ab,nx:boolean; c:char; filvar:text;
  442.  
  443.   procedure ptl;
  444.   begin
  445.       if systat.clearmsg then cls else nl;
  446.       prt('Title: '); mpl(30); inputl(title,30);
  447.     end;
  448.  
  449.   procedure listit(linenum:boolean);
  450.   var l:integer; abort,next:boolean;
  451.   begin
  452.     l:=1;
  453.     abort:=false;
  454.     while (l<>lc) and (not abort) do begin
  455.       if linenum then print(cstr(l)+':');
  456.       printa(li[l],abort,next);
  457.       if (pap<>0) AND (NOFEED=FALSE) then nl;
  458.       l:=l+1;
  459.     end;
  460.     cl(3);prompt('-=> ');cl(4);prompt('Total lines: [');cl(2);prompt(cstr(lc-1));cl(4);print(']');
  461.     saveline:=false;
  462.   end;
  463.  
  464.   procedure rpl(var i1:astr; i2:astr);
  465.   var c1,c2:integer; i3:astr;
  466.   begin
  467.     if i2[1]='/' then delete(i2,1,1);
  468.     if i2[length(i2)]=#1 then i2:=copy(i2,1,length(i2)-1);
  469.     if i2[length(i2)]='/' then i2:=copy(i2,1,length(i2)-1);
  470.     c1:=pos('/',i2); i3:=copy(i2,1,c1-1);
  471.     delete(i2,1,c1);
  472.     if i2[length(i2)]='/' then i2:=copy(i2,1,length(i2)-1);
  473.     c2:=pos(i3,i1);
  474.     if (length(i1)-length(i3)+length(i2))>(thisuser.linelen+10) then
  475.       print('Line would be too long')
  476.     else
  477.       if c2>0 then begin
  478.         delete(i1,c2,length(i3));
  479.         insert(i2,i1,c2);
  480.       end;
  481.   end;
  482.  
  483. var ii:integer; filv:text; s:astr;
  484. begin
  485.  if freek(0)>10 then begin
  486.   lc:=1;spc:='                                                                              ';
  487.   filler:='-------------------------------------------------------------------------------';
  488.   ll:=''; maxli:=systat.maxlines;
  489.   if tr then ptl else ptl;
  490.  end else begin
  491.    title:=''; tr:=true;
  492.    print('Not enough disk space');sysoplog('Hard DISK FULL - Not enough space to save message');
  493.  end;
  494.  if (title<>'') or not tr then begin
  495.   nl;nl;
  496.   prompt('Enter message now. You may have ');cl(3);prompt(cstr(maxli));cl(1);print(' lines maximum.');
  497.   prompt('Enter "');cl(0);prompt('/H');cl(1);
  498.   print('" for help with commands.  "/S" to save your message.');
  499.   cl(3);if (okansi) then
  500.   print(copy('[───:────:────:────:────:────:────:────]────:────:────:────:────:────:────:────]',
  501.     1,thisuser.linelen)) else
  502.   print(copy('[---=----=----=----=----=----=----=----]----=----=----=----=----=----=----=----]',
  503.     1,thisuser.linelen));
  504. repeat
  505.   repeat
  506.     saveline:=true; exit:=false; save:=false; abortit:=false;
  507.     inli(i);
  508.     if (i[1]=^J) and (i[2]='/') then i:=copy(i,2,length(i));
  509.     ti:=copy(i,1,3); if ti[length(ti)]=#1 then ti:=copy(ti,1,length(ti)-1);
  510.     ti[1]:=upcase(ti[1]); ti[2]:=upcase(ti[2]); ti[3]:=upcase(ti[3]);
  511.     if ((ti='/RL') or (ti='/R')) and (lc>1) then begin print('Replace:'); saveline:=false; lc:=lc-1; end;
  512.     if (ti='/EX') or (ti='/E') then begin exit:=true; saveline:=false; end;
  513.     if (ti='/ES') or (ti='/S') then begin exit:=true; save:=true; saveline:=false; end;
  514.     if ti='/C:' then begin
  515.       i:=copy(i,4,length(i)-3);
  516.       if i[length(i)]<>#1 then i:=i+#1;
  517.       i:=#2+i;
  518.     end;
  519.     if (ti='/T:') and (maxli-lc>2) then begin
  520.       i:=copy(i,4,length(i)-3);
  521.       if i[length(i)]=#1 then i:=copy(i,1,length(i)-1);
  522.       li[lc]:=#2+#3+#3+'.-'+copy(filler,1,length(i))+'-.'+#1;
  523.       li[lc+1]:=#2+#3+#3+'| '+#3+#0+i+#3+#3+' |'+#1;
  524.       li[lc+2]:=#2+#3+#3+'`-'+copy(filler,1,length(i))+'-''';
  525.       saveline:=false; lc:=lc+3;
  526.     end;
  527. (*  if (ti='/UL') and (so) then begin
  528.       print('Enter file name to upload: ');mpl(40);inputl(s,40);
  529.       assign(filv,s);
  530.       {$I-} reset(filv); {$I+}
  531.       if ioresult<>0 then print('File not found.') else
  532.       while not eof(filv) do begin
  533.         readln(filv,n);
  534.         dm(' '+n,c);
  535.       end;
  536.       close(filv);
  537.     end; *)
  538.     if (ti='/AB') or (ti='/A') then begin
  539.       exit:=true; abortit:=true; saveline:=false; end;
  540.     if (ti='/CL') or (ti='/C') then begin
  541.       saveline:=false; lc:=1;
  542.       print('Message cleared.... Start over...');
  543.     end;
  544.     if ((ti='/SU') or (ti='/ED')) and (lc>1) then begin
  545.       prt('Replace string on what line (1-'+cstr(lc-1)+') ? ');
  546.       input(i,4); if (value(i)>0) and (value(i)<lc) then begin
  547.         print('Enter replacement string (format: StringtoReplace/NewString)');
  548.         prt(':'); inputl(s,74);
  549.         {rpl(li[lc-1],copy(i,4,80));}
  550.         rpl(li[value(i)],s);
  551.         print('Edited line: '); ab:=false;
  552.         printacr(li[value(i)],ab,nx);
  553.       end;
  554.       saveline:=false;
  555.     end;
  556.     if (ti='/HE') or (ti='/H') or (ti='/?')
  557.        then begin printf(systat.gfilepath+'prhelp'); saveline:=false; end;
  558.     if ti='/CO' then begin saveline:=false; printf(systat.gfilepath+'color'); end;
  559.     if (ti='/LI') or (ti='/L') then begin
  560.       ynq('With line numbers? '); if yn then listit(true) else listit(false);
  561.     end;
  562.     if saveline then begin li[lc]:=i; lc:=lc+1; if lc>maxli then begin
  563.         print('You have used up your maxium amount of lines.');
  564.         exit:=true;
  565.       end;
  566.     end;
  567.   until exit or hangup;
  568.   if hangup then abortit:=true;
  569.   if (not abortit) and (not save) then
  570.   repeat
  571.     prt('Message Editor Command - [S,L,A,C,R,I,D,T,U,?] : '); CL(5);
  572.     ONEK(c,'SULACRIDT?');
  573.     case c of
  574.       'L':begin prompt('With line numbers? '); if yn then listit(true) else listit(false); end;
  575.       'T':ptl;
  576.       'D':begin
  577.             prompt('Line number to delete (1-'+cstr(lc-1)+')? ');
  578.             input(i,4);t:=value(i); if (t>0) and (t<lc) then begin
  579.               for t1:=t to lc-2 do li[t1]:=li[t1+1]; lc:=lc-1;
  580.             end;
  581.           end;
  582.       'R':begin
  583.             prompt('Line number to replace (1-'+cstr(lc-1)+')? ');
  584.             input(i,4);t:=value(i); if (t>0) and (t<lc) then begin
  585.               print('Old line:'); ab:=false; printa(li[t],ab,nx);
  586.               print('Enter new line:'); inli(i);
  587.               if (li[t][length(li[t])]=#1) and (i[length(i)]<>#1) then
  588.                li[t]:=i+#1 else li[t]:=i;
  589.             end;
  590.           end;
  591.       'U':begin
  592.             prompt('Line number to update (1-'+cstr(lc-1)+')? ');
  593.             input(i,4);t:=value(i); if (t>0) and (t<lc) then begin
  594.               nl; ab:=false; printa(li[t],ab,nx); nl; print('Format: oldstr/newstr');
  595.               prompt('Update: '); inputl(i,70); rpl(li[t],i);
  596.               nl; ab:=false; printa(li[t],ab,nx); nl; nl;
  597.             end;
  598.           end;
  599.       'I':if (lc<maxli) then begin
  600.             prompt('Line number to insert before (1-'+cstr(lc-1)+')? ');
  601.             input(i,4); t:=value(i); if (t>0) and (t<lc) then begin
  602.               for t1:=lc downto t+1 do li[t1]:=li[t1-1]; lc:=lc+1;
  603.               print('New line:'); inli(li[t]);
  604.             end;
  605.           end;
  606.       'A':begin
  607.             prompt('Abort? ');
  608.             if yn then abortit:=true else c:=' ';
  609.           end;
  610.       'S':save:=true;
  611.       'C':if lc>maxli then begin print('Too long.'); c:=' '; end else
  612.             print('Continue...');
  613.       '?':printf(systat.gfilepath+'editor');
  614.     end;
  615.   until (c='S') or (c='A') or (c='C') or hangup;
  616.  until abortit or save or hangup;
  617.  if lc=1 then begin abortit:=true; save:=false; end;
  618.  if save then begin
  619.    case an of
  620.      no      : ti:=nam;
  621.      forced  : if so then ti:='!'+nam else ti:='@'+nam;
  622.      yes     : begin
  623.                  ynq('Anonymous? '); CL(1);
  624.                  if yn then
  625.                    if so then
  626.                      ti:='!'+nam
  627.                    else
  628.                      ti:='@'+nam
  629.                  else
  630.                    ti:=nam;
  631.                end;
  632.      dearabby: begin
  633.                  nl;print('Post as:'); print('1. Abby');
  634.                  print('2. Problemed Person'); print('3. '+nam);
  635.                  nl;prompt('Which? '); onek(c,'123N'+#13);
  636.                 case c of
  637.                  '1'        : ti:='+'+nam;
  638.                  '2'        : ti:='-'+nam;
  639.                  '3',#13,'N': ti:=nam;
  640.                 end;
  641.                end;
  642.    end;
  643.    if ti=nam then lan:=false else lan:=true;
  644.    prompt('Saving...');
  645.    while (lc>1) and ((li[lc-1]='') or (li[lc-1]=chr(10))) do lc:=lc-1;
  646.    mrec:=systat.hmsg; mrec.number:=mrec.number+1; if mrec.number=-32767 then
  647.      mrec.ltr:=succ(mrec.ltr);
  648.    if mrec.ltr>'Z' then begin
  649.      mrec.ltr:='A';
  650.      mrec.ext:=mrec.ext+1;
  651.      if mrec.ext>=128 then mrec.ext:=1;
  652.    end;
  653.    systat.hmsg:=mrec;
  654.    if mp then mrec.ext:=mrec.ext+128;
  655.    i:=filename(mrec);
  656.    assign(filvar,i);
  657.    rewrite(filvar);
  658.    writeln(filvar,ti); ti:=dat; writeln(filvar,ti);
  659.    if irt<>'' then begin
  660.      writeln(filvar,'     RE: '+#3+#9+irt+#3+#1);
  661.      writeln(filvar); writeln(filvar); writeln(filvar);
  662.    end;
  663.    for t:=1 to lc-1 do
  664.      writeln(filvar,li[t]);
  665.    close(filvar); savesystat;
  666.    cl(5); for t:=1 to 9 do begin prompt('<'); delay(20); prompt(#8+' '+#8+#8); end;
  667.    cl(9);
  668.  end else begin print('Aborted.'); mrec.ext:=0; end;
  669.  end else begin print('Aborted.'); mrec.ext:=0; end;
  670. end;
  671.  
  672.  
  673. function filename(mrec:messages):astr;
  674. begin
  675.   filename:=systat.msgpath+mrec.ltr+cstr(mrec.number)+'.'+cstr(mrec.ext);
  676. end;
  677.  
  678. procedure printfile1(fn:astr; var abort:boolean);
  679. begin
  680.   pfl(fn,abort,false);
  681. end;
  682.  
  683. procedure wfcmenu;
  684. VAR I:INTEGER;
  685. begin
  686.  clrscr; tc(1); (* Dark Blue *)
  687.  gotoxy(1,1); write('   ─────────────────');
  688.  gotoxy(59,1); write(' ────────────────');
  689.  gotoxy(1,2); write('────────────────────');
  690.  gotoxy(59,2); write(' ────────────────────');
  691.  gotoxy(1,3); write('   ─────────────────');
  692.  gotoxy(59,3); write(' ────────────────');
  693.  if systat.special then for i:=22 downto 0 do begin
  694.    TC(14);
  695.    gotoxy(22,1+i);
  696.    write('┌─┬─┐ ┌── ┬   ┌── ┌──┐ ┌──┐ ┬──┐ ┬──┐');
  697.    tc(12);
  698.    gotoxy(22,2+i); write('  │   ├─  │   ├─  │  ┬ ├──┤ ├─┬┘ │  │');
  699.    tc(4);
  700.    gotoxy(22,3+i); write('  ┴   └── └── └── └──┘ ┴  ┴ ┴ └┘ ┴──┘');
  701.    gotoxy(22,4+i); clreol;
  702.  end else
  703.  begin
  704.    TC(14);
  705.    gotoxy(22,1);
  706.    write('┌─┬─┐ ┌── ┬   ┌── ┌──┐ ┌──┐ ┬──┐ ┬──┐');
  707.    tc(12);
  708.    gotoxy(22,2); write('  │   ├─  │   ├─  │  ┬ ├──┤ ├─┬┘ │  │');
  709.    tc(4);
  710.    gotoxy(22,3); write('  ┴   └── └── └── └──┘ ┴  ┴ ┴ └┘ ┴──┘');
  711.    gotoxy(22,4); clreol;
  712.  end;
  713.  tc(10);
  714.  gotoxy(13,5); writeln('Telegard BBS System, By Carl Mueller and Jeff Randolph');
  715.  gotoxy(33,7); textcolor(14); write('- WFC Commands -');
  716.  WRITELN;textcolor(15);
  717.  writeln('   >Log-on system     A>nswer phone       B>oard edit         />Short Log');
  718.  writeln('  F>ile Board Edit    E>dit a text file   D>Drop to DOS       #>Menu Edit');
  719.  writeln('  I>nit Votes         L>og of today       M>ail read          P>Setup config');
  720.  writeln('  Q>uit to DOS        R>ead feeback       X>Init modem        T>erminal');
  721.  writeln('  U>ser editor        Y>esterday''s log    Z>log report        =>External Utl');
  722.  textcolor(14);
  723.  writeln('                               - System Status -');textcolor(3);
  724.  TEXTCOLOR(15);
  725.  writeln('   Time       :           Disk space   :          Comm port :');
  726.  writeln('   Date       :           Files waiting:          # of users:');
  727.  writeln('   Total calls:           New user''s pw:          Max baud  :');
  728.  writeln('   Board      :           Sysop status :          Hours     :');
  729.  TEXTCOLOR(14);writeln('                              - Today''s Status -');TEXTCOLOR(15);
  730.  writeln('     Activity   :           # of posts   :          Email sent:');
  731.  writeln('     Calls      :           Uploads      :          Feedback  :');
  732.  {writeln('     Last Caller:');}
  733.  textcolor(11);gotoxy(16,16);write(cstr(systat.callernum));gotoxy(16,17);
  734.  if systat.closedsystem then write('Closed') else write('Open');
  735.  gotoxy(41,14);write(cstr(freek(0))+'k');gotoxy(41,15);write(cstr(fw));
  736.  Gotoxy(41,16);if systat.boardpw='' then write('None') else
  737.  write(systat.boardpw);gotoxy(62,14);write(systat.comport);gotoxy(62,15);
  738.  write(cstr(systat.users));gotoxy(62,16);write(systat.maxbaud);gotoxy(62,17);
  739.  if systat.lowtime=systat.hitime then write('None') else
  740.  write(tch(cstr(systat.lowtime div 60))+':'+tch(cstr(systat.lowtime mod 60))+' to '+
  741.        tch(cstr(systat.hitime div 60))+':'+tch(cstr(systat.hitime mod 60)));
  742.  gotoxy(18,19);write(cstr(systat.activetoday));gotoxy(18,20);write(cstr(systat.callstoday));
  743.  gotoxy(43,19);write(cstr(systat.msgposttoday));gotoxy(43,20);write(cstr(systat.uptoday));
  744.  gotoxy(64,19);write(cstr(systat.emailtoday));gotoxy(64,20);write(cstr(systat.fbacktoday));
  745. { gotoxy(18,21);write(lastcaller);}
  746.  textcolor(3);
  747. end;
  748.  
  749. procedure mmkey(var i:astr);
  750. var c:char;
  751. begin
  752.   repeat
  753.     repeat
  754.       getkey(c);
  755.     until (((c>=' ') and (c<chr(127))) or (c=chr(13))) or hangup;
  756.     c:=upcase(c);
  757.     outkey(c);
  758.     thisline:=thisline+c;
  759.     if (c='/') or (c='1') then begin
  760.       i:=c;
  761.       repeat
  762.         getkey(c);
  763.       until ((c>=' ')and(c<=chr(127))) or (c=chr(13)) or (c=chr(8)) or hangup;
  764.       c:=upcase(c);
  765.       if c<>chr(13) then begin outkey(c); thisline:=thisline+c; end;
  766.       if (c=chr(8)) or (c=chr(127)) then prompt(' '+c);
  767.       if c='/' then begin cl(6); input(i,50); end else if c<>chr(13) then i:=i+c;
  768.     end else i:=c;
  769.   until (c<>chr(8)) and (c<>chr(127)) or hangup;
  770.   nl;
  771. end;
  772.  
  773. function greater(mrec:messages):boolean;
  774. begin
  775.  if mrec.ext>thisuser.qscan[board].ext then greater:=true else
  776.   if mrec.ltr>thisuser.qscan[board].ltr then greater:=true else
  777.     if (mrec.ltr=thisuser.qscan[board].ltr) and (mrec.number>thisuser.qscan[board].number) then
  778.       greater:=true
  779.     else greater:=false;
  780. end;
  781.  
  782. function maxage(x:integer):integer;
  783. begin
  784.   maxage:=255;
  785.   if x<20 then
  786.     maxage:=5
  787.   else if x<30 then
  788.     maxage:=14
  789.   else if x<40 then
  790.     maxage:=90
  791.   else if x<60 then
  792.     maxage:=120;
  793. end;
  794.  
  795. function boardacpw(nb:integer):boolean;
  796. var i:astr;
  797. begin
  798.   boardacpw:=false;
  799.   if (thisuser.sl>=boards[nb].sl) and
  800.   ((boards[nb].ar='@') or (boards[nb].ar in thisuser.ar)) then
  801.   if boards[nb].pw='' then boardacpw:=true else begin
  802.     prt('Password? '); mpl(10); input(i,10);
  803.     if i=boards[nb].pw then boardacpw:=true else print('Wrong.');
  804.   end;
  805. end;
  806.  
  807. function boardac(nb:integer):boolean;
  808. begin
  809.   boardac:=false;
  810.   if (thisuser.sl>=boards[nb].sl) and
  811.   ((boards[nb].ar='@') or (boards[nb].ar in thisuser.ar)) then boardac:=true;
  812. end;
  813.  
  814. procedure isr(uname:astr;usernum:integer);
  815. var t,i,ii:integer; sr:smalrec;
  816. begin
  817.  ii:=systat.users; i:=0;
  818.  while (ii-i)>1 do begin
  819.    t:=(ii+i) div 2;
  820.    if uname<srl[t].name then
  821.      ii:=t
  822.    else
  823.      i:=t;
  824.  end;
  825.  if srl[ii].name<uname then i:=ii;
  826.  for ii:=systat.users downto i+1 do
  827.    srl[ii+1]:=srl[ii];
  828.  sr.name:=uname; sr.number:=usernum;
  829.  srl[i+1]:=sr;
  830.  systat.users:=systat.users+1;
  831.  savesystat;
  832.  rewrite(sf); for ii:=0 to systat.users do write(sf,srl[ii]); close(sf);
  833. end;
  834.  
  835. function ctp(t,b:integer):astr;
  836. var i,i1:astr; n:real;
  837. begin
  838.   i:=cstr((t*100) div b); if length(i)=1 then i:=' '+i; i:=i+'.';
  839.   if length(i)=3 then i:=' '+i;
  840.   n:=t/b+0.0005;
  841.   i1:=cstr(trunc(n*1000) mod 10);
  842.   ctp:=i+i1+'%';
  843. end;
  844.  
  845. procedure inli(var i:astr);
  846. var cp,rp:integer; c,c1:char; cv,cc:integer; escp:boolean;
  847.  
  848.   procedure bkspc;
  849.   begin
  850.     if cp>1 then begin
  851.       if (i[cp-2]=#3) and (i[cp-1] in [#0..#9]) then begin
  852.         cp:=cp-1;
  853.         CL(1);
  854.       end else
  855.         if i[cp-1]=#8 then begin
  856.           prompt(' ');
  857.           rp:=rp+1;
  858.         end else
  859.           if i[cp-1]<>#10 then begin
  860.             prompt(#8+' '+#8);
  861.             rp:=rp-1;
  862.           end;
  863.       cp:=cp-1;
  864.     end;
  865.   end;
  866.  
  867. var ccc,d:char;
  868. begin
  869.   write_msg:=true;
  870.   ccc:='1';
  871.   escp:=false;
  872.   rp:=1; cp:=1;
  873.   i:='';
  874.   if ll<>'' then begin prompt(ll); i:=ll; ll:=''; cp:=length(i)+1; rp:=cp;end;
  875.   repeat
  876.     getkey(c);
  877.     case ord(c) of
  878.       32..255:if (cp<strlen) and (rp<thisuser.linelen) then begin
  879.                 i[cp]:=c; cp:=cp+1; rp:=rp+1; outansi(c); thisline:=thisline+c;
  880.               end;
  881.            27:if (cp<strlen) and (rp<thisuser.linelen) then begin
  882.                 escp:=true; i[cp]:=c; cp:=cp+1; rp:=rp+1; outansi(c); thisline:=thisline+c;
  883.               end;
  884.             8:bkspc;
  885.             2:dm(' -'+#14+'/'+#14+'l'+#14+'\'+#14,c);
  886.            19:dm(' '+nam+' ',c);
  887.            24:begin
  888.                 cp:=1; for cv:=1 to rp-1 do prompt(#8+' '+#8);
  889.                 rp:=1;
  890.                 if ccc<>'1' then begin
  891.                   c1:=ccc;
  892.                   i[cp]:=#3;
  893.                   cp:=cp+1;
  894.                   i[cp]:=chr(ord(c1)-ord('0'));
  895.                   cp:=cp+1;
  896.                   CL(ord(i[cp-1]));
  897.                 end;
  898.               end;
  899.            23:if cp>1 then repeat
  900.                 bkspc;
  901.               until (cp=1) or (i[cp]=' ') or ((i[cp]=chr(8)) and (i[cp-1]<>#3));
  902.            14:if (not (rbackspace in thisuser.ac)) then begin
  903.                 prompt(chr(8)); i[cp]:=chr(8); cp:=cp+1; rp:=rp-1;
  904.               end;
  905.            10:if (not (rbackspace in thisuser.ac)) then begin
  906.                 prompt(c); i[cp]:=c; cp:=cp+1;
  907.               end;
  908.            16:if okansi and (cp<strlen-1) then begin
  909.                 getkey(c1);
  910.                 if c1 in ['0'..'9'] then begin
  911.                   ccc:=c1;
  912.                   i[cp]:=#3;
  913.                   cp:=cp+1;
  914.                   i[cp]:=chr(ord(c1)-ord('0'));
  915.                   cp:=cp+1;
  916.                   CL(ord(i[cp-1]));
  917.                 end;
  918.               end;
  919.             9:begin
  920.                 cv:=5-(cp mod 5); if (cp+cv<strlen) and (rp+cv<thisuser.linelen) then
  921.                   for cc:=1 to cv do begin
  922.                     rp:=rp+1; prompt(' ');
  923.                     i[cp]:=' '; cp:=cp+1;
  924.                   end;
  925.               end;
  926.   end;
  927.   until (c=chr(13)) or ((rp=(thisuser.linelen)) or (cp=strlen) and (wordwrap in thisuser.defaults)) or hangup;
  928.   i[0]:=chr(cp-1);
  929.   if (c<>chr(13)) and (cp<>strlen) and (escp=false) then begin
  930.     cv:=cp-1;
  931.     while (cv>1) and (i[cv]<>' ') and ((i[cv]<>chr(8)) or (i[cv-1]=#3)) do
  932.       cv:=cv-1;
  933.     if (cv>(rp div 2)) and (cv<>cp-1) then begin
  934.       ll:=copy(i,cv+1,cp-cv); for cc:=cp-2 downto cv do prompt(chr(8));
  935.       for cc:=cp-2 downto cv do prompt(' ');
  936.       i[0]:=chr(cv-1);
  937.     end;
  938.   end;
  939.   if (escp) and (rp=thisuser.linelen) then cp:=strlen;
  940.   if cp<>strlen then nl;
  941.   if cp=strlen then begin rp:=1; cp:=1; i:=i+chr(29); end;
  942.   if c=chr(13) then begin
  943.     if (rp=(thisuser.linelen)) then i:=i+chr(29) else i:=i+chr(1);
  944.   if (escp=true) and (i[length(i)]<>#1) then i[length(i)+1]:=#1;
  945.            {false}
  946.   end;
  947.   write_msg:=false;
  948. end;
  949.  
  950. procedure readmsg(mrec:messages;rname:boolean; var next:boolean);
  951. var f,n,rn,d:astr; filvar:text; abort:boolean; kkk:boolean;s:astr; i:integer;
  952. begin
  953.   kkk:=false;
  954.   lastname:=''; next:=false;
  955.   f:=filename(mrec); rn:='';
  956.   if (wantfilename) and (cs) and (not hangup) then begin
  957.   prompt('   File: ');cl(5);print(f);end;
  958.   assign(filvar,f); {$I-} reset(filvar); {$I+}
  959.   if ioresult<>0 then begin cl(5);print(#7+'--> Message not available'); kkk:=true;
  960.     end else
  961.   if (not hangup) then begin
  962.     readln(filvar,n);
  963.     readln(filvar,d); lastname:=n;
  964.     if ((n[1]='@') and rname) or ((n[1]='!') and so) then
  965.       n:=copy(n,2,length(n)-1)+' (Anon)'
  966.     else
  967.       if (n[1] in ['!','@']) then
  968.         begin
  969.           lastname:='';
  970.           n:='Anonymous'; d:='In-Active';
  971.         end;
  972.     if (N[1]='+') or (n[1]='-') then begin
  973.       rn:=copy(n,2,length(n)-1);
  974.       if n[1]='+' then n:='Abby' else n:='Problemed Person';
  975.       if not rname then begin d:='?'; rn:=''; lastname:=''; end;
  976.     end;
  977.     abort:=false;
  978.     s:='     By: '+#3+#5+n;
  979.     for i:=1 to (31-length(n)) do s:=s+' ';
  980.     s:=s+#3+#1+'Status: '+#3+#3; if not readingmail then if msgval=true then s:=s+'Public' else s:=s+'Unvalidated' else
  981.       s:=s+'Private';
  982.     printacr(s,abort,next); if not abort then begin
  983.       if  rn<>'' then BEGIN prompt('Real NN: ');cl(5);print(rn); END;
  984.       s:='   Date: '+#3+#5+d;
  985.       for i:=1 to (31-length(d)) do s:=s+' ';
  986.       if not readingmail then
  987.       s:=s+#3+#1+'Board:  '+#3+#3+boards[board].name else
  988.       s:=s+#3+#1+'Board:  '+#3+#3+'E-mail';
  989.       printacr(s,abort,next); nl;
  990. {     if okansi then begin
  991.         cl(2); s:='  '; for i:=1 to 68 do s:=s+'─';
  992.         printacr(s,abort,next);
  993.       end;                     }
  994.       if lcs then msgval:=true;
  995.       while (not abort) and (not eof(filvar)) and (msgval) do begin
  996.         readln(filvar,n);
  997.         reading_a_msg:=true;
  998.         printa(n,abort,next);
  999.         reading_a_msg:=false;
  1000.       end;
  1001.       if not abort then nl;
  1002.     end;
  1003.   end;
  1004.   if kkk=false then close(filvar); nl;
  1005. end;
  1006. end.