home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 341.img / TCS161S.ZIP / TEXTMESS.PAS < prev    next >
Pascal/Delphi Source File  |  1989-10-07  |  2KB  |  84 lines
  1. procedure dumptext(sector:integer);
  2. procedure reloadtext (sector:integer; var q:message);
  3.  
  4. implementation
  5.  
  6. procedure reloadtext (sector:integer; var q:message);
  7. var k:char;
  8.     sectorptr,tmp,n:integer;
  9.     buff:buffer;
  10.     x:boolean;
  11.  
  12.   procedure setbam (sector,val:integer);
  13.   begin
  14.     seek (mapfile,sector);
  15.     write (mapfile,val)
  16.   end;
  17.  
  18.   procedure chk;
  19.   begin
  20.     iocode:=ioresult;
  21.     if iocode<>0 then writeln (usr,'(Error ',iocode,' reading message)')
  22.   end;
  23.  
  24. begin
  25.   sectorptr:=32767;
  26.   n:=1;
  27.   q.text[1]:='';
  28.   repeat
  29.     if sectorptr>sectorsize then begin
  30.       if sector<0 then exit;
  31.       seek (tfile,sector); chk;
  32.       read (tfile,buff); chk;
  33.       seek (mapfile,sector); chk;
  34.       read (mapfile,tmp); chk;
  35.       if tmp=-2 then begin
  36.         tmp:=-1;
  37.         seek (mapfile,sector); chk;
  38.         write (mapfile,tmp); chk;
  39.       end;
  40.       sector:=tmp;
  41.       sectorptr:=1
  42.     end;
  43.     k:=buff[sectorptr];
  44.     case k of
  45.       #0,#10:;
  46.       #13:if n>=maxmessagesize
  47.             then k:=#0
  48.             else begin
  49.               n:=n+1;
  50.               q.text[n]:=''
  51.             end
  52.       else q.text[n]:=q.text[n]+k
  53.     end;
  54.     sectorptr:=sectorptr+1
  55.   until k=#0;
  56.   q.numlines:=n;
  57.   chk
  58. end;
  59.  
  60.  
  61. procedure dumptext (sector:integer, tf:text);
  62. var q:message;
  63.     x,bub,done:boolean;
  64.     n,m,t,w,b,y,mm,i,apexiscool,e:integer;
  65.     p:byte;
  66.     s,a,cornerstone,sunbane:string;
  67.     cs,css,keithmillerisafag:char;
  68.     kay,thegog:char;
  69. begin
  70.   reloadtext (sector,q);
  71.   writeln (^B);
  72.   n:=1;
  73.   repeat
  74.    mm:=0;
  75.    repeat
  76.     if length(q.text[n])>0 then begin
  77.     writeln(outf,q.text[n]);
  78.   until break or (n>q.numlines);
  79.   writeln (^B^M);
  80. end;
  81.  
  82. begin
  83. end.
  84.