unit URingBuffer;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, SyncObjs;
type
TCircleBuffer =
class(TStream)
private
FData: PByte;
FSize: integer;
FLock: TCriticalSection;
protected
FReadPosition: integer;
FWritePosition: integer;
FCanReadCount: integer;
FCanWriteCount: integer;
function GetSize: int64;
override;
public
constructor Create(
const ABuffSize: integer);
destructor Destroy();
override;
function Read(
var Buffer; Count: longint): longint;
override;
function Write(
const Buffer; Count: longint): longint;
override;
procedure SaveToFile(
const AFilename:
string);
end;
implementation
{ TCircleBuffer }
constructor TCircleBuffer.Create(
const ABuffSize: integer);
begin
FSize := ABuffSize;
GetMem(FData, FSize);
FWritePosition := 0;
FReadPosition := 0;
FCanWriteCount := ABuffSize;
FCanReadCount := 0;
Fillchar(FData^, FSize, 0);
FLock := TCriticalSection.Create;
end;
destructor TCircleBuffer.Destroy;
begin
inherited;
FLock.Free;
FreeMem(FData, FSize);
end;
function TCircleBuffer.
Read(
var Buffer; Count: longint): longint;
var
P: PByte;
Src: PByte;
Len, DataLen: integer;
begin
FLock.Enter;
try
Result := 0;
if FCanReadCount <= 0
then
begin
Exit;
end;
if Count > FCanReadCount
then
DataLen := FCanReadCount
else
DataLen := Count;
src := FData;
Inc(src, FReadPosition
mod FSize);
Result := DataLen;
move(src^, buffer, DataLen);
Dec(FCanReadCount, Result);
Dec(Count, Result);
if (Count > 0)
and (FCanReadCount > 0)
then
begin
DataLen := Count;
if DataLen > FCanReadCount
then
DataLen := FCanReadCount;
src := FData;
P := @Buffer;
Inc(P, Result);
Len := DataLen;
move(src^, p^, DataLen);
Inc(Result, Len);
Dec(FCanReadCount, Len);
end;
Inc(FCanWriteCount, Result);
if FCanWriteCount > FSize
then
FCanWriteCount := FSize;
Inc(FReadPosition, Result);
if FReadPosition > FSize
then
Dec(FReadPosition, FSize);
finally
FLock.Leave;
end;
end;
function TCircleBuffer.
Write(
const Buffer; Count: longint): longint;
var
Len, DataLen: integer;
dst: PByte;
P: PByte;
begin
FLock.Enter;
try
Result := 0;
if FCanWriteCount <= 0
then
Exit;
if Count > FCanWriteCount
then
DataLen := FCanWriteCount
else
DataLen := Count;
dst := FData;
Inc(dst, FWritePosition
mod FSize);
P := @Buffer;
Result := DataLen;
move(Buffer, dst^, DataLen);
P := FData;
if P =
nil then
Exit;
Dec(Count, Result);
Dec(FCanWriteCount, Result);
if (Count > 0)
and (FCanWriteCount > 0)
then
begin
P := @Buffer;
Inc(P, Result);
Len := FReadPosition - 0;
if Count > Len
then
DataLen := Len
else
DataLen := Count;
dst := Fdata;
move(p^, dst^, DataLen);
Len := DataLen;
Inc(Result, Len);
Dec(FCanWriteCount, Len);
end;
Inc(FCanReadCount, Result);
if FCanReadCount > FSize
then
FCanReadCount := FSize;
Inc(FWritePosition, Result);
if FWritePosition > FSize
then
FWritePosition := FWritePosition - FSize;
finally
FLock.Leave;
end;
end;
function TCircleBuffer.GetSize: int64;
begin
FLock.Enter;
try
Result := FCanReadCount;
finally
FLock.Leave;
end;
end;
procedure TCircleBuffer.SaveToFile(
const AFilename:
string);
var
ms: TMemoryStream;
begin
ms := TMemoryStream.Create;
ms.
Write(FData^, FWritePosition);
ms.SaveToFile(AFilename);
ms.Free;
end;
end.