unit UBufferedFS;
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
interface
uses SysUtils, Classes, Math;
type
TBFSMode = (BFMRead, BFMWrite);
TBufferedFS =
class(TStream)
private
membuffer:
array of Byte;
BufferSize: Integer;
bytesinbuffer: Integer;
bufferpos: Integer;
bufferdirty: Boolean;
Mode: TBFSMode;
FStream: TStream;
FOwnStream: Boolean;
procedure Init;
procedure Flush;
procedure FillBuffer;
public
constructor Create(
const FileName:
String; Mode: Word;
BufSize: Integer = $10000);
overload;
constructor Create(AHandle: THandle; BufSize: Integer = $10000);
overload;
// constructor Create(AStream: TStream; Owned: Boolean = false;
// BufSize: Integer = $10000); overload;
destructor Destroy;
override;
function Read(
var Buffer; Count: Longint): Longint;
override;
function Write(
const Buffer; Count: Longint): Longint;
override;
function Seek(
const Offset: Int64; Origin: TSeekOrigin): Int64;
override;
end;
implementation
function MovePointer(
const P: pointer;
const dist: Integer): pointer;
inline;
begin
result := pointer(Integer(p) + dist);
end;
procedure TBufferedFS.Init;
begin
bytesinbuffer := 0;
bufferpos := 0;
bufferdirty := FALSE;
mode := BFMWrite;
end;
procedure TBufferedFS.Flush;
begin
if bufferdirty
then
inherited Write(membuffer[0], bufferpos);
bufferdirty := FALSE;
bytesinbuffer := 0;
bufferpos := 0;
end;
constructor TBufferedFS.Create(
const FileName:
String; Mode: Word;
BufSize: Integer);
begin
inherited Create;
FStream := TFileStream.Create(FileName, Mode);
FOwnStream := true;
SetLength(membuffer, BufSize);
BufferSize := BufSize;
init;
end;
constructor TBufferedFS.Create(AHandle: THandle; BufSize: Integer);
begin
inherited Create;
FStream := TFileStream.Create(AHandle);
FOwnStream := true;
SetLength(membuffer, BufSize);
BufferSize := BufSize;
init;
end;
//constructor TBufferedFS.Create(AStream: TStream; Owned: Boolean = false;
// BufSize: Integer = $10000);
//begin
// inherited Create;
// FStream := AStream;
// FOwnStream := Owned;
// SetLength(membuffer, BufSize);
// BufferSize := BufSize;
// init;
//end;
destructor TBufferedFS.Destroy;
begin
flush;
inherited;
end;
procedure TBufferedFS.FillBuffer;
begin
flush;
bytesinbuffer := FStream.
Read(membuffer[0], buffersize);
end;
function TBufferedFS.
Read(
var Buffer; Count: Longint): Longint;
var
p: PByte;
bytestoread: Integer;
b: Integer;
begin
Assert(Count >= 0, '
Count must not be a negative number!');
if Mode = BFMWrite
then
begin
flush;
mode := BFMRead;
end;
result := 0;
if Count = 0
then
exit;
if count <= bytesinbuffer
then
begin
//all data already in buffer
move(membuffer[bufferpos], buffer, count);
dec(bytesinbuffer, count);
inc(bufferpos, count);
result := count;
end
else
begin
bytestoread := count;
p := @buffer;
if (bytesinbuffer <> 0)
then
begin
//read data remaining in buffer and increment data pointer
b :=
Read(p^, bytesinbuffer);
inc(p, b);
dec(bytestoread, b);
result := b;
end;
if bytestoread >= BufferSize
then
begin
//data to read is larger than the buffer, read it directly
result := result + FStream.
Read(p^, bytestoread);
end
else
begin
//refill buffer
FillBuffer;
//recurse
result := result +
Read(p^, math.Min(bytestoread, bytesinbuffer));
end;
end;
end;
function TBufferedFS.
Write(
const Buffer; Count: Longint): Longint;
var
p: pointer;
bytestowrite: Integer;
b: Integer;
Pos: Int64;
begin
if mode = BFMRead
then
begin
Pos := Seek(0, soCurrent);
FStream.seek(Pos, soFromBeginning);
bytesinbuffer := 0;
bufferpos := 0;
end;
mode := BFMWrite;
result := 0;
if count <= BufferSize - bytesinbuffer
then
begin
//all data fits in buffer
bufferdirty := TRUE;
move(buffer, membuffer[bufferpos], count);
inc(bytesinbuffer, count);
inc(bufferpos, count);
result := count;
end else
begin
bytestowrite := count;
if (bytestowrite <> 0)
And (bytesinbuffer <> BufferSize)
And
(bytesinbuffer <> 0)
then
begin
//write data to remaining space in buffer and increment data pointer
b :=
Write(buffer, BufferSize - bytesinbuffer);
p := MovePointer( @buffer, b);
dec(bytestowrite, b);
result := b;
end else
p := @buffer;
if bytestowrite >= BufferSize
then
begin
//empty buffer
Flush;
//data to write is larger than the buffer, write it directly
result := result + FStream.
Write(p^, bytestowrite);
end else
begin
//empty buffer
Flush;
//recurse
result := result +
Write(p^, bytestowrite);
end;
end;
end;
function TBufferedFS.Seek(
const Offset: Int64; Origin: TSeekOrigin): Int64;
var
X: Int64;
begin
if (Origin = soCurrent)
And (Offset = 0)
then
begin
if Mode = BFMWrite
then
result := FStream.seek(Offset, origin) + bufferpos
else
result := FStream.seek(Offset, origin) - BytesInBuffer;
if Result < 0
then
Result := 0;
end
else
begin
case Origin
of
soCurrent:
begin
X := bufferpos + Offset;
if (X < 0)
or (X >= BytesInBuffer)
or (Mode = BFMWrite)
then
begin
X := Seek(0, soCurrent);
flush;
result := FStream.seek(X + Offset, soBeginning);
end
else
begin
BufferPos := X;
dec(BytesInBuffer, Offset);
Result := Seek(0, soCurrent);
end;
end;
soBeginning:
begin
Assert(Offset >= 0);
Result := seek(Offset - Seek(0, soCurrent), soCurrent);
end;
soEnd:
begin
flush;
result := FStream.Seek(offset, origin);
end;
else
raise EStreamError.Create(
'
Seek: not (origin in [soCurrent, soBeginning, soEnd])');
end;
end;
end;
end.