Ringspeicher als TStream

[Peter666]

Hi,

hat jemand schonmal einen Ringspeicher auf TStream Basis geschrieben? Irgendwie bekomme ich das ganze nicht hin. Der Hintergrund ist, dass ich LibVLC einen Stream übergeben will, den ich in einem separaten Thread befülle.

Peter

[Rollo62]

Zitat:

Zitat von Peter666 (Beitrag 1462365)

Hi,

hat jemand schonmal einen Ringspeicher auf TStream Basis geschrieben?

Ja, ich benutze eine eigene Klasse die einen TMemoryStream als Speicher benutzt,
um Daten entkoppelt rein- rauszuschreiben.

Darin ist mit WriteBuffer / ReadBuffer die Basisfunktion gemacht,
aber auch andere übliche Varianten Write/Read habe ich implementiert.
Man muss dann noch eine Menge drumrum bauen um das thread sicher zu machen,
und falls nötig dynamisches Allozieren zu ermöglichen.

Funktioniert aber mit TMemoryStream hervorragend.

Hatte mal das hier als Basis genommen.
http://files.cnblogs.com/lwm8246/uCircleBuffer.rar

[himitsu]

Nja, erstmal braucht dein Stream zwei Positionszeiger. Einer für Lesen und einer für Schreiben.

Das Size müsste man auch verdoppeln, für Lesen und Schreiben.
Jenachdem ob die externe Klasse lesen oder schreiben soll (hierfür Lesen), würde dann Size und Position auf den Lesezeiger gehen und bis zum Schreibzeiger die Größe.

Für deinen Schreibzugriff dann über neue SizeIrgendwas/PositionIrgendwas-Property auf den Schreibzeiger, bis zum Lesezeiger gehend.

Ein zussätzliches SizeNochwas oder einfach das Capacity für die Größe des Speichers.


Kannst hierfür ja den TMemoryStream oder TBytesStream verwenden.
Bei Denen könnte man auch Extern nur den einen Zugriff zulassen (hier Lesen) und das Schreiben verbieten (Datenmenge=0 oder Exception beim Zugriff) und da direkt in den Speicher (.Memory bzw. .Bytes) reinschreiben.


Alternativ könnte man auch zwei Stream-Klassen verbinden: Eine zum Schreiben und die Andere zum Lesen,
als Subkomponente, mit gemeinsamen Speicher.


Man könnte aber auch zwei "unabhängige" THandleStream verwenden und z.B. mit einer Pipe bzw. Named-Pipe verbinden. (die Pipe hat dabei in sich quasi sowas wie einen Ring-Puffer ... jenachdem wie Windows den Speicher behandlet: Verschieben oder im Kreis)

[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 :)

[Der schöne Günther]

Alternativ könnte man einfach Unit-Tests schreiben, das ist irgendwie besser als zu gucken ob es geht

[himitsu]

Zitat:

Delphi-Quellcode:

  ms := TMemoryStream.Create;
  ms.Write(FData^, FWritePosition);
  ms.SaveToFile(AFilename);
  ms.Free;

Wir wäre es mit Ressourcenschutzblöcken?

Zitat:

Delphi-Quellcode:

{$mode objfpc}

Es kann nicht schaden, wenn du in deinem Profil angibst, dass du FreePascal (vielleicht auch Lazarus) verwendest,
bzw. in einigen Unterforen kann man das bei jedem Thread auch nochmal einzeln angeben,
denn es macht es den Helfenden auch einfacher die Anzwortmöglichkeiten entsprechend abzuwägen.


In "etwas neueren" Delphis gibt es z.B.

Delphi-Quellcode:

TFile.WriteAllBytes

, womit man wunderschön ByteArrays speichern/laden kann.


TMemoryStream bzw. TBytesStream als Vorfahre und du kannst direkt dessen Speicher benutzen, anstatt selbst mit Pointer rumzuhantieren.
Statt wilden Pointern verwende ich selbst auch fast nur noch TBytes, bzw. TArray<Byte>, was sich den Speicher automatisch freigeben lässt und auch beim Debuggen einen schöneren Einblick gewährt.

[Rollo62]

Ich würde noch die Zeiger konsequent mit den "Atomic" Funktionen abfragen und setzen.

Delphi-Quellcode:

    FReadPosition: integer;
    FWritePosition: integer;
    FCanReadCount: integer;
    FCanWriteCount: integer;

So kann man die aus einigen Lock-Blöcken rausziehen, und vermeidet unnötiges Locken.