home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 153.img / TELES.ZIP / UNITX.PAS < prev    next >
Pascal/Delphi Source File  |  1988-07-25  |  36KB  |  1,125 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. Unit UnitX; {PartX renamed to Unit X for sanity's sake}
  9.  
  10. Interface
  11.  
  12. Uses
  13.   Crt,
  14.   Dos,
  15.   Common,
  16.   Unit0;
  17.  
  18. procedure readq(filen:astr);
  19. procedure docitystate;
  20. procedure dozipcode;
  21. procedure dophone;
  22. procedure dostreet;
  23. procedure dojob;
  24. procedure doscreen;
  25. procedure finduser(var usernum:integer);
  26. procedure post;
  27. procedure p1;
  28. function p2:boolean;
  29. function rmail(n:integer):astr;
  30. procedure dsr(uname:astr);
  31. procedure ssm(dest:integer; s:astr);
  32. procedure rsm;
  33. procedure chbds;
  34. procedure forwardmail;
  35. procedure chcolors;
  36. procedure mmacroo;
  37. procedure readamsg;
  38. procedure logon1;
  39. function vote1x(qnum:integer; var vd:vdatar):boolean;
  40. procedure wmsg;
  41. procedure smail2(na:emary);
  42. procedure initp1;
  43. procedure getcallera(var c:char; var chkcom:boolean);
  44.  
  45. Implementation
  46.  
  47. procedure readq(filen:astr);
  48. var ff,ff1:text; a,s,store:astr; i,x:integer; fuku,abort:boolean;
  49. begin
  50.   assign(ff,filen);
  51.   {$I-} reset(ff); {$I+}
  52.   if ioresult=0 then begin
  53.     store:=copy(filen,1,pos('.',filen)-1)+'.ASW';
  54.     assign(ff1,store); {$I-} append(ff1); {$I+}
  55.     if ioresult<>0 then rewrite(ff1);
  56.     writeln(ff1,'User: '+nam);
  57.     repeat
  58.     fuku:=false;
  59.     readln(ff,a);
  60.     for i:=1 to length(a) do begin
  61.       if a[i]='*' then begin
  62.         prompt(copy(a,1,i-1));
  63.         x:=80-i; inputl(s,x);
  64.         writeln(ff1,copy(a,1,i-1)+s);
  65.         fuku:=true;
  66.       end;
  67.     end;
  68.     abort:=false;
  69.     if fuku=false then printacr(a,abort,next);
  70. {   if fuku then writeln(f1,copy(a,1,length(a)-1)+s) else writeln(f1,a);}
  71.     until (eof(ff)) or (hangup);
  72.   close(ff); close(ff1);
  73.   end;
  74. end;
  75.  
  76. procedure finduser(var usernum:integer);
  77. var t,i,i1:integer;
  78.     nn:astr;
  79. begin
  80.   input(nn,25);
  81.   usernum:=value(nn); if usernum>0 then begin
  82.     reset(uf);
  83.     if usernum>filesize(uf)-1 then begin
  84.       print('Unknown User.');
  85.       usernum:=0; end
  86.     else begin
  87.       seek(uf,usernum);
  88.       read(uf,user);
  89.       if user.deleted then begin
  90.         print('Unknown User.');
  91.         usernum:=0; end;
  92.       end;
  93.     close(uf); end
  94.   else begin
  95.     i:=1; i1:=systat.users; t:=(i1+i) div 2;
  96.     while ((i1-i)>1) and (srl[t].name<>nn) do begin
  97.       if srl[t].name<nn then
  98.         i:=t
  99.       else
  100.         i1:=t;
  101.       t:=(i1+i) div 2;
  102.     end;
  103.     usernum:=0;
  104.     if srl[i].name=nn then usernum:=srl[i].number;
  105.     if srl[i1].name=nn then usernum:=srl[i1].number;
  106.     if srl[t].name=nn then usernum:=srl[t].number;
  107.     if nn='NEW' then usernum:=-1;
  108.     if usernum=0 then print('Unknown User.');
  109.    end;
  110.  end;
  111.  
  112. procedure post;
  113. var b:messagerec; i:astr; mesag:messages; a:anontyp; c:char;
  114. begin
  115.   if (thisuser.sl<boards[board].postsl) or (rpost in thisuser.ac) then
  116.     print('Your access privledges do not include posting.')
  117.   else begin
  118.    if not rep then irt:='';
  119.    if ((ptoday>=seclev[thisuser.sl].posts) and (thisuser.sl<55)) then
  120.      print('Too many messages posted today.') else begin
  121.     a:=boards[board].anonymous;
  122.     if (a=no) and (pana in seclev[thisuser.sl].anst) then
  123.       a:=yes;
  124.     if rpostan in thisuser.ac then a:=no;
  125.     inmsg(mesag,a,i,true,false);
  126.       if mesag.ext<>0 then begin
  127.         b.message:=mesag;
  128.         b.title:=i;
  129.         b.owner:=usernum;
  130.         b.date:=daynum(date);
  131.         b.mage:=maxage(thisuser.sl);
  132.         if rvalidate in thisuser.ac then
  133.           b.messagestat:=unvalidated else b.messagestat:=validated;
  134.         if rmsg in thisuser.ac then b.messagestat:=deleted;
  135.         iscan;
  136.         if tnum>=boards[board].maxmsgs then deletem(1);
  137.         mary[0].message.number:=tnum+1;
  138.         mary[tnum]:=b;
  139.         bchanged:=true;
  140.         thisuser.msgpost:=thisuser.msgpost+1; ptoday:=ptoday+1;
  141.         systat.msgposttoday:=systat.msgposttoday+1;
  142.         sysoplog('+'+i+' posted on '+boards[board].name); topscr;
  143.         print('Message posted on '+boards[board].name+'.');
  144.       end;
  145.    end;
  146.   end;
  147. end;
  148.  
  149. procedure docitystate;
  150. begin
  151.   repeat
  152.     nl;
  153.     print('Enter your city & state seperated by a comma');
  154.     prompt(':');
  155.     inputl(thisuser.citystate,26);
  156.   until (pos(',',thisuser.citystate)<>0) or (hangup);
  157. end;
  158.  
  159. procedure dostreet;
  160. begin
  161.   repeat
  162.     nl;
  163.     print('Enter your mailing address: <House number> <Street> [APT#]');
  164.     prompt(':');
  165.     inputl(thisuser.street,21);
  166.   until (thisuser.street<>'') or (hangup);
  167. end;
  168.  
  169. procedure dozipcode;
  170. begin
  171.   repeat
  172.     print('Enter your zipcode (9 digit if available)');
  173.     print(' ##### or #####-####');
  174.     prompt(':');
  175.     input(thisuser.zipcode,10);
  176.   until (thisuser.zipcode<>'') or (hangup);
  177. end;
  178.  
  179. procedure dojob;
  180. begin
  181.   repeat
  182.     print('Enter your occupation');
  183.     prompt(':');
  184.     inputl(thisuser.occupation,40);
  185.   until (thisuser.occupation<>'') or (hangup);
  186. end;
  187.  
  188. procedure doscreen;
  189. var v:astr;
  190. begin
  191.   nl;prompt('How many columns wide is your screen (32-80, <CR>=80) :');
  192.   ini(thisuser.linelen);
  193.   if thisuser.linelen=0 then thisuser.linelen:=80;
  194.   prompt('Number of lines per page (4-25, <CR>=25) : ');
  195.   input(v,2);
  196.   if v='' then thisuser.pagelen:=25;
  197.   if v<>'' then thisuser.pagelen:=value(v);
  198.   if thisuser.pagelen>25 then thisuser.pagelen:=25;
  199.   if thisuser.pagelen<4 then thisuser.pagelen:=4;
  200. end;
  201.  
  202. procedure dophone;
  203. var right:boolean;
  204. begin
  205.   repeat
  206.     right:=true;
  207.     print('Enter your VOICE phone number in the');
  208.     print('form:');
  209.     print(' ###-###-####.'); prompt(':');
  210.     input(thisuser.ph,12);
  211.     if (copy(thisuser.ph,5,12)='000-0000') or (copy(thisuser.ph,5,3)='555')
  212.     or (copy(thisuser.ph,5,12)='111-1111') then
  213.     begin
  214.       print('GEE - I almost believe you.');
  215.       thisuser.ph:='';
  216.     end;
  217.     if (length(thisuser.ph)<>12) or (thisuser.ph[4]<>'-') or
  218.     (thisuser.ph[8]<>'-') then begin
  219.     print('Please enter the phone number correctly!'); right:=false; end;
  220.   until (right) or (hangup);
  221. end;
  222.  
  223. procedure p1;
  224. var c:char; tries,i,ii,t:integer; s,s1,s2:astr; tf:boolean; fi:text; pasw:astr;
  225.     done:boolean; choseansi,chosecolor:boolean;
  226.  
  227.   procedure showstuff;
  228.   begin
  229.     nl;nl;printf(systat.gfilepath+'system');
  230.     nl;nl;printf(systat.gfilepath+'newuser');
  231.     tries:=0; pasw:='';
  232.     while (systat.boardpw<>pasw) and (not hangup) do begin
  233.       prompt('Newuser password :'); echo:=false; input(pasw,38);
  234.       echo:=true; tries:=tries+1;
  235. {        if (pasw='OFF') or (pasw='BYE') then tries:=systat.tries+1;}
  236.       if tries>=(systat.tries) then
  237.         hangup:=true
  238.       else
  239.         if (systat.boardpw<>pasw) and (pasw<>'') then
  240.           sl1('Wrong newuser password: '+pasw);
  241.     end;
  242.   end;
  243.  
  244.   procedure doname;
  245.   var i:integer;
  246.   begin
  247.     repeat
  248.       if systat.alias then print('Enter your first & last name, or your alias.') else
  249.       print('Enter your first & last name.  Handles are not allowed!');
  250.       prompt(':'); input(thisuser.name,21); tf:=false;
  251.       nl;
  252.       if not (thisuser.name[1] in ['A'..'Z']) or (thisuser.name='') then tf:=true;
  253.       for i:=1 to systat.users do if srl[i].name=thisuser.name then begin
  254.         tf:=true;
  255.         print('That name is already being used.');
  256.       end;
  257.       assign(fi,systat.gfilepath+'trashcan.txt');{$I-} reset(fi); {$I+}
  258.       if ioresult=0 then begin
  259.         s2:=' '+thisuser.name+' ';
  260.         while not eof(fi) do begin
  261.           readln(fi,s1); if s1[length(s1)]=#1 then s1[length(s1)]:=' ' else s1:=s1+' ';
  262.           s1:=' '+s1; for i:=1 to length(s1) do s1[i]:=upcase(s1[i]);
  263.           if pos(s1,s2)<>0 then begin print('"'+copy(s1,pos(s1,s2),length(s1))+'" may not be used!');
  264.             tf:=true; end;
  265.         end;
  266.         close(fi);
  267.       end;
  268.       if tf and (not hangup) then begin
  269.         print(chr(7)+'Sorry, can''t use that name.');
  270.          t:=t+1;
  271.         sl1('Unacceptable name     : '+thisuser.name);
  272.       end;
  273.       if t>=3 then hangup:=true;
  274.     until (tf=false) or hangup;
  275.   end;
  276.  
  277.   procedure dorealname;
  278.   begin
  279.     repeat
  280.       nl; print('Enter your REAL first & last name.');
  281.       prompt (':');
  282.       inputl(thisuser.realname,21);
  283.       if (thisuser.realname='=') or (thisuser.realname='same') then
  284.         thisuser.realname:=thisuser.name;
  285.     until (thisuser.realname<>'') or (hangup);
  286.   end;
  287.  
  288.   procedure docomputer;
  289.   var right:boolean;
  290.   begin
  291.     repeat
  292.       print('What kind of computer do you have?');
  293.       prompt(':');input(thisuser.computer,14);
  294.     until (thisuser.computer<>'');
  295.   end;
  296.  
  297.   procedure dosex;
  298.   begin
  299.     nl; prompt('Your sex (M,F) ? ');
  300.     onek(thisuser.sex,'MF');
  301.   end;
  302.  
  303.   procedure doage;
  304.   begin
  305.     repeat
  306.       nl;
  307.       prompt('What is your age in years? ');
  308.       ini(thisuser.age);
  309.     if thisuser.age<7 then print('Aren''t you a little too young?');
  310.     if thisuser.age>99 then print('Yeah, sure. That old!');
  311.     until (thisuser.age>6) and (thisuser.age<100) or (hangup);
  312.   end;
  313.  
  314.   procedure dowherebbs;
  315.   begin
  316.     repeat
  317.       print('Where did you hear about this BBS?');
  318.       prompt(':');
  319.       inputl(thisuser.wherebbs,40);
  320.     until (thisuser.wherebbs<>'') or (hangup);
  321.   end;
  322.  
  323.   procedure doansi;
  324.   begin
  325.     begin
  326.       choseansi:=false;
  327.       prompt('Can you display ANSI graphics (Y/N) ? ');
  328.       if yn then begin
  329.         thisuser.defaults:=thisuser.defaults+[ansi]; choseansi:=true;
  330.         prompt('Do you have a color monitor (Y/N) ? ');
  331.         if yn then begin thisuser.defaults:=thisuser.defaults+[color]; chosecolor:=true; end else chosecolor:=false;
  332.       end;
  333.     end;
  334.   end;
  335.  
  336.   procedure dopw;
  337.   begin
  338.     tf:=false;
  339.     repeat
  340.     nl; print('Enter a password that you will use to log on again');
  341.     prompt(':'); input(thisuser.pw,20);
  342.     if length(thisuser.pw)<3 then
  343.       print('Must be 3 characters in length.')
  344.     else begin
  345.       prompt('Is this correct (Y/N) ? ');
  346.       tf:=yn;
  347.     end;
  348.     until tf or hangup;
  349.   end;
  350.  
  351.   procedure doitall;
  352.   begin
  353.     showstuff;
  354.     doname;
  355.     dophone;
  356.     dorealname;
  357.     docomputer;
  358.     dosex;
  359.     doage;
  360.     docitystate;
  361.     dostreet;
  362.     dozipcode;
  363.     dojob;
  364.     dowherebbs;
  365.     doansi;
  366.     doscreen;
  367.     dopw;
  368.   end;
  369.  
  370.     begin
  371.       t:=0;
  372.       thisuser.defaults:=[onekey,wordwrap,mmnu];
  373.       doitall;
  374.       repeat
  375.         done:=false;
  376.         cls;
  377.         cl(5);print('User Information Change');
  378.         nl;
  379.         print('[A] System Name - '+thisuser.name);
  380.         print('[B] Real Name   - '+thisuser.realname);
  381.         print('[C] Phone #     - '+thisuser.ph);
  382.         print('[D] Computer    - '+thisuser.computer);
  383.         print('[E] Sex         - '+thisuser.sex);
  384.         print('[F] Age         - '+cstr(thisuser.age));
  385.         print('[G] City, State - '+thisuser.citystate);
  386.         print('[H] Address     - '+thisuser.street);
  387.         print('[I] Zip Code    - '+thisuser.zipcode);
  388.         print('[J] Occupation  - '+thisuser.occupation);
  389.         print('[K] Heard from  - '+thisuser.wherebbs);
  390.         prompt('[L] ANSI        - ');
  391.         if choseansi then prompt('Enabled') else prompt('Disabled');
  392.         if (chosecolor) and (choseansi) then prompt(' w/ Color') else prompt(' w/o Color');
  393.         nl;
  394.         print('[M] Screen size - '+cstr(thisuser.linelen)+'X'+cstr(thisuser.pagelen));
  395.         print('[N] Password    - '+thisuser.pw);
  396.         nl;
  397.         prt('Selection (A-J) to change, or Y when done :');
  398.         onek(c,'ABCDEFGHIJKLMNY');
  399.         case c of
  400.           'A':doname;
  401.           'B':dorealname;
  402.           'C':dophone;
  403.           'D':docomputer;
  404.           'E':dosex;
  405.           'F':doage;
  406.           'G':docitystate;
  407.           'H':dostreet;
  408.           'I':dozipcode;
  409.           'J':dojob;
  410.           'K':dowherebbs;
  411.           'L':doansi;
  412.           'M':doscreen;
  413.           'N':dopw;
  414.           'Y':done:=true;
  415.         end;
  416.     until (done) or (hangup);
  417.   end;
  418.  
  419. function p2:boolean;
  420. var c:char; tries,i,ii,t:integer; s,s1,s2:astr; tf,tf1:boolean; fi:text; pasw:astr;
  421. begin
  422.   tf1:=false;
  423.   if not hangup then begin
  424.     with thisuser do begin
  425.       deleted:=false; waiting:=0; laston:='Never.';loggedon:=0; msgpost:=0;
  426.       emailsent:=0; feedback:=0; linelen:=80; pagelen:=25;
  427.       ontoday:=0; illegal:=0;
  428.       option:=[]; dsl:=systat.newdsl; downloads:=0; uploads:=0;
  429.       ttimeon:=0.0; for i:=1 to 70 do res[i]:=0; note:='';
  430.       filepoints:=systat.newfp;
  431.       dlnscn:=[]; for i:=0 to 39 do dlnscn:=dlnscn+[i];
  432.       forusr:=0;
  433.       sl:=systat.newsl;
  434.       ac:=systat.newac; ar:=systat.newar;
  435.       for i:=1 to 20 do vote[i]:=0; qscan[1].ext:=1;
  436.       qscan[1].ltr:='A'; qscan[1].number:=-32767;
  437.       for i:=2 to 39 do qscan[i]:=qscan[1];
  438.       for i:=1 to 39 do qscn[i]:=true;
  439.       macro[1]:='This is the Ctrl-D Macro';
  440.       macro[2]:='This is the Ctrl-F Macro';
  441.       sbn:=0;
  442.       cols:=dcols;
  443.     end;
  444.     tf:=false;
  445.     nl;prompt('Please wait while I save your record ... ');
  446.     reset(uf);
  447.     ii:=0;
  448.     for i:=1 to filesize(uf)-1 do begin
  449.       seek(uf,i);
  450.       read(uf,user);
  451.       if user.deleted and (ii=0) then ii:=i;
  452.     end;
  453.     if ii=0 then usernum:=filesize(uf) else usernum:=ii;
  454.     seek(uf,usernum);
  455.     write(uf,thisuser);
  456.     close(uf);
  457.     isr(thisuser.name,usernum);
  458.     print('Saved.');nl;
  459.     lastcaller:=nam;
  460.     prompt('Your user number is ');cl(3);PRINT(cstr(usernum));
  461.     prompt('Your password is "');cl(4);PROMPT(thisuser.pw);cl(1);PRINT('".');
  462.     print('Please remember these, you will need them to log on again.');
  463.     nl;prt('Press any key to continue ...');getkey(c);nl;nl;
  464.     nl; nl;
  465.     cls;
  466.     readq(systat.gfilepath+'newuser.inf');
  467.   { if incom then begin}
  468.       topscr;
  469.       if systat.app then begin
  470.         printf(systat.gfilepath+'newapp');
  471.         irt:='New User Application';
  472.       end;
  473.       nl; tf1:=true;
  474.    { end;}
  475.   end;
  476.   p2:=tf1;
  477. end;
  478.  
  479. function rmail(n:integer):astr;
  480. var tu,cn,c:integer; f:file; mr,mr1:mailrec; u:userrec; dm:boolean;
  481. begin
  482.   dm:=true; mailread:=true;
  483.   seek(mailfile,n); read(mailfile,mr); tu:=mr.destin;
  484.   if mr.msg.ext>128 then begin
  485.     for c:=0 to filesize(mailfile)-1 do begin
  486.       seek(mailfile,c); read(mailfile,mr1);
  487.       if (mr1.msg.ltr=mr.msg.ltr) and (mr1.msg.number=mr.msg.number)
  488.       and (mr.msg.ext=mr1.msg.ext) and (c<>n) and (mr1.destin<>-1) then
  489.         dm:=false;
  490.     end;
  491.   end;
  492.   if dm then begin
  493.     assign(f,filename(mr.msg)); {$I-} erase(f); {$I+} cn:=ioresult;
  494.   end;
  495.   mr.destin:=-1; mr.from:=0; mr.mage:=0;
  496.   seek(mailfile,n); write(mailfile,mr);
  497.   reset(uf);
  498.   if (tu>0) and (tu<filesize(uf)) then begin
  499.     seek(uf,tu); read(uf,u); u.waiting:=u.waiting-1;
  500.     seek(uf,tu); write(uf,u);if tu=1 then fw:=fw-1;
  501.   end;
  502.   close(uf);
  503.   rmail:=u.name+' #'+cstr(tu);
  504. end;
  505.  
  506. procedure dsr(uname:astr);
  507. var i,rn:integer; sr:smalrec;
  508. begin
  509.   rn:=0;
  510.   for i:=1 to systat.users do
  511.     if srl[i].name=uname then
  512.       rn:=i;
  513.   if rn<>0 then begin
  514.     for i:=rn to systat.users-1 do srl[i]:=srl[i+1];
  515.     systat.users:=systat.users-1; savesystat;
  516.     rewrite(sf); for i:=0 to systat.users do write(sf,srl[i]); close(sf);
  517.   end else sl1('*** Couldn''t delete "'+uname+'"');
  518. end;
  519.  
  520. procedure ssm(dest:integer; s:astr);
  521. var x:smr; u:userrec;
  522. begin
  523.   {$I-} reset(smf);{$I+}
  524.   if ioresult<>0 then rewrite(smf);
  525.   seek(smf,filesize(smf)); x.msg:=s; x.destin:=dest;
  526.   write(smf,x);
  527.   close(smf);
  528.   reset(uf);
  529.   if (dest>0) and (dest<=filesize(uf)) then begin
  530.     seek(uf,dest); read(uf,u);
  531.     if not (smw in u.option) then
  532.       begin u.option:=u.option+[smw]; seek(uf,dest); write(uf,u); end;
  533.   end;
  534.   close(uf);
  535.   if (dest=usernum) then thisuser.option:=thisuser.option+[smw];
  536. end;
  537.  
  538. procedure rsm;
  539. var x:smr; i:integer;
  540. begin
  541.   {$I-} reset(smf); {$I+}
  542.   if ioresult=0 then begin
  543.     i:=0;
  544.     repeat
  545.       if i<=filesize(smf)-1 then begin seek(smf,i); read(smf,x); end;
  546.       while (i<filesize(smf)-1) and (x.destin<>usernum) do begin
  547.         i:=i+1; seek(smf,i); read(smf,x);
  548.       end;
  549.       if (x.destin=usernum) and (i<=filesize(smf)-1) then begin
  550.         print(x.msg);
  551.         seek(smf,i); x.destin:=-1; write(smf,x);
  552.         smread:=true;
  553.       end;
  554.       i:=i+1;
  555.     until (i>filesize(smf)-1) or hangup;
  556.     close(smf);
  557.   end;
  558. end;
  559.  
  560. procedure chbds;
  561. var i:astr; i1,ii:integer;
  562. begin
  563.   repeat
  564.     nl;nl;CL(4);prompt('Boards to Q-scan marked with ''');cl(8);
  565.     prompt('*');cl(4);print('''');
  566.     nl; for ii:=1 to numboards do if boardac(ii) then begin
  567.       if thisuser.qscn[ii] then begin CL(8);prompt('*  ');end else prompt('   ');
  568.       if boards[ii].key=' ' then BEGIN CL(4);PROMPT(cstr(ii));END else BEGIN CL(4);PROMPT(boards[ii].key);END;
  569.       PROMPT(' ');
  570.       CL(2);PROMPT(' : ');CL(3);PRINT(boards[ii].name);
  571.     end;
  572.     repeat
  573.      prt('Enter board #, Q, or ? :'); input(i,2);
  574.      ii:=value(i);
  575.      if (ii>0) and (ii<=numboards) then
  576.        if (boards[ii].key=' ') and boardac(ii) then thisuser.qscn[ii]:=
  577.          not thisuser.qscn[ii]
  578.        else
  579.      else begin
  580.        i1:=0;
  581.        for ii:=1 to numboards do if boards[ii].key=i then i1:=ii;
  582.        if (i1<>0) and (i<>' ') then if boardac(ii) then
  583.          thisuser.qscn[ii]:=not thisuser.qscn[ii];
  584.      end;
  585.     until (i='Q') or (i='?') or hangup;
  586.   until (i='Q') or hangup;
  587. end;
  588.  
  589. procedure forwardmail;
  590. var u:userrec; n:integer; i:astr; tf:boolean;
  591. begin
  592.   nl;
  593.   print('If you forward your mail, all mail');
  594.   print('addressed to you will go to that person');
  595.   print('Now enter the user''s number, or just');
  596.   print('hit <CR> to deactivate mail forwarding.');
  597.   prt(': '); input(i,4);
  598.   n:=value(i);
  599.   nl;
  600.   if n=0 then begin
  601.     thisuser.forusr:=0;
  602.     print('Forwarding deactivated.');
  603.   end else begin
  604.     reset(uf); tf:=true;
  605.     if n>=filesize(uf) then tf:=false else begin
  606.       seek(uf,n); read(uf,u);
  607.       if u.deleted or (nomail in u.option) then tf:=false;
  608.     end;
  609.     if n=usernum then tf:=false;
  610.     if tf then begin
  611.       thisuser.forusr:=n;
  612.       print('Forwarding set to: '+u.name+' #'+cstr(n));
  613.     end else
  614.       print('Sorry, can''t forward to that user.');
  615.     close(uf);
  616.   end;
  617. end;
  618.  
  619. procedure chcolors;
  620. var mcol,ocol:byte; c,c1,c2:integer; cl:boolean; i:astr; done:boolean; ch:char;
  621.  
  622.   function colo(n:integer):astr;
  623.   begin
  624.     case n of
  625.       0:colo:='Black';
  626.       1:colo:='Blue';
  627.       2:colo:='Green';
  628.       3:colo:='Cyan';
  629.       4:colo:='Red';
  630.       5:colo:='Magenta';
  631.       6:colo:='Yellow';
  632.       7:colo:='White';
  633.     end;
  634.   end;
  635.  
  636.   function dt(n:integer):astr;
  637.   var i:astr;
  638.   begin
  639.     i:=colo(n and 7)+' on '+colo((n shr 4) and 7);
  640.     if (n and 8)<>0 then i:=i+', High Intensity';
  641.     if (n and 128)<>0 then i:=i+', Blinking';
  642.     dt:=i;
  643.   end;
  644.  
  645.   function stf(n:integer):astr;
  646.   var i:astr;
  647.   begin
  648.     case n of
  649.       0:i:='Other';
  650.       1:i:='Default';
  651.       2:i:='Unused';
  652.       3:i:='Yes/No';
  653.       4:i:='Prompts';
  654.       5:i:='Note';
  655.       6:i:='Input line';
  656.       7:i:='Y/N question';
  657.       8:i:='Blinking';
  658.       9:i:='Other';
  659.     end;
  660.     i:=cstr(n)+'. '+i;
  661.     while length(i)<20 do i:=i+' ';
  662.     stf:=i;
  663.   end;
  664.  
  665.   procedure liststf;
  666.   var c:integer;
  667.   begin
  668.     nl;
  669.     for c:=0 to 9 do begin
  670.       prompt(stf(c)); ansic(c); print(dt(thisuser.cols[cl,c]));
  671.     end;
  672.     nl;
  673.   end;
  674.  
  675. begin
  676.   cl:=color in thisuser.defaults;
  677.   nl; if cl then print('Set multiple colors.')
  678.   else print('Set B&W colors.');
  679.   ch:='?'; done:=false;
  680.   repeat
  681.     case ch of
  682.       'Q':done:=true;
  683.       '?':liststf;
  684.       '0'..'9':begin
  685.             nl; print('Current:'); c1:=value(ch); nl;
  686.             prompt(stf(c1)); ansic(c1); print(dt(thisuser.cols[cl,c1]));
  687.             nl; nl; print('Colors:'); nl;
  688.             for c:=0 to 7 do begin
  689.               prompt(cstr(c)+'. '+colo(c)+' '); setc(c); print(colo(c));
  690.             end;
  691.             ocol:=thisuser.cols[cl,c1]; nl;
  692.             prt('Foreground? '); onek(ch,#13+'01234567');
  693.             if ch=#13 then
  694.               mcol:= ocol and 7
  695.             else
  696.               mcol:=value(ch);
  697.             prt('Background? '); onek(ch,#13+'01234567');
  698.             if ch=#13 then
  699.               mcol:=mcol or (ocol and 112)
  700.             else
  701.               mcol:=mcol or (value(ch) shl 4);
  702.             ynq('Intensified? ');
  703.             if yn then mcol:=mcol or 8;
  704.             ynq('Blinking? ');
  705.             if yn then mcol:=mcol or 128;
  706.             nl; nl; prompt(stf(c1)); setc(mcol); print(dt(mcol));
  707.             nl; prompt('Is this correct? ');
  708.             if yn then  thisuser.cols[cl,c1]:=mcol;
  709.           end;
  710.     end;
  711.     if not done then begin
  712.       nl; prt('Colors: 0-9,Q,?  : '); onek(ch,'Q?0123456789');
  713.     end;
  714.   until done or hangup;
  715. end;
  716.  
  717.  
  718. procedure mmacroo;
  719. var mc,c:char; n1,n,mcn,mn:integer; i:astr;
  720. begin
  721.   nl; prt('Which (D,F,Q=Quit) :'); onek(c,'QDF');
  722.   if c<>'Q' then begin
  723.     nl;nl; mc:=c; print('Enter your macro now, Ctrl-'+mc);
  724.     print('to end macro.  79 Character limit.'); nl;if mc='D' then mcn:=4 else mcn:=6;
  725.     n:=1; i:=''; macok:=false; if mc='D' then mn:=1 else mn:=2;
  726.     repeat
  727.       getkey(c);
  728.       if (ord(c)<32) then
  729.         if not((c=#8) or (c=#10) or (c=#13) or (c=#14) or (c=#9) or (c=#16) or
  730.                (c=chr(mcn))) then c:=chr(0);
  731.         if c=#8 then if n<2 then c:=#0 else begin
  732.           oc(#8); oc(' '); oc(#8);
  733.           n:=n-1; c:=#0; if i[n]<#32 then begin
  734.             oc(#8); oc(' '); oc(#8);
  735.           end;
  736.         end;
  737.       if (c<>#0) and (c<>chr(mcn)) then begin
  738.         if (c=#16) or (c=#14) or (c=#9) or (c=#27) or (c=#2) then begin
  739.            cl(3);prompt('^'+chr(ord(c)+64));cl(1);
  740.         end
  741.         else oc(c);
  742.         i[n]:=c; n:=n+1;
  743.         if c=#13 then oc(chr(10));
  744.       end;
  745.     until (c=chr(mcn)) or (n=80) or hangup;
  746.     nl;
  747.     if n=80 then begin
  748.       print('Macro limit is 79 chars.');
  749.       print('That much saved.');
  750.     end;
  751.     i[0]:=chr(n-1);
  752.     print('Ctrl-'+mc+' macro is now:'); prompt('"');
  753.     for n1:=1 to length(i) do
  754.       if i[n1]>=' ' then
  755.         prompt(i[n1])
  756.       else
  757.         begin cl(3);prompt('^'+chr(64+ord(i[n1])));cl(1);end;
  758.     print('"'); dump;
  759.     prompt('Is this what you want? ');
  760.     if yn then begin thisuser.macro[mn]:=i; print('Macro saved.') end
  761.     else print('Macro not saved, then.');
  762.     macok:=true;
  763.   end;
  764. end;
  765.  
  766. procedure readamsg;
  767. var filv:text; i,n:astr; ii:integer; ll:integer; s:array [1..3] of astr; wa:integer;
  768. begin
  769.   nl;nl;assign(filv,systat.gfilepath+'auto.msg'); ll:=0;
  770.   {$I-} reset(filv); {$I+}
  771.     if ioresult<>0 then commandline('No Auto-Message!') else begin
  772.     readln(filv,n);
  773.     if n[1]='@' then
  774.       if postn in seclev[thisuser.sl].anst then n:=copy(n,2,length(n))+' (Posted Anonymously)'
  775.       else n:='Anonymous';
  776.     if n[1]='!' then
  777.       if so then n:=copy(n,2,length(n))+' (Posted Anonymously)'
  778.       else n:='Anonymous';
  779.     cl(5); prompt('Auto message by: '); cl(3); print(n);
  780.     for ii:=1 to 3 do begin
  781.       readln(filv,i); s[ii]:=i; if length(i)>ll then ll:=length(i);
  782.     end;
  783.     close(filv);
  784.   end;
  785.   if okansi then for ii:=1 to ll do prompt('─'); nl;
  786.   for ii:=1 to 3 do begin cl(0); print(s[ii]); end;
  787.   if okansi then for ii:=1 to ll do prompt('─');
  788.   nl;nl;
  789. (*  if systat.quote then begin
  790.     wa:=0;
  791.     systat.quoteptr:=systat.quoteprt+1;
  792.     nl;nl;assign(filv,systat.gfilepath+'quotes.msg'); ll:=0;
  793.     {$I-} reset(filv); {$I+}
  794.     if ioresult<>0 then commandline('Sorry, none available!') else begin
  795.     readln(filv,n);
  796.     if n='' then wa:=wa+1;
  797.     if systat.quoteprt=wa
  798.  
  799.    *)
  800. end;
  801.  
  802.  
  803. procedure logon1;
  804. var fil:file of astr; lo:array[1..8] of astr; num:integer; i:astr; ul:text; c:char;
  805.     abort:boolean; var d1,d2:zlogt; zf:file of zlogt; n,z:integer; C1:INTEGER;
  806.  
  807. begin
  808.   realsl:=thisuser.sl; realdsl:=thisuser.dsl;
  809. { assign(fil,systat.gfilepath+'laston.dat');
  810.   reset(fil); for num:=1 to 8 do read(fil,lo[num]);
  811.   abort:=false;
  812.   cl(5);
  813.   print('Last few callers:'); nl;
  814.   if cs then c1:=0 else c1:=4;
  815.       repeat
  816.         c1:=c1+1;
  817.         if lo[c1]<>'' then printacr(lo[c1],abort,next); i:='';
  818.       until (c1=8) or (abort);
  819.   if (spd<>'KB') then begin
  820.     seek(fil,0); for num:=2 to 8 do write(fil,lo[num]);
  821.     i:=#3+#3+cstr(systat.callernum)+': '+#3+#1+nam;
  822.     write(fil,i);
  823.   end;
  824.   close(fil);} cls;
  825.   cl(3); prompt('You are caller '); cl(2);
  826.   prompt('#'); cl(4); print(cstr(systat.callernum));
  827.   if systat.callernum=32767 then begin
  828.     sysoplog('[> Value passed to number of callers was higher than the maximum');
  829.     sysoplog('   integer value.  Caller number was reset to 1.');
  830.     systat.callernum:=1;
  831.   end;
  832.   if thisuser.laston=date then thisuser.ontoday:=thisuser.ontoday+1
  833.     else thisuser.ontoday:=1;
  834.   if systat.lastdate<>date then begin
  835.     nl; print('Running daily maintance ...');
  836.     commandline('Creating ZLOG.DAT ...');
  837.     assign(zf,systat.gfilepath+'zlog.dat');
  838.     {$I-} reset(zf); {$I+}
  839.     if ioresult<>0 then begin
  840.       rewrite(zf);
  841.       d1.date:='';
  842.       for n:=1 to 97 do
  843.         write(zf,d1);
  844.     end;
  845.     d1.date:=systat.lastdate;
  846.     d1.active:=systat.activetoday;
  847.     d1.calls:=systat.callstoday;
  848.     d1.post:=systat.msgposttoday;
  849.     d1.email:=systat.emailtoday;
  850.     d1.fback:=systat.fbacktoday;
  851.     d1.up:=systat.uptoday;
  852.     for n:=95 downto 0 do begin
  853.       seek(zf,n);
  854.       read(zf,d2);
  855.       seek(zf,n+1);
  856.       write(zf,d2);
  857.     end;
  858.     seek(zf,0);
  859.     write(zf,d1);
  860.     close(zf);
  861.     systat.lastdate:=date;
  862.     assign(ul,systat.gfilepath+'ysysop.log'); {$I-} erase(ul); {$I+} num:=ioresult;
  863.     sl1('');
  864.     sl1('Total Time On........: '+ cstr(systat.activetoday));
  865.     sl1('Calls Today..........: '+cstr(systat.callstoday));
  866.     sl1('Messages posted today: '+cstr(systat.msgposttoday));
  867.     sl1('Files u/l today......: '+cstr(systat.uptoday));
  868.     close(sysopf);
  869.     commandline('Patching System Log ...');
  870.     rename(sysopf,systat.gfilepath+'ysysop.log');
  871.     assign(sysopf,systat.gfilepath+'sysop.log');
  872.     rewrite(sysopf); writeln(sysopf); close(sysopf); append(sysopf);
  873.     assign(ul,systat.gfilepath+'user.log'); rewrite(ul); writeln(ul); close(ul);
  874.     with systat do begin
  875.       activetoday:=0; callstoday:=0; msgposttoday:=0; emailtoday:=0;
  876.       fbacktoday:=0; uptoday:=0;
  877.     end;
  878.     nl;
  879.     enddayf:=true;
  880.   end;
  881. end;
  882.  
  883. function vote1x(qnum:integer; var vd:vdatar):boolean;
  884. var cv,tv,ii:integer; ij,i,i1,i2:astr; c:char; abort,next,bb:boolean;
  885. begin
  886.   i2:='                                  '; cls; bb:=false;
  887.   if vd.numa=0 then print('Inactive question.') else begin
  888.     cl(5);PROMPT('Question ');cl(2);PROMPT('#');cl(4);PRINT(cstr(qnum)+':');
  889.     nl; cl(7);print(vd.question); nl;
  890.     tv:=0; for ii:=1 to vd.numa do tv:=tv+vd.answ[ii].numres;
  891.     prompt('Users voting: ');cl(3);print(ctp(tv,systat.users)); if tv=0 then tv:=1;
  892.     nl; CL(0);print('0:No Comment');
  893.     ij:='Q0';
  894.     ii:=1; abort:=false;
  895.     while (ii<=vd.numa) do begin
  896.       ij:=ij+cstr(ii);
  897.       i1:=copy(vd.answ[ii].ans,1,25);
  898.       i1:=i1+copy(i2,1,25-length(i1))+#3+#2+' :';
  899.       i:=copy(cstr(vd.answ[ii].numres),1,3);
  900.       i1:=i1+copy(i2,1,3-length(i))+i+' '+ctp(vd.answ[ii].numres,tv);
  901.       printacr(#3+#4+cstr(ii)+#3+#7+':'+#3+#3+i1,abort,next);
  902.       ii:=ii+1;
  903.     end;
  904.     nl;nl;
  905.     i:='Your vote: '+vd.answ[thisuser.vote[qnum]].ans; print(i);
  906.     if not(rvoting in thisuser.ac) and (not hangup) and (thisuser.sl>10) then begin
  907.       ynq('Change it? '); if yn then begin
  908.         nl; prt('Which number (0-'+cstr(vd.numa)+') ? ');
  909.         onek(i[1],ij);
  910.         i[0]:=#1; ii:=value(i); if (i<>'') and (ii>=0) and (ii<=vd.numa) then begin
  911.           if thisuser.vote[qnum]<>0 then
  912.             vd.answ[thisuser.vote[qnum]].numres:=vd.answ[thisuser.vote[qnum]].numres-1;
  913.           thisuser.vote[qnum]:=ii;
  914.           if ii<>0 then vd.answ[ii].numres:=vd.answ[ii].numres+1;
  915.           bb:=true;
  916.           cls; print('Current Standings for question #'+cstr(qnum)+' : '); nl; print(vd.question); nl;
  917.           tv:=0; for ii:=1 to vd.numa do tv:=tv+vd.answ[ii].numres;
  918.           print('Users voting: '+ctp(tv,systat.users)); nl; if tv=0 then tv:=1;
  919.           abort:=false; ii:=1;
  920.           while (ii<=vd.numa) and (not abort) do begin
  921.             i1:=copy(vd.answ[ii].ans,1,25);
  922.             i1:=i1+copy(i2,1,25-length(i1))+' '+#3+#2+':';
  923.             i:=copy(cstr(vd.answ[ii].numres),1,3);
  924.             i1:=i1+copy(i2,1,3-length(i))+i+' '+ctp(vd.answ[ii].numres,tv);
  925.             if ii=thisuser.vote[qnum] then printacr(#3+#8+'*'+#3+#4+cstr(ii)+#3+#7+':'+#3+#3+i1,abort,next) else
  926.             printacr(' '+#3+#4+cstr(ii)+#3+#7+':'+#3+#3+i1,abort,next);
  927.             ii:=ii+1;
  928.           end;
  929.         end;
  930.       end;
  931.     end;
  932.     dump;
  933.   end;
  934.   vote1x:=bb;
  935. end;
  936.  
  937. procedure wmsg;
  938. var filvar:text; ii:integer; li:array[1..3] of astr; n:astr;
  939. begin
  940.   nl;print('Enter three lines:'); nl;
  941.   for ii:=1 to 3 do begin
  942.     cl(9); prt(cstr(ii)+':'); cl(0); inputl(li[ii],77);
  943.   end;
  944.   n:=nam; if pana in seclev[thisuser.sl].anst then begin
  945.     nl; ynq('Anonymous? ');
  946.     if yn then
  947.       if realsl=255 then
  948.         n:='!'+n
  949.       else
  950.         n:='@'+n;
  951.   end;
  952.   prompt('Is this alright? ');
  953.   if yn then begin
  954.     assign(filvar,systat.gfilepath+'auto.msg');
  955.     rewrite(filvar); writeln(filvar,n);
  956.     for ii:=1 to 3 do writeln(filvar,li[ii]);
  957.     close(filvar); print('Auto-message saved.');
  958.     if (realsl<>255) or incom then begin
  959.       sysoplog('Changed Auto-message');
  960.       for ii:=1 to 3 do sysoplog('   '+li[ii]);
  961.     end;
  962.   end else prompt('Nothing saved.');
  963. end;
  964.  
  965. procedure smail2(na:emary);
  966. var f:messages; a:anontyp; i:astr; c1,t,cp,e:integer; mr:mailrec; us:userrec;
  967. begin
  968.   if na[1]<>0 then begin
  969.     a:=no; if sanm in seclev[thisuser.sl].anst then a:=yes;
  970.     irt:='Mass Mail.';
  971.     inmsg(f,a,i,false,true);
  972.     if f.ext<>0 then begin
  973.       {$I-} reset(mailfile); {$I+}
  974.       if (ioresult<>0) then
  975. {! 45. IOR^esult now returns different values corresponding to DOS error codes.}
  976.         rewrite(mailfile);
  977.       e:=filesize(mailfile);
  978.       if e=0 then cp:=0 else begin
  979.         cp:=-1; t:=e-1;
  980.         seek(mailfile,t); read(mailfile,mr);
  981.         while (t>0) and (mr.destin=-1) do begin
  982.           t:=t-1; seek(mailfile,t); read(mailfile,mr);
  983.         end;
  984.         cp:=t+1;
  985.       end;
  986.       seek(mailfile,cp);
  987.       mr.msg:=f; if lan then mr.from:=-usernum else mr.from:=usernum;
  988.       mr.title:=i; mr.date:=daynum(date);
  989.       mr.mage:=maxage(thisuser.sl);
  990.       c1:=1; nl; print('Sending mail to:');
  991.       while (na[c1]<>0) and (c1<=20) do begin
  992.         mr.destin:=na[c1];
  993.         write(mailfile,mr);
  994.         if na[c1]=1 then begin
  995.           thisuser.feedback:=thisuser.feedback+1;
  996.           ftoday:=ftoday+1;
  997.           fw:=fw+1;
  998.         end else begin
  999.           thisuser.emailsent:=thisuser.emailsent+1;
  1000.           etoday:=etoday+1;
  1001.         end;
  1002.         seek(uf,na[c1]); read(uf,us);
  1003.         us.waiting:=us.waiting+1; seek(uf,na[c1]); write(uf,us);
  1004.         if na[c1]=usernum then thisuser.waiting:=thisuser.waiting+1;
  1005.         i:=us.name+' #'+cstr(na[c1]);
  1006.         sysoplog('Mult-mail sent to '+i);
  1007.         print('  '+i);
  1008.         c1:=c1+1;
  1009.       end;
  1010.       close(mailfile); topscr;
  1011.     end;
  1012.   end;
  1013. end;
  1014.  
  1015. procedure initp1;
  1016. var a:integer; filv:text; i:astr; d:astr;
  1017. begin
  1018.   wantout:=true; lastcaller:='No one';
  1019.   ldate:=daynum(date);
  1020.   ch:=false; lil:=0; thisuser.pagelen:=20; buf:=''; chatcall:=false;
  1021.   spd:=''; lastname:=''; ll:=''; i:=''; chatr:=''; textcolor(0);
  1022.   cursoroff; textcolor(0);
  1023.   assign(systatf,'status.dat');
  1024.   reset(systatf); read(systatf,systat);close(systatf);
  1025.   if systat.users>200 then delay(100) else delay(900);
  1026.   assign(uf,systat.gfilepath+'user.lst');
  1027.   assign(sf,systat.gfilepath+'names.lst');
  1028.   assign(sysopf,systat.gfilepath+'sysop.log');
  1029.   {$I-} append(sysopf); {$I+}
  1030.   if ioresult<>0 then begin
  1031.     rewrite(sysopf);
  1032.     writeln(sysopf);
  1033.   end;
  1034.   assign(mailfile,systat.gfilepath+'email.dat');
  1035.   iport;
  1036.   assign(smf,systat.gfilepath+'shortmsg.dat');
  1037.   assign(cf,systat.gfilepath+'chat.msg'); cfo:=false;
  1038.   reset(sf); for a:=0 to systat.users do read(sf,srl[a]); close(sf);
  1039.   for a:=systat.users+1 to maxusers do begin
  1040.   srl[a].name:=''; srl[a].number:=0; end;
  1041.   assign(ulf,systat.gfilepath+'uploads.dat');
  1042.   reset(ulf); maxulb:=-1;
  1043.   while not eof(ulf) do begin maxulb:=maxulb+1; read(ulf,uboards[maxulb]); end;
  1044.   close(ulf);
  1045.   hangup:=false;
  1046.   incom:=false; outcom:=false;
  1047.   echo:=true; doneday:=false;
  1048.   assign(bf,systat.gfilepath+'boards.dat');
  1049.   reset(bf);
  1050.   numboards:=filesize(bf);
  1051. { assign(xp,systat.gfilepath+'expro.dat');
  1052.   reset(xp); numprotocals:=-1;
  1053.   while not eof(xp) do begin numprotocals:=numprotocals+1; read(xp,protocals[numprotocals]); end;
  1054.   close(xp);}
  1055.   for a:=1 to numboards do
  1056.     read(bf,boards[a]);
  1057.   close(bf);
  1058.   assign(slf,systat.gfilepath+'seclev.dat'); reset(slf); for a:=0 to 255 do read(slf,seclev[a]);
  1059.   close(slf);
  1060.   assign(uf,systat.gfilepath+'user.lst');
  1061.   reset(uf);
  1062.   if filesize(uf)>1 then begin seek(uf,1); read(uf,user); fw:=user.waiting;
  1063.   end else fw:=0;
  1064.   close(uf); textcolor(7); first_time:=true;
  1065.   sl1(#3+#9+'-------------------->'+#3+#3+'System booted at '+time+#3+#9+'<-----------------');
  1066. end;
  1067.  
  1068. procedure getcallera(var c:char; var chkcom:boolean);
  1069. var rl,rl1:real; i:astr;
  1070. begin
  1071.     if commpressed then c:=cinkey;
  1072.     if c='2' then begin
  1073.       chkcom:=true; rl:=timer; star;
  1074.       while (c<>#13) and (abs(rl-timer)<0.2) do c:=cinkey;
  1075.     end;
  1076.     if chkcom then begin
  1077.       if (answerbaud<2) or (not returna) then pr(systat.answer);
  1078.       cursoron;
  1079.       writeln('Answering Phone-Force: [1] 300 [2] 1200 [3] 2400 [4] 4800 [5] 9600 [H] Abort');
  1080.       delay(50); dump; rl1:=timer; i:=''; rl:=0.0;
  1081.       repeat
  1082.         chkcom:=false;
  1083.         if answerbaud>2 then begin
  1084.           spd:=cstr(answerbaud);
  1085.           chkcom:=true;
  1086.           answerbaud:=0;
  1087.         end;
  1088.         if keypressed then begin c:=readkey;
  1089.           if upcase(c)='H' then begin
  1090.             chkcom:=true;
  1091.             pr('A');
  1092.             delay(200);
  1093.             dump;
  1094.           end;
  1095.           case c of
  1096.             '1':spd:='300';
  1097.             '2':spd:='1200';
  1098.             '3':spd:='2400';
  1099.             '4':spd:='4800';
  1100.             '5':spd:='9600';
  1101.           end;
  1102.           chkcom:=true;
  1103.         end;
  1104.         c:=cinkey;
  1105.         if (rl<>0.0) and (abs(rl-timer)>2.0) and (c=#0) then c:=#13;
  1106.         if (c<#32) and (c<>#13) then c:=#0;
  1107.         if c<>#0 then
  1108.           if c<>#13 then begin i:=i+c; rl:=timer; end else begin
  1109.             if i=cstr(systat.result300) then begin spd:='300'; chkcom:=true; end;
  1110.             if i=cstr(systat.result1200) then begin spd:='1200'; chkcom:=true; end;
  1111.             if i=cstr(systat.result2400) then begin spd:='2400'; chkcom:=true; end;
  1112.             if i=cstr(systat.result4800) then begin spd:='4800'; chkcom:=true; end;
  1113.             if i=cstr(systat.result9600) then begin spd:='9600'; chkcom:=true; end;
  1114.             if i=cstr(systat.nocarrier) then chkcom:=true;
  1115.             rl:=0.0;
  1116.           end;
  1117.         if c=#13 then i:='';
  1118.         if abs(timer-rl1)>45.0 then chkcom:=true;
  1119.       until chkcom;
  1120.       if abs(timer-rl1)>45.0 then begin c:='X'; lmsg:=true; end;
  1121.       clrscr;
  1122.     end;
  1123.     if spd<>'KB' then incom:=true;
  1124. end;
  1125. END.