unit tbfstrm;

interface

  uses Classes;

  const

    DefaultStreamBufferSize = 2048;

  type

    TBufferedFileStream = class( TFileStream )

      private

        Buffer      : array [ 1..DefaultStreamBufferSize ] of char;
        BufferPos   : Cardinal;
        BytesRead   : Cardinal;
        Dirty       : Boolean;

      public

        constructor Create( const FileName : string; Mode : Word );
        destructor Destroy; override;

        function Seek( Offset : Longint; Origin : Word ) : Longint; override;
        procedure ResetBuffer;
        function GetNextChar( var C : Char ) : Boolean;
        procedure PutChar( const C : Char );

    end;

implementation

uses SysUtils;

(*------------------------------------------------------------------------------
  Create
  ------
  Only resets the buffer after object is constructed. *)

constructor TBufferedFileStream.Create( const FileName : string; Mode : Word);
begin
  inherited Create( FileName , Mode );
  Dirty := False;
  ResetBuffer;
end;

(*------------------------------------------------------------------------------
  Destroy
  -------
  Commits any data and destroys object. *)

destructor TBufferedFileStream.Destroy;
begin
  ResetBuffer;
  inherited Destroy;
end;

(*------------------------------------------------------------------------------
  ResetBuffer
  -----------
  Writes any information that has not  been committed.

  Will set BufferPos and BytesRead to values that will force a file read the
  next time GetNextChar is called *)

procedure TBufferedFileStream.ResetBuffer;
begin
  if Dirty then
    begin
      Write( Buffer , BufferPos - 1 );
      Dirty := False;
    end;
  BufferPos := DefaultStreamBufferSize + 1;
  BytesRead := DefaultStreamBufferSize;
end;

(*------------------------------------------------------------------------------
  Seek
  ----
  Is not smart enough to determine whether the destination is within the buffer
  because it does not maintain information about the buffer's position relative
  to the beginning of the stream.

  It simply resets the current buffer, so the stream will perform a file read
  after every seek. *)

function TBufferedFileStream.Seek( Offset : Longint; Origin : Word ) : Longint;
begin
  ResetBuffer;
  Result := inherited Seek( Offset , Origin );
end;

(*------------------------------------------------------------------------------
  GetNextChar
  -----------
  Reads the next character in the stream.
  If and end of file is reached, returns False, otherwise returns True and
  populates C with the character read.

  BufferSize characters are read from disk at a time, and when the buffer
  runs out, a new buffer is automatically read.

  Making BufferSize larger will reduce the number of reads and thus
  increase speed, but will ( of course ) consume more memory. *)

function TBufferedFileStream.GetNextChar( var C : Char ) : Boolean;
begin
  Result := False;
  if ( BufferPos > BytesRead ) then
    begin
      if ( BytesRead < DefaultStreamBufferSize ) then
        Exit
      else
        begin
          BufferPos := 1;
          BytesRead := Read( Buffer , DefaultStreamBufferSize );
          Result := GetNextChar( C );
        end;
    end
  else
    begin
      C := Buffer[ BufferPos ];
      Inc( BufferPos );
      Result := True;
    end;
end;


(*------------------------------------------------------------------------------
  PutChar
  -------
  If the buffer is full and dirty, it will be written to disk and restarted. *)

procedure TBufferedFileStream.PutChar( const C : char );
begin
  if ( BufferPos > DefaultStreamBufferSize ) then
    begin
      ResetBuffer;
      BufferPos := 1;
    end;
  Buffer[ BufferPos ] := C;
  Inc( BufferPos );
  Dirty := True;
end;

end.