home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 276.img / FORUM21S.ZIP / MAINR2.PAS < prev    next >
Pascal/Delphi Source File  |  1988-02-13  |  4KB  |  195 lines
  1. {$R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ }
  2. {$M 65500,0,0 }
  3.  
  4. unit mainr2;
  5.  
  6. interface
  7.  
  8. uses gentypes,modem,subs1,subs2,statret,configrt,overret1,
  9.      textret,userret,mailret,lineedit,ansiedit,mainr1;
  10.  
  11. function reedit (var m:message; g:boolean):boolean;
  12. function editor (var m:message; gettitle:boolean):integer;
  13. procedure seekbdfile (n:integer);
  14. procedure writebdfile (var bd:boardrec);
  15. procedure writecurboard;
  16. procedure addnews;
  17. procedure sendmailto (uname:mstr; anon:boolean);
  18. procedure addfeedback (var m:mailrec);
  19. procedure hangupmodem;
  20. procedure setupmodem;
  21. procedure dialnumber (num:lstr);
  22. procedure disconnect;
  23.  
  24. implementation
  25.  
  26. function reedit (var m:message; g:boolean):boolean;
  27. begin
  28.   if fseditor in urec.config
  29.     then reedit:=ansireedit (m,g)
  30.     else reedit:=linereedit (m,g);
  31.   trimmessage (m)
  32. end;
  33.  
  34. function editor (var m:message; gettitle:boolean):integer;
  35.  
  36.   function getthetitle:boolean;
  37.   begin
  38.     m.anon:=false;
  39.     getthetitle:=true;
  40.     if gettitle then begin
  41.       buflen:=30;
  42.       writestr (^M^M'Title: &');
  43.       if length(input)=0 then begin
  44.         getthetitle:=false;
  45.         exit
  46.       end;
  47.       m.title:=input;
  48.       if ulvl>=anonymouslevel then begin
  49.         buflen:=1;
  50.         writestr ('Anonymous? *');
  51.         m.anon:=yes
  52.       end
  53.     end;
  54.   end;
  55.  
  56. begin
  57.   editor:=-1;
  58.   m.numlines:=0;
  59.   if getthetitle
  60.     then if reedit(m,gettitle)
  61.       then editor:=maketext(m)
  62. end;
  63.  
  64. procedure seekbdfile (n:integer);
  65. begin
  66.   seek (bdfile,n);
  67.   seek (bifile,n); che
  68. end;
  69.  
  70. procedure writebdfile (var bd:boardrec);
  71. begin
  72.   write (bdfile,bd);
  73.   write (bifile,bd.shortname)
  74. end;
  75.  
  76. procedure writecurboard;
  77. begin
  78.   seekbdfile (curboardnum);
  79.   writebdfile (curboard); che
  80. end;
  81.  
  82. procedure addnews;
  83. var newline,r:integer;
  84.     nfile:file of integer;
  85.     numnews,cnt:integer;
  86.     m:message;
  87. begin
  88.   writehdr ('Adding to the news');
  89.   newline:=editor (m,false);
  90.   if newline<0 then exit;
  91.   r:=ioresult;
  92.   assign (nfile,'News');
  93.   reset (nfile);
  94.   r:=ioresult;
  95.   if r<>0
  96.     then
  97.       begin
  98.         if r<>1 then writeln ('Error ',r,' opening news file; recreating.');
  99.         rewrite (nfile);
  100.         write (nfile,newline);
  101.         numnews:=0
  102.       end
  103.     else
  104.       begin
  105.         numnews:=filesize(nfile);
  106.         for cnt:=numnews-1 downto 0 do
  107.           begin
  108.             seek (nfile,cnt);
  109.             read (nfile,r);
  110.             seek (nfile,cnt+1);
  111.             write (nfile,r)
  112.           end;
  113.         che;
  114.         seek (nfile,0);
  115.         write (nfile,newline)
  116.       end;
  117.   writeln ('News added.  News items: ',numnews+1);
  118.   writelog (2,1,'');
  119.   close (nfile)
  120. end;
  121.  
  122. procedure sendmailto (uname:mstr; anon:boolean);
  123. var un:integer;
  124.     me:message;
  125.     line:integer;
  126.     u:userrec;
  127. begin
  128.   if length(uname)=0 then exit;
  129.   un:=lookupuser (uname);
  130.   if un=0 then writeln ('User not found.') else begin
  131.     if anon and (ulvl<sysoplevel) then uname:=anonymousstr;
  132.     seek (ufile,un);
  133.     read (ufile,u);
  134.     if u.emailannounce>-1 then begin
  135.       writehdr (u.handle+'''s Announcement');
  136.       printtext (u.emailannounce)
  137.     end;
  138.     writehdr ('Sending mail to '+uname);
  139.     line:=editor(me,true);
  140.     if line>=0 then addmail (un,line,me)
  141.   end
  142. end;
  143.  
  144. procedure addfeedback (var m:mailrec);
  145. var ffile:file of mailrec;
  146. begin
  147.   assign (ffile,'Feedback');
  148.   reset (ffile);
  149.   if ioresult<>0 then begin
  150.     close (ffile);
  151.     rewrite (ffile)
  152.   end;
  153.   seek (ffile,filesize(ffile));
  154.   write (ffile,m);
  155.   close (ffile);
  156.   newfeedback:=newfeedback+1;
  157. end;
  158.  
  159. procedure hangupmodem;
  160. var tries:integer;
  161. begin
  162.   tries:=0;
  163.   while carrier and (tries<5) do begin
  164.     hangup;
  165.     sendmodemstr (modemhangupstr,false);
  166.     tries:=tries+1
  167.   end;
  168.   setparam (usecom,baudrate,parity)
  169. end;
  170.  
  171. procedure setupmodem;
  172. begin
  173.   if carrier then exit;
  174.   writeln (usr,^M^J'Setting up the modem...'^M^J^J);
  175.   sendmodemstr (modemsetupstr,true);
  176.   if hashayes then sendmodemstr ('|~~ATS0=0M0Q0V0X1|',true)
  177. end;
  178.  
  179. procedure dialnumber (num:lstr);
  180. begin
  181.   sendmodemstr (modemdialprefix+num+modemdialsuffix,true)
  182. end;
  183.  
  184. procedure disconnect;
  185. begin
  186.   if online then hangupmodem;
  187.   online:=true;
  188.   writelog (0,3,'');
  189.   if (unum>0) and not disconnected then updateuserstats (true);
  190.   disconnected:=true
  191. end;
  192.  
  193. begin
  194. end.
  195.