home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TXTSEK.ZIP / TEXTSEEK.PAS
Encoding:
Pascal/Delphi Source File  |  1989-05-13  |  3.3 KB  |  147 lines
  1. unit textseek;
  2.  
  3. {Text Seek provides some of the advantages of a file-of-characters for}
  4. {text files.  By Tom Cantlon.}
  5.  
  6. {This is revision 2 of textseek. It fixes a bug related to how Eof works.}
  7. {The change is one line at line 103 in this file. 85 previous down loads.}
  8.  
  9.  
  10. interface
  11.  
  12. uses dos;
  13.  
  14. procedure tseek(var f:text; n:longint);
  15.  
  16. {The equivelant of seek}
  17.  
  18.  
  19. procedure backupln(var f:text; n:word);
  20.  
  21. {Backs up the pointer in a text file n lines.  Backup 1 would cause the line}
  22. {last read to be read again.  It is not an error to back up to many times.  }
  23. {The pointer will simply remain at the beginning of the file.}
  24.  
  25.  
  26. function bof(var f:text):boolean;
  27.  
  28. {The equivelant of eof but tests for the beginning of a file.  Usefull when}
  29. {in a loop using backupln.}
  30.  
  31.  
  32. function tfilepos(var f:text):longint;
  33.  
  34. {The equivelant of filepos.}
  35.  
  36.  
  37. implementation
  38.  
  39. var reg:registers;
  40.     c:char;
  41.     temp:word;
  42.     bofile:boolean;
  43.     fileposition:longint;
  44.     loop:byte;
  45.     templong:longint;
  46.  
  47. type wordrec = record low,high:word; end;
  48.  
  49. const CR = #$0D;
  50.  
  51.  
  52. function actualfilepos(var f:text):longint;
  53. begin
  54. with reg do begin
  55.   ah := $42;
  56.   al := 1;
  57.   bx := textrec(f).handle;
  58.   cx := 0;
  59.   dx := 0;
  60.   msdos(reg);
  61.   wordrec(templong).high := dx;
  62.   wordrec(templong).low := ax;
  63.   end;  {with}
  64. actualfilepos := templong;
  65. end; {proc}
  66.  
  67.  
  68. procedure backupln;
  69. begin
  70. bofile := false;
  71. if eof(f) then loop := 1 else loop := 0;
  72. with textrec(f) do begin
  73.   repeat  {n times}
  74.     repeat  {find CR twice}
  75.       inc(loop);
  76.       repeat  {find CR}
  77.         if bufpos > 0 then dec(bufpos)
  78.         else begin
  79.           bofile := bof(f);
  80.           if not bofile then begin
  81.             fileposition := actualfilepos(f);
  82.             if fileposition >= bufsize + bufend
  83.                                then tseek(f,fileposition - (bufsize + bufend))
  84.             else begin
  85.               temp := fileposition - bufend;
  86.               tseek(f,0);
  87.               bufend := temp;
  88.               with reg do begin
  89.                 ah := $42;
  90.                 al := 0;
  91.                 bx := handle;
  92.                 cx := 0;
  93.                 dx := bufend;
  94.                 msdos(reg);
  95.                 end;  {with}
  96.               end;  {else}
  97.             bufpos := bufend - 1;
  98.             end;  {if not bof}
  99.           end;  {else}
  100.         until (buffer[bufpos] = CR) or bofile;
  101.       if not bofile and (loop = 2) then begin
  102.         readln(f);                             {step past CR/LF}
  103.         if eof(f) then loop := 0;              {take care of eof quirk}
  104.         end;
  105.       until (loop = 2) or bofile;
  106.     dec(n);
  107.     loop := 0;
  108.     until (n = 0) or bofile;
  109.   end;  {with}
  110. end;  {proc}
  111.  
  112.  
  113. procedure tseek;
  114. begin
  115. with reg do begin
  116.   ah := $42;
  117.   al := 0;
  118.   bx := textrec(f).handle;
  119.   cx := wordrec(n).high;
  120.   dx := wordrec(n).low;
  121.   msdos(reg);
  122.   end;  {with}
  123. textrec(f).bufpos := textrec(f).bufend;
  124. read(f,c);
  125. textrec(f).bufpos := 0;
  126. end; {proc}
  127.  
  128.  
  129. function bof;
  130. begin
  131. with reg do begin
  132.   ah := $42;
  133.   al := 1;
  134.   bx := textrec(f).handle;
  135.   cx := 0;
  136.   dx := 0;
  137.   msdos(reg);
  138.   bof := ((ax <= textrec(f).bufsize) and (dx = 0)) and (textrec(f).bufpos = 0);
  139.   end;  {with}
  140. end;  {proc}
  141.  
  142.  
  143. function tfilepos;
  144. begin
  145. tfilepos := actualfilepos(f) - textrec(f).bufsize + textrec(f).bufpos;
  146. end;
  147. end.  {unit}