home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 276.img / FORUM21S.ZIP / MAINR1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-02-13  |  3.2 KB  |  142 lines
  1. {$R-,S-,I-,D-,T-,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;
  23.   var ff:text;
  24.       fn:lstr;
  25.       me:message;
  26.       k:char;
  27.       found:boolean;
  28.   begin
  29.     if u.infoform=-1 then begin
  30.       writeln (^B'That user has no information form.');
  31.       exit
  32.     end;
  33.     fn:=textfiledir+'infoform';
  34.     assign (ff,fn);
  35.     reset (ff);
  36.     if ioresult<>0 then begin
  37.       close (ff);
  38.       lnum:=ioresult;
  39.       writeln (^B'No information form is present.');
  40.       exit
  41.     end;
  42.     reloadtext (u.infoform,me);
  43.     writeln (^M,me.text[1],^M^M);
  44.     lnum:=1;
  45.     while not (break or eof(ff)) do begin
  46.       read (ff,k);
  47.       if k='*'
  48.         then if lnum>me.numlines
  49.           then writeln ('No answer')
  50.           else begin
  51.             lnum:=lnum+1;
  52.             writeln (me.text[lnum])
  53.           end
  54.         else write (k)
  55.     end;
  56.     textclose (ff)
  57.   end;
  58.  
  59. begin
  60.   if uname='' then begin
  61.     writeln (^B^M'          Showing All Forms');
  62.     seek (ufile,1);
  63.     for cnt:=1 to numusers do begin
  64.       read (ufile,u);
  65.       if u.infoform<>-1 then begin
  66.         writeln (^M^M,u.handle,^M);
  67.         showone
  68.       end;
  69.       if xpressed then exit
  70.     end
  71.   end else begin
  72.     un:=lookupuser (uname);
  73.     if un=0 then writeln (^B'No such user.') else begin
  74.       seek (ufile,un);
  75.       read (ufile,u);
  76.       showone
  77.     end
  78.   end
  79. end;
  80.  
  81. function validfname (name:lstr):boolean;
  82. const invalid:set of char=[#0..#31,'"',']','[',':','\','>','<','/','?','*',
  83.   '|','+','=',';', ',' ,#127..#255];
  84. var p,cnt:integer;
  85.     k:char;
  86.     dotfound:boolean;
  87. begin
  88.   validfname:=false;
  89.   dotfound:=false;
  90.   if (length(name)>12) or (length(name)<1) then exit;
  91.   for p:=1 to length(name) do begin
  92.     k:=upcase(name[p]);
  93.     if k in invalid then exit;
  94.     if k='.' then begin
  95.       if dotfound then exit;
  96.       dotfound:=true;
  97.       if (p<length(name)-3) or (p=1) then exit
  98.     end
  99.   end;
  100.   validfname:=not devicename(name)
  101. end;
  102.  
  103. function searchboard (name:sstr):integer;
  104. var bi:sstr;
  105.     cnt:integer;
  106. begin
  107.   seek (bifile,0);
  108.   for cnt:=0 to filesize(bifile)-1 do begin
  109.     read (bifile,bi);
  110.     if match(bi,name) then begin
  111.       searchboard:=cnt;
  112.       exit
  113.     end
  114.   end;
  115.   searchboard:=-1
  116. end;
  117.  
  118. function numfeedback:integer;
  119. var ffile:file of mailrec;
  120. begin
  121.   assign (ffile,'Feedback');
  122.   reset (ffile);
  123.   if ioresult<>0 then begin
  124.     numfeedback:=0;
  125.     rewrite (ffile)
  126.   end else numfeedback:=filesize (ffile);
  127.   close (ffile)
  128. end;
  129.  
  130. procedure trimmessage (var m:message);
  131. var cnt:integer;
  132. begin
  133.   for cnt:=1 to m.numlines do
  134.     while m.text[cnt][length(m.text[cnt])]=' ' do
  135.       m.text[cnt][0]:=pred(m.text[cnt][0]);
  136.   while (m.numlines>0) and (m.text[m.numlines]='') do
  137.     m.numlines:=m.numlines-1
  138. end;
  139.  
  140. begin
  141. end.
  142.