Ringspeicher als TStream

[Peter666]

Danke, ich habe das jetzt wie folgt umgesetzt:

Delphi-Quellcode:

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.

Ob es geht, wird sich zeigen