home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 341.img / TCS161S.ZIP / PREPARE.PAS < prev    next >
Pascal/Delphi Source File  |  1989-10-07  |  3KB  |  125 lines
  1. program NetPrep;
  2.  
  3. {$R-,S-,I-,D-,F+,V-,B-,N-,O+ }
  4. {$M 65500,0,0 }
  5.  
  6.  
  7. uses crt,dos,gentypes,gensubs,subs1,textret;
  8.  
  9. const msgbreak='=-LBTVTKSSTMB-=';
  10.  
  11.  
  12. var outf:text; ct,kt:integer; b1:bulrec; bf:file of bulrec; wrk:lstr;
  13.     nummess,iocode,numlines:integer; textf:message;
  14.  
  15.  
  16. procedure reloadtext (sector:integer; var q:message);
  17. var k:char;
  18.     sectorptr,tmp,n:integer;
  19.     buff:buffer;
  20.     x:boolean;
  21.  
  22.   procedure setbam (sector,val:integer);
  23.   begin
  24.     seek (mapfile,sector);
  25.     write (mapfile,val)
  26.   end;
  27.  
  28.   procedure chk;
  29.   begin
  30.     iocode:=ioresult;
  31.     if iocode<>0 then writeln ('(Error ',iocode,' reading message)')
  32.   end;
  33.  
  34. begin
  35.   sectorptr:=32767;
  36.   n:=1;
  37.   q.text[1]:='';
  38.   repeat
  39.     if sectorptr>sectorsize then begin
  40.       if sector<0 then exit;
  41.       seek (tfile,sector); chk;
  42.       read (tfile,buff); chk;
  43.       seek (mapfile,sector); chk;
  44.       read (mapfile,tmp); chk;
  45.       if tmp=-2 then begin
  46.         tmp:=-1;
  47.         seek (mapfile,sector); chk;
  48.         write (mapfile,tmp); chk;
  49.       end;
  50.       sector:=tmp;
  51.       sectorptr:=1
  52.     end;
  53.     k:=buff[sectorptr];
  54.     case k of
  55.       #0,#10:;
  56.       #13:if n>=maxmessagesize
  57.             then k:=#0
  58.             else begin
  59.               n:=n+1;
  60.               q.text[n]:=''
  61.             end
  62.       else q.text[n]:=q.text[n]+k
  63.     end;
  64.     sectorptr:=sectorptr+1
  65.   until k=#0;
  66.   q.numlines:=n;
  67.   chk
  68. end;
  69.  
  70.  
  71. procedure dumptext (sector:integer);
  72. var q:message;
  73.     x,bub,done:boolean;
  74.     n,m,t,w,b,y,mm,i,apexiscool,e:integer;
  75.     p:byte;
  76.     s,a,cornerstone,sunbane:string;
  77.     cs,css,keithmillerisafag:char;
  78.     kay,thegog:char;
  79. begin
  80.   reloadtext (sector,q);
  81.   writeln (^B);
  82.   n:=1;
  83.    repeat
  84.     if length(q.text[n])>0 then begin
  85.     writeln(outf,q.text[n]);
  86.     inc(n);
  87.     end;
  88.    until (break or (n>q.numlines));
  89.   writeln (^B^M);
  90. end;
  91.  
  92.  
  93. begin
  94.     assign(outf,'NETMAIL.MSG'); rewrite(outf); clrscr;
  95.     writeln('TCS Net-Mail Collection Utility v1.0');
  96.     writeln;
  97.     assign(bf,'1.bul'); reset(bf); nummess:=filesize(bf);
  98.     writeln('1] Switching to area #1.   Number of Msgs: ',nummess);
  99.     writeln('2] Looking for today''s bulletins.'); writeln;
  100.  
  101.     for ct:=0 to nummess-1 do begin
  102.             seek(bf,ct);
  103.             read(bf,b1);
  104.             writeln(ct,'.  ',b1.title);
  105.             writeln(outf,b1.title);
  106.  
  107.             if b1.anon then b1.leftby:='(Anonymous)';
  108.             writeln(outf,b1.leftby); writeln('By: ',b1.leftby);
  109.             writeln(outf,b1.leftto); writeln('To: ',b1.leftto);
  110.             writeln(outf,b1.title);
  111.             writeln(outf,b1.when);  writeln(datestr(b1.when));
  112.             writeln(outf,b1.status); writeln(b1.status);
  113.  
  114.                         reloadtext(b1.line,textf);
  115.                         numlines:=textf.numlines;
  116.      textf.text[numlines+1]:=' ';
  117.      textf.text[numlines+2]:='(from The Mudd Club via TCS-Net v1.50)';
  118.                         numlines:=numlines+2;
  119.                         for kt:=1 to numlines do writeln(outf,textf.text[kt]);
  120.  
  121.             writeln(outf,msgbreak);
  122.  
  123.             end;
  124. close(bf); close(outf);
  125. end.