rsvk/Component/smart_buf_filestream_unit.pas

353 lines
8.8 KiB
Plaintext

unit smart_buf_filestream_unit;
{-------------------------------------------------------------------------------
Smart Buffered file stream input/output
rev 2.1
reSource v2.6
Copyright (C) 1998-2001 Victor Kasenda / gruv
http://go.to/gruv
email: vickas@singnet.com.sg
Features:
Enable/Disable buffering.
efficient in-buffer seeks.
Notes:
Buffering is enabled by default.
To enable/disable buffering, call EnableBuf/DisableBuf.
Procedures allowed when buffering is on or off.
When Buffering is on:
GetNextByte
WriteByte
ReadBuf
WriteBuf
When buffering is off:
Read
Write
Seek
Buffering on/off:
SmartSeek
Assertions are used to check if they are used correctly.
Be warned that not all procedures are protected.
Warning:
Do not call seek when buffering is used. Try not to use it at all.
Call SmartSeek all the time.
Notes:
For GetNextByte
EOF is assumed when bytes_read is smaller than bufsize. Therefore to force
a buffer reread set bytes_read to bufsize. (ResetBuffer)
Version
2.1: Fixed buffer reread and rewrite on GetByte and WriteByte
-------------------------------------------------------------------------------}
(**) interface (**)
uses Classes, Sysutils;
type
ESeekError = class(Exception);
{public
constructor Create;
end;}
TBuf = array[0..MaxLongInt-1] of byte;
PBuf = ^TBuf;
TBufferedFileStream = class( TFileStream )
private
buf: PBuf;
bufsize: integer; // actual size of the buffer
bytes_read: integer; // number of bytes read into the buffer
bufpos: integer;
bufoffset: integer; // actual buffer offset in file
dirty: Boolean;
buf_enabled: boolean;
FFileName: string;
write_mode: boolean;
reread_buffer: boolean;
function GetBufFilePos: integer;
public
property Position: integer read GetBufFilePos;
property FileName: string read FFileName;
constructor Create(const FileName: string; Mode: Word; _bufsize: Cardinal);
destructor Destroy; override;
function SmartSeek(offset: Longint; origin: Word): Longint;
procedure ResetBuffer;
function GetNextByte(var c: byte): Boolean; virtual;
procedure WriteByte(b: byte); virtual;
function ReadBuf(var Buffer; Count: Longint): Longint;
function WriteBuf(const Buffer; Count: Longint): Longint;
procedure EnableBuf;
procedure DisableBuf;
end;
(**) implementation (**)
uses ErrorUnit;
{constructor ESeekError.Create;
begin
inherited Create('Gruv: Fatal Seek Error');
end;}
////////////////////////////////////////////////////////////////////////////////
// Create
// ------
// Only resets the buffer after object is constructed.
////////////////////////////////////////////////////////////////////////////////
constructor TBufferedFileStream.Create( const FileName : string; Mode : Word; _bufsize: Cardinal);
begin
inherited Create(FileName, Mode);
bufsize := _bufsize;
bytes_read := 0;
bufoffset := 0;
dirty := False;
buf_enabled := true;
FFileName := FileName;
write_mode := (Mode and fmOpenWrite <> 0) or (Mode and fmOpenReadWrite <> 0);
GetMem(buf, bufsize);
ResetBuffer;
end;
////////////////////////////////////////////////////////////////////////////////
// Destroy
// -------
// Commits any data and destroys object.
////////////////////////////////////////////////////////////////////////////////
destructor TBufferedFileStream.Destroy;
begin
ResetBuffer;
Freemem(buf);
inherited Destroy;
end;
function TBufferedFileStream.GetBufFilePos: integer;
begin
if (bufpos = 0) and (bytes_read = 0) then
begin
// buffer could be just reset. get the actual physical position
result := inherited Position;
end
else
result := bufoffset + bufpos;
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(buf^, bufpos); {bufpos already incremented by 1}
dirty := False;
bufoffset := inherited Position;
end;
bufpos := 0;
bytes_read := 0;
reread_buffer := true;
end;
////////////////////////////////////////////////////////////////////////////////
// SmartSeek
//
// Will attempt to do an in buffer seek.
////////////////////////////////////////////////////////////////////////////////
function TBufferedFileStream.SmartSeek(offset: Longint; origin: Word) : Longint;
var
abs_offset: integer; // absolute offset
new_relative_offset: integer; // new pos in buffer if seek in buffer possible
begin
if write_mode then
begin
// write out data if buffer is dirty then do the seek
ResetBuffer;
Result := Seek(Offset, Origin);
bufoffset := inherited Position;
end
else
begin
// Attempt to do a seek in buffer if buf_enabled
if buf_enabled then
begin
// Convert offset to absolute offset
case origin of
soFromBeginning: abs_offset := offset;
soFromCurrent: abs_offset := GetBufFilePos + offset;
soFromEnd: abs_offset := Size - 1 + offset; { - 1 to convert to zero base }
else
begin
ShowError('abs_offset not initialized');
abs_offset := offset; {this line to remove the warning}
end;
end; {Case Origin}
// Test if seek in buffer is possible
new_relative_offset := abs_offset - bufoffset;
if (new_relative_offset > 0) and (new_relative_offset < bytes_read-1) then
begin
bufpos := new_relative_offset;
Result := GetBufFilePos;
end
else
begin
Result := Seek(Offset, Origin);
ResetBuffer;
end;
end
else
Result := Seek(Offset, Origin);
end; // write_mode
if (Result < 0) then raise ESeekError.Create('SmartSeek General error');
end;
(*------------------------------------------------------------------------------
GetNextByte
-----------
Reads the next byte in the stream.
bufsize 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.GetNextByte(var c: byte): Boolean;
begin
Assert(buf_enabled = true);
// If the bufpos is over the bytes_read, then must fill buffer with new characters
if (bufpos >= bytes_read) or reread_buffer then
begin
// bytes_read = bufsize implies the file has not reached eof yet
// the file is read in bufsize chunks. smaller than that implies no more data.
if (bytes_read = bufsize) or reread_buffer then
begin
reread_buffer := false;
bufoffset := inherited Position;
bytes_read := Read(buf^, bufsize);
bufpos := 0;
result := GetNextByte(c)
end
else
begin
c := 0;
// return EOF reached
result := false;
end;
end
else
begin
c := buf^[bufpos];
inc(bufpos);
result := True;
end;
end;
(*-----------------------------------------------------------------------------
PutChar
-------
If the buffer is full and dirty, it will be written to disk and restarted. *)
procedure TBufferedFileStream.WriteByte(b: byte);
begin
Assert(buf_enabled = true);
if (bufpos >= bufsize) then
begin
ResetBuffer;
end;
buf^[bufpos] := b;
inc(bufpos);
dirty := True;
end;
procedure TBufferedFileStream.EnableBuf;
begin
buf_enabled := true;
ResetBuffer;
{All changes were made directly to the file. No buffer flushing needed.
Resume normal buffer operation as usual.}
end;
procedure TBufferedFileStream.DisableBuf;
begin
buf_enabled := false;
ResetBuffer;
end;
function TBufferedFileStream.ReadBuf(var Buffer; Count: Longint): Longint;
var
b: PBuf;
c: byte;
i: integer;
begin
Assert(buf_enabled = true);
b := PBuf(@Buffer);
for i := 0 to Count-1 do
begin
GetNextByte(c);
b^[i] := c;
end;
result := Count; // return number of bytes read
end;
function TBufferedFileStream.WriteBuf(const Buffer; Count: Longint): Longint;
var
b: PBuf;
i: integer;
begin
Assert(buf_enabled = true);
b := PBuf(@Buffer);
for i := 0 to Count-1 do
WriteByte(b^[i]);
result := Count;
end;
end.