home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / help / ngdump / bufio.pas next >
Encoding:
Pascal/Delphi Source File  |  1990-04-04  |  2.4 KB  |  124 lines
  1. {$R+,I+}
  2. {$M 45000,0,655360}
  3. unit BufIO;
  4.  
  5. interface
  6.  
  7. procedure bread(var f:file; var buf; count:word; var result:word);
  8. procedure bskip(var f:file; n:longint);
  9. procedure bseek(var f:file; p:longint);
  10. function  bpos(var f:file):longint;
  11.  
  12. implementation
  13.  
  14. {$define Buffered}
  15.  
  16. {$ifdef Buffered}
  17.  
  18. const MaxFbuf = 1024;
  19.  
  20. var   fbuf   : array [1..MaxFbuf] of byte;
  21.       inbuf  : 0..MaxFbuf;
  22.       curbuf : 1..MaxFbuf+1;
  23.  
  24. procedure bread( var f:file; var buf; count:word; var result:word);
  25. type ByteArray = array [1..maxint] of byte;
  26. var done,n:word;
  27.     abuf : ByteArray absolute buf;
  28. begin
  29.   result := 0;
  30.   if (count > inbuf) or (inbuf = 0) then begin
  31.      if (inbuf > 0)
  32.       then move(fbuf[curbuf], buf, inbuf);
  33.      done := inbuf;
  34.      while (done < count) do begin
  35.         blockread(f, fbuf, MaxFbuf, result);
  36.         inbuf := result;
  37.         if (inbuf < 1) then begin
  38. {           writeln('BufIO.bread: unexpected eof.'); }
  39.            FillChar(buf, count, 0);
  40.            result := 0;
  41.            exit;
  42.         end;
  43.         curbuf := 1;
  44.         n := count - done;
  45.         if (n > inbuf) then n := inbuf;
  46.         move(fbuf[curbuf], abuf[done+1], n);
  47.         inc(done, n);
  48.         dec(inbuf, n);
  49.         inc(curbuf, n);
  50.      end;
  51.   end
  52.   else begin
  53.      move(fbuf[curbuf], buf, count);
  54.      dec(inbuf, count);
  55.      inc(curbuf);
  56.   end;
  57.   result := count;
  58. end;
  59.  
  60. procedure bseek(var f:file; p:longint);
  61. begin
  62.   seek(f, p);
  63.   inbuf := 0; curbuf := 1;       { flush buffer }
  64. end;
  65.  
  66. function bpos(var f:file):longint;
  67. begin
  68.   bpos := filepos(f) - inbuf;
  69. end;
  70.  
  71. procedure bskip(var f:file; n:longint);
  72. begin
  73.   if (n < inbuf) then begin
  74.      dec(inbuf, n);
  75.      inc(curbuf, n);
  76.   end
  77.   else begin
  78.      bseek(f, bpos(f)+n);
  79.   end;
  80. end;
  81.  
  82. {$else}
  83.  
  84. procedure bread( var f:file; var buf; count:word; var result:word);
  85. begin
  86.   blockread(f, buf, count, result);
  87.   if (result < 1) then begin
  88.      writeln('BufIO.bread: unexpected eof.');
  89.   end;
  90. end;
  91.  
  92. procedure bseek(var f:file; p:longint);
  93. begin
  94.   seek(f, p);
  95. end;
  96.  
  97. function bpos(var f:file):longint;
  98. begin
  99.   bpos := filepos(f);
  100. end;
  101.  
  102. procedure bskip(var f:file; n:longint);
  103. begin
  104.   bseek(f, filepos(f)+n);
  105. end;
  106.  
  107. {$endif}
  108.  
  109. (*
  110. var SaveExitProc : Pointer;
  111.  
  112. {$F+} procedure MyExitProc; {$F-}
  113. begin
  114.   ExitProc := SaveExitProc;
  115. end;
  116. *)
  117.  
  118. begin
  119. {$ifdef Buffered}
  120.   inbuf := 0;
  121.   curbuf := 1;
  122. {$endif}
  123. end.
  124.