home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / DPSX / TOOL-PAS.ZIP / BUFIO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-01-24  |  10.5 KB  |  350 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, debugs;
  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.          reverse:    boolean;    {reading backwards?}
  47.       end;
  48.  
  49.  
  50.    var
  51.       berr: boolean;       {true if buffered read or write fails}
  52.  
  53.  
  54.    procedure bcreate(name:    dos_filename);
  55.       {create an empty file; use with bopen to open output files}
  56.  
  57.    procedure bprepare(var bfd:   buffered_file;
  58.                       fd:        dos_handle;
  59.                       maxrecn:   word;
  60.                       recsize:   word);
  61.       {enable buffering on an already open dos_handle}
  62.  
  63.    procedure bopen(var bfd:   buffered_file; {file variable}
  64.                    name:      dos_filename;  {name of file}
  65.                    maxrecn:   word;          {number of records to buffer}
  66.                    recsize:   word);         {size of each record}
  67.       {open a buffered file}                 {sets 'bErr' if not ok}
  68.  
  69.    procedure bflush(var bfd:  buffered_file);
  70.       {write buffer, force re-read on next access}
  71.       
  72.    procedure bseek(var bfd:   buffered_file;
  73.                    recn:      word);
  74.       {set position of buffered file}
  75.    
  76.    procedure bseekeof(var bfd:   buffered_file);
  77.       {set position of buffered file to end-of-file}
  78.    
  79.    function btell(var bfd:    buffered_file): word;
  80.       {tell current record number in buffered file}
  81.  
  82.    function beof(var bfd:     buffered_file): boolean;
  83.       {check for eof on buffered file}
  84.  
  85.    procedure bread(var bfd:   buffered_file;
  86.                    var dest);
  87.       {buffered read}
  88.    
  89.    procedure bwrite(var bfd:   buffered_file;
  90.                     var src);
  91.       {buffered write}
  92.  
  93.    procedure bclose(var bfd:  buffered_file);
  94.       {close a buffered file}
  95.  
  96.  
  97.  
  98. implementation
  99.  
  100. (* -------------------------------------------------------- *)
  101.    procedure bcreate(name:    dos_filename);
  102.       {create an empty file}
  103.    begin
  104.       dos_close(dos_create(name));
  105.    end;
  106.  
  107.  
  108. (* -------------------------------------------------------- *)
  109.    procedure bprepare(var bfd:   buffered_file;
  110.                       fd:        dos_handle;
  111.                       maxrecn:   word;
  112.                       recsize:   word);
  113.       {enable buffering on an already open dos_handle}
  114.    var
  115.       limrec:  word;
  116.    begin
  117.       {reduce buffer records if needed to avoid exceeding buffer size limit}
  118.       limrec := maxbufsiz div recsize;
  119.       if maxrecn > limrec then
  120.          maxrecn := limrec;
  121.  
  122.       {initialize the file buffer variables}
  123.       bfd.maxrec := maxrecn;
  124.       bfd.recsiz := recsize;
  125.       bfd.bufsiz := maxrecn*recsize;
  126.       bfd.fcount := 0;
  127.       bfd.fnext := 0;
  128.       bfd.fptr := 0;
  129.       bfd.dirty := false;
  130.       bfd.reverse := true;
  131.  
  132.       {open the file and allocate a buffer for it}
  133.       bfd.handle := fd;
  134.       berr := bfd.handle = dos_error;
  135.       if berr then
  136.          bfd.buffer := nil
  137.       else
  138.          dos_getmem(bfd.buffer, bfd.bufsiz);
  139.  
  140. (****
  141.    if debugging then
  142.       writeln(debugfd^,'bopen: handle=',bfd.handle,
  143.                   ' path=',bfd.pathname,
  144.                   ' buf@',seg(bfd.buffer^),':',ofs(bfd.buffer^),
  145.                   ' bfd@',seg(bfd),':',ofs(bfd));
  146.  *****)
  147.    end;
  148.  
  149.  
  150. (* -------------------------------------------------------- *)
  151.    procedure bopen(var bfd:   buffered_file;
  152.                    name:      dos_filename;
  153.                    maxrecn:   word;
  154.                    recsize:   word);
  155.       {open a buffered file}
  156.    begin
  157.       {open the file and allocate a buffer for it}
  158.       bfd.pathname := name;
  159.       bfd.handle := dos_open(name, open_update);
  160.       bprepare(bfd,bfd.handle,maxrecn,recsize);
  161.    end;
  162.  
  163.  
  164. (* -------------------------------------------------------- *)
  165.    procedure bflush(var bfd:  buffered_file);
  166.       {save changes in buffer, force re-read on next access}
  167.    begin
  168.       {if file has been written, write buffer contents}
  169.       if bfd.dirty then
  170.       begin
  171.          dos_rseek(bfd.handle, bfd.fptr, bfd.recsiz, seek_start);
  172.          dos_write(bfd.handle, bfd.buffer^, bfd.recsiz*bfd.fcount);
  173. {if debugging then
  174.    writeln(debugfd^,'...write ',bfd.fcount,' fptr=',bfd.fptr,' name=',bfd.pathname);}
  175.          bfd.dirty := false;
  176.          berr := dos_write_err;
  177.       end
  178.       else
  179.          berr := false;
  180.  
  181.       {adjust physical position in file and empty the buffer}
  182.       inc(bfd.fptr, bfd.fnext);
  183.       bfd.fnext := 0;
  184.       bfd.fcount := 0;
  185.       dos_rseek(bfd.handle, bfd.fptr, bfd.recsiz, seek_start);
  186.    end;
  187.  
  188.  
  189. (* -------------------------------------------------------- *)
  190.    procedure bseek(var bfd:   buffered_file;
  191.                    recn:      word);
  192.       {set position of buffered file}
  193.    begin
  194.       {reposition within buffer, if possible}
  195.       if (recn >= bfd.fptr) and (recn <= bfd.fptr+bfd.fcount) then
  196.          bfd.fnext := recn - bfd.fptr
  197.       else
  198.       begin
  199.          {save changes, if any}
  200.          if bfd.dirty then
  201.             bflush(bfd);
  202.  
  203.          bfd.reverse := recn < bfd.fptr;
  204.  
  205.          {perform the physical seek}
  206.          bfd.fptr := recn;
  207.          bfd.fnext := 0;
  208.          bfd.fcount := 0;
  209.          dos_rseek(bfd.handle, recn, bfd.recsiz, seek_start);
  210.       end;
  211.    end;
  212.    
  213.  
  214. (* -------------------------------------------------------- *)
  215.    procedure bseekeof(var bfd:   buffered_file);
  216.       {set position of buffered file to end-of-file}
  217.    begin
  218.       {save changes, if any}
  219.       if bfd.dirty then
  220.          bflush(bfd);
  221.  
  222.       dos_lseek(bfd.handle, 0, seek_end);
  223.       bfd.fptr := dos_tell div longint(bfd.recsiz);
  224.       bfd.fnext := 0;
  225.       bfd.fcount := 0;
  226.    end;
  227.    
  228.  
  229. (* -------------------------------------------------------- *)
  230.    function btell(var bfd:    buffered_file): word;
  231.       {tell current record number in buffered file}
  232.    begin
  233.       btell := bfd.fptr+bfd.fnext;
  234.    end;
  235.  
  236.  
  237. (* -------------------------------------------------------- *)
  238.    function beof(var bfd: buffered_file): boolean;
  239.       {check for eof on buffered file}
  240.    var
  241.       cr:   word;
  242.       nr:   word;
  243.    begin
  244.       {read next block if buffer is empty or exhausted}
  245.       if bfd.fnext >= bfd.fcount then
  246.       begin
  247.  
  248.          {if reading backwards read "lower" in the file than needed}
  249.          if bfd.reverse and (bfd.fcount = 0) then
  250.          begin
  251.             cr := bfd.fptr;            {current base position}
  252.             nr := bfd.maxrec div 4;    {new position for reverse-read}
  253.             if cr > nr then
  254.                bseek(bfd,cr-nr)
  255.             else
  256.                bseek(bfd,0);
  257.  
  258.             bfd.fnext := 0;
  259.             bfd.fcount :=
  260.                   dos_read(bfd.handle, bfd.buffer^, bfd.bufsiz) div bfd.recsiz;
  261.             bseek(bfd,cr);
  262.          end
  263.          else
  264.  
  265.          begin
  266.             {save changes if buffer has been written}
  267.             if bfd.dirty then
  268.                bflush(bfd);
  269.  
  270.             inc(bfd.fptr,bfd.fcount);
  271.             bfd.fnext := 0;
  272.             bfd.fcount := dos_read(bfd.handle, bfd.buffer^, bfd.bufsiz) div bfd.recsiz;
  273.    {if debugging then
  274.       writeln(debugfd^,'...read ',bfd.fcount,' fptr=',bfd.fptr,' name=',bfd.pathname);}
  275.          end;
  276.       end;
  277.       
  278.       {eof if no records left}
  279.       beof := bfd.fcount = 0;
  280.    end;
  281.          
  282.  
  283. (* -------------------------------------------------------- *)
  284.    procedure bread(var bfd:   buffered_file;
  285.                    var dest);
  286.       {buffered read}
  287.    begin
  288.       {check for end of file; read next block when needed}
  289.       berr := beof(bfd);
  290.       if berr then
  291.          exit;
  292.  
  293.       {copy from buffer to user variable}
  294.       move(bfd.buffer^[bfd.fnext*bfd.recsiz], dest, bfd.recsiz);
  295.       inc(bfd.fnext);
  296.    end;
  297.    
  298.  
  299. (* -------------------------------------------------------- *)
  300.    procedure bwrite(var bfd:   buffered_file;
  301.                     var src);
  302.       {buffered write (call dos_write_err to check status)}
  303.    begin
  304.       dos_write_err := false;
  305.  
  306.       {save changes if not yet writing or if buffer is full of changes}
  307.       if (not bfd.dirty) or (bfd.fnext >= bfd.maxrec) then
  308.          bflush(bfd)
  309.       else
  310.          berr := false;
  311.  
  312.       {save user variable in buffer and flag it as 'dirty'(unsaved)}
  313.       move(src, bfd.buffer^[bfd.fnext*bfd.recsiz], bfd.recsiz);
  314.       inc(bfd.fnext);
  315.       if bfd.fcount < bfd.fnext then
  316.          inc(bfd.fcount);
  317.       bfd.dirty := true;
  318.    end;
  319.  
  320.  
  321. (* -------------------------------------------------------- *)
  322.    procedure bclose(var bfd:  buffered_file);
  323.       {close a buffered file}
  324.    begin
  325.       if bfd.buffer = nil then
  326.          exit;
  327.  
  328.       if bfd.handle <> dos_error then
  329.       begin
  330.          bflush(bfd);
  331.          dos_close(bfd.handle);              {low-level file close}
  332.       end;
  333.  
  334. (****
  335.     if debugging then
  336.       writeln(debugfd^,'bclose: handle=',bfd.handle,
  337.                   ' path=',bfd.pathname,
  338.                   ' buf@',seg(bfd.buffer^),':',ofs(bfd.buffer^),
  339.                   ' bfd@',seg(bfd),':',ofs(bfd));
  340.  ****)
  341.  
  342.       dos_freemem(bfd.buffer);    {release buffer memory}
  343.    end;
  344.  
  345.  
  346. {unit initialization}
  347. {begin}
  348. end.
  349.  
  350.