home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 189.img / TCS120S.ZIP / MAINR1.PAS < prev    next >
Pascal/Delphi Source File  |  1989-03-04  |  5KB  |  190 lines
  1. {$R-,S-,I-,D-,F+,V-,B-,N-,L+ }
  2. {$M 65500,0,0 }
  3.  
  4. unit mainr1;
  5.  
  6. interface
  7.  
  8. uses gentypes,configrt,textret,gensubs,subs1,userret,statret;
  9.  
  10. procedure showinfoforms (uname:mstr);  { UNAME='' shows all }
  11. function validfname (name:lstr):boolean;
  12. function searchboard (name:sstr):integer;
  13. function numfeedback:integer;
  14. procedure trimmessage (var m:message);
  15.  
  16. implementation
  17.  
  18. procedure showinfoforms (uname:mstr);  { UNAME='' shows all }
  19. var lnum,un,cnt:integer;
  20.     u:userrec;
  21.  
  22.   procedure showone (yiyiyi:integer);
  23.   var ff:text;
  24.       fn:lstr;
  25.       me:message;
  26.       k:char;
  27.       found:boolean;
  28.   begin
  29.     if (yiyiyi<1) or (yiyiyi>5) then exit;
  30.     if yiyiyi=1 then begin
  31.      if u.infoform1=-1 then begin
  32.        writeln (^B'That user has no Information Form #1.');
  33.        exit
  34.      end;
  35.     end;
  36.     if yiyiyi=2 then begin
  37.      if u.infoform2=-1 then begin
  38.        writeln (^B'That user has no Information Form #2.');
  39.        exit
  40.      end;
  41.     end;
  42.     if yiyiyi=3 then begin
  43.      if u.infoform3=-1 then begin
  44.        writeln (^B'That user has no Information Form #3.');
  45.        exit
  46.      end;
  47.     end;
  48.     if yiyiyi=4 then begin
  49.      if u.infoform4=-1 then begin
  50.        writeln (^B'That user has no Information Form #4.');
  51.        exit
  52.      end;
  53.     end;
  54.     if yiyiyi=5 then begin
  55.      if u.infoform5=-1 then begin
  56.        writeln (^B'That user has no Information Form #5.');
  57.        exit
  58.      end;
  59.     end;
  60.     fn:=textfiledir+'Infoform.'+strr(yiyiyi);
  61.     assign (ff,fn);
  62.     reset (ff);
  63.     if ioresult<>0 then begin
  64.       close (ff);
  65.       lnum:=ioresult;
  66.       writeln (^B'No Information Form is present for #',yiyiyi,'.');
  67.       exit
  68.     end;
  69.     if yiyiyi=1 then begin
  70.      reloadtext (u.infoform1,me);
  71.     end;
  72.     if yiyiyi=2 then begin
  73.      reloadtext (u.infoform2,me);
  74.     end;
  75.     if yiyiyi=3 then begin
  76.      reloadtext (u.infoform3,me);
  77.     end;
  78.     if yiyiyi=4 then begin
  79.      reloadtext (u.infoform4,me);
  80.     end;
  81.     if yiyiyi=5 then begin
  82.      reloadtext (u.infoform5,me);
  83.     end;
  84.     writeln (^M,me.text[1],^M^M);
  85.     lnum:=1;
  86.     while not (break or eof(ff)) do begin
  87.       read (ff,k);
  88.       if k='*'
  89.         then if lnum>me.numlines
  90.           then writeln ('No answer')
  91.           else begin
  92.             lnum:=lnum+1;
  93.             writeln (me.text[lnum])
  94.           end
  95.         else write (k)
  96.     end;
  97.     textclose (ff)
  98.   end;
  99.  
  100. begin
  101.   if uname='' then begin
  102.     writeln (^B^M^S'          Showing All Info-Forms'^R);
  103.     writeln;
  104.     seek (ufile,1);
  105.     for cnt:=1 to numusers do begin
  106.       read (ufile,u);
  107.       writeln (^M^M,u.handle,^M);
  108.       if u.infoform1<>-1 then showone (1);
  109.       if u.infoform2<>-1 then showone (2);
  110.       if u.infoform3<>-1 then showone (3);
  111.       if u.infoform4<>-1 then showone (4);
  112.       if u.infoform5<>-1 then showone (5);
  113.       if xpressed then exit
  114.     end
  115.   end else begin
  116.     un:=lookupuser (uname);
  117.     if un=0 then writeln (^B'No such user.') else begin
  118.       seek (ufile,un);
  119.       read (ufile,u);
  120.       showone (1);
  121.       showone (2);
  122.       showone (3);
  123.       showone (4);
  124.       showone (5)
  125.     end
  126.   end
  127. end;
  128.  
  129. function validfname (name:lstr):boolean;
  130. const invalid:set of char=[#0..#31,'"',']','[',':','\','>','<','/','?','*',
  131.   '|','+','=',';', ',' ,#127..#255];
  132. var p,cnt:integer;
  133.     k:char;
  134.     dotfound:boolean;
  135. begin
  136.   validfname:=false;
  137.   dotfound:=false;
  138.   if (length(name)>12) or (length(name)<1) then exit;
  139.   for p:=1 to length(name) do begin
  140.     k:=upcase(name[p]);
  141.     if k in invalid then exit;
  142.     if k='.' then begin
  143.       if dotfound then exit;
  144.       dotfound:=true;
  145.       if (p<length(name)-3) or (p=1) then exit
  146.     end
  147.   end;
  148.   validfname:=not devicename(name)
  149. end;
  150.  
  151. function searchboard (name:sstr):integer;
  152. var bi:sstr;
  153.     cnt:integer;
  154. begin
  155.   seek (bifile,0);
  156.   for cnt:=0 to filesize(bifile)-1 do begin
  157.     read (bifile,bi);
  158.     if match(bi,name) then begin
  159.       searchboard:=cnt;
  160.       exit
  161.     end
  162.   end;
  163.   searchboard:=-1
  164. end;
  165.  
  166. function numfeedback:integer;
  167. var ffile:file of mailrec;
  168. begin
  169.   assign (ffile,'Feedback');
  170.   reset (ffile);
  171.   if ioresult<>0 then begin
  172.     numfeedback:=0;
  173.     rewrite (ffile)
  174.   end else numfeedback:=filesize (ffile);
  175.   close (ffile)
  176. end;
  177.  
  178. procedure trimmessage (var m:message);
  179. var cnt:integer;
  180. begin
  181.   for cnt:=1 to m.numlines do
  182.     while m.text[cnt][length(m.text[cnt])]=' ' do
  183.       m.text[cnt][0]:=pred(m.text[cnt][0]);
  184.   while (m.numlines>0) and (m.text[m.numlines]='') do
  185.     m.numlines:=m.numlines-1
  186. end;
  187.  
  188. begin
  189. end.
  190.