home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TOOL_USE.ZIP / BUFIO.PAS next >
Encoding:
Pascal/Delphi Source File  |  1989-03-01  |  8.6 KB  |  296 lines
  1.  
  2. (*
  3.  * Copyright 1987, 1989 Samuel H. Smith;  All rights reserved
  4.  *
  5.  * This is a component of the ProDoor System.
  6.  * Do not distribute modified versions without my permission.
  7.  * Do not remove or alter this notice or any other copyright notice.
  8.  * If you use this in your own program you must distribute source code.
  9.  * Do not use any of this in a commercial product.
  10.  *
  11.  *)
  12.  
  13. (*
  14.  * Bufio - Buffered File I/O Unit (3-1-89)
  15.  *
  16.  * This unit provides both read and write buffering on block oriented
  17.  * random-access files.  It is optimized for sequential reads or writes,
  18.  * but will function properly with fully random files.
  19.  *
  20.  *)
  21.  
  22. {$i prodef.inc}
  23.  
  24. unit BufIO;
  25.  
  26. interface
  27.    uses DosMem, MdosIO;
  28.  
  29.    const
  30.       maxbufsiz = $FE00;         {largest file buffer to allocate}
  31.  
  32.    type
  33.       bufarray = array[0..maxbufsiz] of char;
  34.  
  35.       buffered_file = record     {buffered file description record}
  36.          pathname:   dos_filename;  {full name of the file}
  37.          handle:     dos_handle; {handle for dos calls}
  38.          maxrec:     word;       {maximum number of records}
  39.          recsiz:     word;       {record size}
  40.          bufsiz:     word;       {size of the data buffer}
  41.          buffer:     ^bufarray;  {the data buffer}
  42.          fptr:       word;       {base record in file for buffer}
  43.          fnext:      word;       {next record position in buffer (0=first)}
  44.          fcount:     word;       {count of records in buffer}
  45.          dirty:      boolean;    {unsaved changes in buffer?}
  46.       end;
  47.  
  48.  
  49.    var
  50.       berr: boolean;       {true if buffered read or write fails}
  51.  
  52.  
  53.    procedure bcreate(name:    dos_filename);
  54.       {create an empty file; use with bopen to open output files}
  55.  
  56.    procedure bopen(var bfd:   buffered_file;
  57.                    name:      dos_filename;
  58.                    maxrecn:   word;
  59.                    recsize:   word);
  60.       {open a buffered file}
  61.  
  62.    procedure bflush(var bfd:  buffered_file);
  63.       {write buffer, force re-read on next access}
  64.       
  65.    procedure bseek(var bfd:   buffered_file;
  66.                    recn:      word);
  67.       {set position of buffered file}
  68.    
  69.    procedure bseekeof(var bfd:   buffered_file);
  70.       {set position of buffered file to end-of-file}
  71.    
  72.    function btell(var bfd:    buffered_file): word;
  73.       {tell current record number in buffered file}
  74.  
  75.    function beof(var bfd:     buffered_file): boolean;
  76.       {check for eof on buffered file}
  77.  
  78.    procedure bread(var bfd:   buffered_file;
  79.                    var dest);
  80.       {buffered read}
  81.    
  82.    procedure bwrite(var bfd:   buffered_file;
  83.                     var src);
  84.       {buffered write}
  85.  
  86.    procedure bclose(var bfd:  buffered_file);
  87.       {close a buffered file}
  88.  
  89.  
  90.  
  91. implementation
  92.  
  93. (* -------------------------------------------------------- *)
  94.    procedure bcreate(name:    dos_filename);
  95.       {create an empty file}
  96.    begin
  97.       dos_close(dos_create(name));
  98.    end;
  99.  
  100.  
  101. (* -------------------------------------------------------- *)
  102.    procedure bopen(var bfd:   buffered_file;
  103.                    name:      dos_filename;
  104.                    maxrecn:   word;
  105.                    recsize:   word);
  106.       {open a buffered file}
  107.    var
  108.       limrec:  word;
  109.    begin
  110.       {reduce buffer records if needed to avoid exceeding buffer size limit}
  111.       limrec := maxbufsiz div recsize;
  112.       if maxrecn > limrec then
  113.          maxrecn := limrec;
  114.  
  115.       {initialize the file buffer variables}
  116.       bfd.maxrec := maxrecn;
  117.       bfd.recsiz := recsize;
  118.       bfd.bufsiz := maxrecn*recsize;
  119.       bfd.fcount := 0;
  120.       bfd.fnext := 0;
  121.       bfd.fptr := 0;
  122.       bfd.dirty := false;
  123.       bfd.pathname := name;
  124.  
  125.       {open the file and allocate a buffer for it}
  126.       bfd.handle := dos_open(name, open_update);
  127.       berr := bfd.handle = dos_error;
  128.       if berr then
  129.          bfd.buffer := nil
  130.       else
  131.          dos_getmem(bfd.buffer, bfd.bufsiz);
  132.  
  133. (****
  134.    writeln('bopen: handle=',bfd.handle,
  135.                   ' path=',bfd.pathname,
  136.                   ' buf@',seg(bfd.buffer^),':',ofs(bfd.buffer^),
  137.                   ' bfd@',seg(bfd),':',ofs(bfd));
  138.  *****)
  139.    end;
  140.  
  141.  
  142. (* -------------------------------------------------------- *)
  143.    procedure bflush(var bfd:  buffered_file);
  144.       {save changes in buffer, force re-read on next access}
  145.    begin
  146.       {if file has been written, write buffer contents}
  147.       if bfd.dirty then
  148.       begin
  149.          dos_rseek(bfd.handle, bfd.fptr, bfd.recsiz, seek_start);
  150.          dos_write(bfd.handle, bfd.buffer^, bfd.recsiz*bfd.fcount);
  151. {writeln('...write ',bfd.fcount,' fptr=',bfd.fptr,' name=',bfd.pathname);}
  152.          bfd.dirty := false;
  153.          berr := dos_write_failed;
  154.       end
  155.       else
  156.          berr := false;
  157.  
  158.       {adjust physical position in file and empty the buffer}
  159.       inc(bfd.fptr, bfd.fnext);
  160.       bfd.fnext := 0;
  161.       bfd.fcount := 0;
  162.       dos_rseek(bfd.handle, bfd.fptr, bfd.recsiz, seek_start);
  163.    end;
  164.  
  165.  
  166. (* -------------------------------------------------------- *)
  167.    procedure bseek(var bfd:   buffered_file;
  168.                    recn:      word);
  169.       {set position of buffered file}
  170.    begin
  171.       {reposition within buffer, if possible}
  172.       if (recn >= bfd.fptr) and (recn <= bfd.fptr+bfd.fcount) then
  173.          bfd.fnext := recn - bfd.fptr
  174.       else
  175.       begin
  176.          {save changes, if any}
  177.          if bfd.dirty then
  178.             bflush(bfd);
  179.  
  180.          {perform the physical seek}
  181.          bfd.fptr := recn;
  182.          bfd.fnext := 0;
  183.          bfd.fcount := 0;
  184.          dos_rseek(bfd.handle, recn, bfd.recsiz, seek_start);
  185.       end;
  186.    end;
  187.    
  188.  
  189. (* -------------------------------------------------------- *)
  190.    procedure bseekeof(var bfd:   buffered_file);
  191.       {set position of buffered file to end-of-file}
  192.    begin
  193.       {save changes, if any}
  194.       if bfd.dirty then
  195.          bflush(bfd);
  196.  
  197.       dos_lseek(bfd.handle, 0, seek_end);
  198.       bfd.fptr := dos_tell div longint(bfd.recsiz);
  199.       bfd.fnext := 0;
  200.       bfd.fcount := 0;
  201.    end;
  202.    
  203.  
  204. (* -------------------------------------------------------- *)
  205.    function btell(var bfd:    buffered_file): word;
  206.       {tell current record number in buffered file}
  207.    begin
  208.       btell := bfd.fptr+bfd.fnext;
  209.    end;
  210.  
  211.  
  212. (* -------------------------------------------------------- *)
  213.    function beof(var bfd: buffered_file): boolean;
  214.       {check for eof on buffered file}
  215.    begin
  216.       {read next block if buffer is empty or exhausted}
  217.       if bfd.fnext >= bfd.fcount then
  218.       begin
  219.          {save changes if buffer has been written}
  220.          if bfd.dirty then
  221.             bflush(bfd);
  222.  
  223.          inc(bfd.fptr,bfd.fcount);
  224.          bfd.fnext := 0;
  225.          bfd.fcount :=
  226.                dos_read(bfd.handle, bfd.buffer^, bfd.bufsiz) div bfd.recsiz;
  227. {writeln('...read ',bfd.fcount,' fptr=',bfd.fptr,' name=',bfd.pathname);}
  228.       end;
  229.       
  230.       {eof if no records left}
  231.       beof := bfd.fcount = 0;
  232.    end;
  233.          
  234.  
  235. (* -------------------------------------------------------- *)
  236.    procedure bread(var bfd:   buffered_file;
  237.                    var dest);
  238.       {buffered read}
  239.    begin
  240.       {check for end of file; read next block when needed}
  241.       berr := beof(bfd);
  242.       if berr then
  243.          exit;
  244.  
  245.       {copy from buffer to user variable}
  246.       move(bfd.buffer^[bfd.fnext*bfd.recsiz], dest, bfd.recsiz);
  247.       inc(bfd.fnext);
  248.    end;
  249.    
  250.  
  251. (* -------------------------------------------------------- *)
  252.    procedure bwrite(var bfd:   buffered_file;
  253.                     var src);
  254.       {buffered write (call dos_write_failed to check status)}
  255.    begin
  256.       {save changes if not yet writing or if buffer is full of changes}
  257.       if (not bfd.dirty) or (bfd.fnext >= bfd.maxrec) then
  258.          bflush(bfd)
  259.       else
  260.          berr := false;
  261.  
  262.       {save user variable in buffer and flag it as 'dirty'(unsaved)}
  263.       move(src, bfd.buffer^[bfd.fnext*bfd.recsiz], bfd.recsiz);
  264.       inc(bfd.fnext);
  265.       if bfd.fcount < bfd.fnext then
  266.          inc(bfd.fcount);
  267.       bfd.dirty := true;
  268.    end;
  269.  
  270.  
  271. (* -------------------------------------------------------- *)
  272.    procedure bclose(var bfd:  buffered_file);
  273.       {close a buffered file}
  274.    begin
  275.       if bfd.buffer = nil then
  276.          exit;
  277.  
  278.       bflush(bfd);
  279.       dos_close(bfd.handle);              {low-level file close}
  280.  
  281. (****
  282.     writeln('bclose: handle=',bfd.handle,
  283.                   ' path=',bfd.pathname,
  284.                   ' buf@',seg(bfd.buffer^),':',ofs(bfd.buffer^),
  285.                   ' bfd@',seg(bfd),':',ofs(bfd));
  286.  ****)
  287.  
  288.       dos_freemem(bfd.buffer);    {release buffer memory}
  289.    end;
  290.  
  291.  
  292. {unit initialization}
  293. {begin}
  294. end.
  295.  
  296.