utils/uutlStreamHelper.pas

unit uutlStreamHelper;

{ Package:      Utils
  Prefix:       utl - UTiLs
  Beschreibung: diese Unit enthält Klassen zum lesen und schreiben von Werten in einen Stream
                TutlStreamReader - Wrapper für beliebige Streams, handelt Datentypen
                TutlStreamWriter - Wrapper für beliebige Streams, handelt Datentypen }

{$mode objfpc}{$H+}

interface

uses
  SysUtils, Classes, syncobjs,
  uutlGenerics;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlFourCC = string[4];
  TutlStreamUtility = class
  private type
    TPositionStack = specialize TutlStack<Int64>;

  private
    fStream: TStream;
    fOwnsStream: Boolean;
    fPositions: TPositionStack;

  public
    property Stream: TStream read FStream;

    procedure Push;
    procedure Pop;
    procedure Drop;

    constructor Create(const aBaseStream: TStream; const aOwnsStream: Boolean);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlStreamReader = class(TutlStreamUtility)
  protected
    function ReadBuffer(var Buffer; Size: int64): int64;

  public
    function ReadFourCC:            TutlFourCC; inline;
    function CheckFourCC            (constref Correct: TutlFourCC): boolean; inline;
    function ReadByte:              Byte; inline;
    function ReadWord:              Word; inline;
    function ReadCardinal:          Cardinal; inline;
    function ReadInteger:           Integer; inline;
    function ReadInt64:             Int64; inline;
    function ReadSingle:            Single; inline;
    function ReadDouble:            Double; inline;
    function ReadAnsiString:        AnsiString; inline;
    function ReadLine:              AnsiString;
    function IsEOF:                 boolean; inline;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlStreamWriter = class(TutlStreamUtility)
  protected
    procedure WriteBuffer(var Data; Size: int64);

  public
    procedure WriteFourCC           (FCC: TutlFourCC); inline;
    procedure WriteByte             (A: Byte); inline;
    procedure WriteWord             (A: Word); inline;
    procedure WriteCardinal         (A: Cardinal); inline;
    procedure WriteInteger          (A: Integer); inline;
    procedure WriteInt64            (A: Int64); inline;
    procedure WriteSingle           (A: Single); inline;
    procedure WriteDouble           (A: Double); inline;
    procedure WriteAnsiString       (A: AnsiString); inline;
    procedure WriteAnsiBytes        (A: AnsiString); inline;
    procedure WriteLine             (A: AnsiString); inline;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlStreamHelper = class
  private
    class function  ReadBuffer      (constref aStream: TStream; var Buffer; Size: int64): int64;
    class procedure WriteBuffer     (constref aStream: TStream; var Data; Size: int64);

  public
    class function  ReadFourCC      (constref aStream: TStream): TutlFourCC; inline;
    class function  CheckFourCC     (constref aStream: TStream; Correct: TutlFourCC): boolean; inline;
    class function  ReadByte        (constref aStream: TStream): Byte; inline;
    class function  ReadWord        (constref aStream: TStream): Word; inline;
    class function  ReadCardinal    (constref aStream: TStream): Cardinal; inline;
    class function  ReadInteger     (constref aStream: TStream): Integer; inline;
    class function  ReadInt64       (constref aStream: TStream): Int64; inline;
    class function  ReadSingle      (constref aStream: TStream): Single; inline;
    class function  ReadDouble      (constref aStream: TStream): Double; inline;
    class function  ReadAnsiString  (constref aStream: TStream): AnsiString; inline;
    class function  ReadLine        (constref aStream: TStream): AnsiString;
    class function  IsEOF           (constref aStream: TStream): boolean; inline;

  public
    class procedure WriteFourCC     (constref aStream: TStream; FCC: TutlFourCC); inline;
    class procedure WriteByte       (constref aStream: TStream; A: Byte); inline;
    class procedure WriteWord       (constref aStream: TStream; A: Word); inline;
    class procedure WriteCardinal   (constref aStream: TStream; A: Cardinal); inline;
    class procedure WriteInteger    (constref aStream: TStream; A: Integer); inline;
    class procedure WriteInt64      (constref aStream: TStream; A: Int64); inline;
    class procedure WriteSingle     (constref aStream: TStream; A: Single); inline;
    class procedure WriteDouble     (constref aStream: TStream; A: Double); inline;
    class procedure WriteAnsiString (constref aStream: TStream; A: AnsiString); inline;
    class procedure WriteAnsiBytes  (constref aStream: TStream; A: AnsiString); inline;
    class procedure WriteLine       (constref aStream: TStream; A: AnsiString); inline;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlPagedBufferStream = class(TOwnerStream)
  public const
    DEFAULT_BUFLEN = 4096*16;

  private
    FVirtualSize, FVirtualPosition: Int64;
    FBuffer: TBytes;
    FBufferStart: Int64;
    FBufferModified: boolean;

  protected
    function  GetSize: Int64; override;
    procedure SetSize(const NewSize: Int64); override;
    procedure ReMapBuffer;
    procedure FlushBuffer;

  public
    function Read(var Buffer; Count: Integer): Integer; override;
    function Write(const Buffer; Count: Integer): Integer; override;
    function Seek(Offset: Integer; Origin: Word): Integer; override;

    constructor Create(const BaseStream: TStream; const BufferSize: Cardinal = DEFAULT_BUFLEN; const aOwnsStream: Boolean = false);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlFIFOStream = class(TStream)
  private const
    MAX_PAGE_SIZE = 4096;

  private type
    PPage = ^TPage;
    TPage = record
      Next: PPage;
      Data: packed array[0..MAX_PAGE_SIZE-1] of byte;
    end;

  private
    fLockFree: boolean;
    fPageFirst, fPageLast: PPage;
    fReadPtr, fWritePtr: Cardinal;
    fTotalSize: Int64;
    fDataLock: TCriticalSection;

  protected
    function GetSize: Int64; override;

  public
    property LockFree: boolean read fLockFree;

    function  Read    (var Buffer; Count: Longint): Longint; override;
    function  Reserve (var Buffer; Count: Longint): Longint;
    function  Discard (Count: Longint): Longint;
    function  Write   (const Buffer; Count: Longint): Longint; override;
    function  Seek    (const {%H-}Offset: Int64; {%H-}Origin: TSeekOrigin): Int64; override; overload;

    procedure BeginOperation;
    procedure EndOperation;
    procedure Clear;

    constructor Create(const aLockFree: boolean = false);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlBase64Decoder = class(TStringStream)
  public const
    CODE64 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
    PADDING_CHARACTER = '=';

  public
    function Read(var Buffer; Count: Longint): Longint; override;
    function Decode(const aOutput: TStream): Boolean;

    constructor Create;
  end;

implementation

uses
  RtlConsts, Math;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlStreamUtility/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStreamUtility.Pop;
begin
  FStream.Position := fPositions.Pop;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStreamUtility.Drop;
begin
  fPositions.Pop;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStreamUtility.Push;
begin
  FPositions.Push(FStream.Position);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlStreamUtility.Create(const aBaseStream: TStream; const aOwnsStream: Boolean);
begin
  inherited Create;
  fStream     := aBaseStream;
  fOwnsStream := aOwnsStream;
  fPositions  := TPositionStack.Create(true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlStreamUtility.Destroy;
begin
  if FOwnsStream
    then FreeAndNil(fStream)
    else fStream:= nil;
  FreeAndNil(FPositions);
  inherited;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlStreamReader//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlStreamReader.ReadBuffer(var Buffer; Size: int64): int64;
begin
  if (FStream.Position + Size > FStream.Size) then
    raise EInvalidOperation.Create('stream is to small');
  Result:= FStream.Read(Buffer, Size);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlStreamReader.ReadFourCC: TutlFourCC;
begin
  SetLength(Result, 4);
  ReadBuffer(Result[1], 4);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlStreamReader.CheckFourCC(constref Correct: TutlFourCC): boolean;
begin
  Result := ReadFourCC=Correct;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlStreamReader.ReadByte: Byte;
begin
  ReadBuffer(Result{%H-}, Sizeof(Result));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlStreamReader.ReadWord: Word;
begin
  ReadBuffer(Result{%H-}, Sizeof(Result));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlStreamReader.ReadCardinal: Cardinal;
begin
  ReadBuffer(Result{%H-}, Sizeof(Result));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlStreamReader.ReadInteger: Integer;
begin
  ReadBuffer(Result{%H-}, Sizeof(Result));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlStreamReader.ReadInt64: Int64;
begin
  ReadBuffer(Result{%H-}, Sizeof(Result));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlStreamReader.ReadSingle: Single;
begin
  ReadBuffer(Result{%H-}, Sizeof(Result));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlStreamReader.ReadDouble: Double;
begin
  ReadBuffer(Result{%H-}, Sizeof(Result));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlStreamReader.ReadAnsiString: AnsiString;
begin
  SetLength(Result, ReadCardinal);
  ReadBuffer(Result[1], Length(Result));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlStreamReader.ReadLine: AnsiString;
begin
  result := TutlStreamHelper.ReadLine(fStream);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlStreamReader.IsEOF: boolean;
begin
  Result := FStream.Position = FStream.Size;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlStreamWriter//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStreamWriter.WriteBuffer(var Data; Size: int64);
begin
  FStream.Write(Data, Size);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStreamWriter.WriteFourCC(FCC: TutlFourCC);
begin
  WriteBuffer(FCC[1], 4);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStreamWriter.WriteByte(A: Byte);
begin
  WriteBuffer(A, SizeOf(a));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStreamWriter.WriteWord(A: Word);
begin
  WriteBuffer(A, SizeOf(a));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStreamWriter.WriteCardinal(A: Cardinal);
begin
  WriteBuffer(A, SizeOf(a));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStreamWriter.WriteInteger(A: Integer);
begin
  WriteBuffer(A, SizeOf(a));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStreamWriter.WriteInt64(A: Int64);
begin
  WriteBuffer(A, SizeOf(a));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStreamWriter.WriteSingle(A: Single);
begin
  WriteBuffer(A, SizeOf(a));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStreamWriter.WriteDouble(A: Double);
begin
  WriteBuffer(A, SizeOf(a));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStreamWriter.WriteAnsiString(A: AnsiString);
begin
  WriteCardinal(Length(A));
  WriteBuffer(A[1], Length(a));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStreamWriter.WriteAnsiBytes(A: AnsiString);
begin
  WriteBuffer(A[1], Length(A));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStreamWriter.WriteLine(A: AnsiString);
begin
  WriteAnsiBytes(A + sLineBreak);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlStreamHelper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlStreamHelper.ReadBuffer(constref aStream: TStream; var Buffer; Size: int64): int64;
begin
  if (aStream.Position + Size > aStream.Size) then
    raise EInvalidOperation.Create('stream is to small');
  Result := aStream.Read(Buffer, Size);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlStreamHelper.WriteBuffer(constref aStream: TStream; var Data; Size: int64);
begin
  aStream.Write(Data, Size);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlStreamHelper.ReadFourCC(constref aStream: TStream): TutlFourCC;
begin
  SetLength(Result, 4);
  ReadBuffer(aStream, Result[1], 4);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlStreamHelper.CheckFourCC(constref aStream: TStream; Correct: TutlFourCC): boolean;
begin
  result := (ReadFourCC(aStream) = Correct);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlStreamHelper.ReadByte(constref aStream: TStream): Byte;
begin
  ReadBuffer(aStream, result{%H-}, SizeOf(result));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlStreamHelper.ReadWord(constref aStream: TStream): Word;
begin
  ReadBuffer(aStream, result{%H-}, SizeOf(result));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlStreamHelper.ReadCardinal(constref aStream: TStream): Cardinal;
begin
  ReadBuffer(aStream, result{%H-}, SizeOf(result));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlStreamHelper.ReadInteger(constref aStream: TStream): Integer;
begin
  ReadBuffer(aStream, result{%H-}, SizeOf(result));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlStreamHelper.ReadInt64(constref aStream: TStream): Int64;
begin
  ReadBuffer(aStream, result{%H-}, SizeOf(result));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlStreamHelper.ReadSingle(constref aStream: TStream): Single;
begin
  ReadBuffer(aStream, result{%H-}, SizeOf(result));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlStreamHelper.ReadDouble(constref aStream: TStream): Double;
begin
  ReadBuffer(aStream, result{%H-}, SizeOf(result));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlStreamHelper.ReadAnsiString(constref aStream: TStream): AnsiString;
begin
  SetLength(Result, ReadCardinal(aStream));
  ReadBuffer(aStream, Result[1], Length(Result));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlStreamHelper.ReadLine(constref aStream: TStream): AnsiString;
const
  READ_LENGTH = 80;
var
  rp, rl: integer;
  cp: PAnsiChar;
  bpos: Int64;
  r: integer;
  EOF: Boolean;

  procedure ReadSome;
  begin
    SetLength(Result, rl + READ_LENGTH);
    r:= aStream.Read(Result[rl + 1], READ_LENGTH);
    inc(rl, r);
    EOF:= r <> READ_LENGTH;
    cp:= @Result[rp];
  end;

begin
  Result := '';
  rl     := 0;
  bpos   := aStream.Position;
  repeat
    rp := rl + 1;
    ReadSome;
    while rp <= rl do begin
      if cp^ in [#10, #13] then begin
        inc(bpos, rp);
        // never a second char after #10
        if cp^ = #13 then begin
          if (rp = rl) and not EOF then begin
            ReadSome;
          end;
          if (rp <= rl) then begin
            inc(cp);
            if cp^ = #10 then
              inc(bpos);
          end;
        end;
        aStream.Position := bpos;
        SetLength(Result, rp-1);
        Exit;
      end;
      inc(cp);
      inc(rp);
    end;
  until EOF;
  SetLength(Result, rl);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlStreamHelper.IsEOF(constref aStream: TStream): boolean;
begin
  Result := aStream.Position = aStream.Size;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlStreamHelper.WriteFourCC(constref aStream: TStream; FCC: TutlFourCC);
begin
  WriteBuffer(aStream, FCC[1], 4);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlStreamHelper.WriteByte(constref aStream: TStream; A: Byte);
begin
  WriteBuffer(aStream, a, SizeOf(a));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlStreamHelper.WriteWord(constref aStream: TStream; A: Word);
begin
  WriteBuffer(aStream, a, SizeOf(a));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlStreamHelper.WriteCardinal(constref aStream: TStream; A: Cardinal);
begin
  WriteBuffer(aStream, a, SizeOf(a));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlStreamHelper.WriteInteger(constref aStream: TStream; A: Integer);
begin
  WriteBuffer(aStream, a, SizeOf(a));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlStreamHelper.WriteInt64(constref aStream: TStream; A: Int64);
begin
  WriteBuffer(aStream, a, SizeOf(a));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlStreamHelper.WriteSingle(constref aStream: TStream; A: Single);
begin
  WriteBuffer(aStream, a, SizeOf(a));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlStreamHelper.WriteDouble(constref aStream: TStream; A: Double);
begin
  WriteBuffer(aStream, a, SizeOf(a));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlStreamHelper.WriteAnsiString(constref aStream: TStream; A: AnsiString);
begin
  WriteCardinal(aStream, Length(A));
  WriteBuffer(aStream, A[1], Length(a));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlStreamHelper.WriteAnsiBytes(constref aStream: TStream; A: AnsiString);
begin
  WriteBuffer(aStream, A[1], Length(a));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlStreamHelper.WriteLine(constref aStream: TStream; A: AnsiString);
begin
  WriteAnsiBytes(aStream, A + sLineBreak);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlPagedBufferStream/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlPagedBufferStream.GetSize: Int64;
begin
  Result:= FVirtualSize;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlPagedBufferStream.SetSize(const NewSize: Int64);
begin
  FVirtualSize:= NewSize;
  Source.Size:= NewSize;
  if Position > FVirtualSize then
    Position:= FVirtualSize;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlPagedBufferStream.ReMapBuffer;
var
  newbs: Int64;
  inbuf: Int64;
begin
  // Welches Buffer-Segment wird gesucht?
  newbs:= (FVirtualPosition div Length(FBuffer)) * Length(FBuffer);
  // ist das das aktuelle?
  if FBufferStart <> newbs then begin
    FlushBuffer;
    // Segment holen
    Source.Position:= newbs;
    inbuf:= Min(Length(FBuffer), FVirtualSize - newbs);
    Source.ReadBuffer(FBuffer[0], inbuf);
    FBufferStart:= newbs;
    FBufferModified:= false;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlPagedBufferStream.FlushBuffer;
var
  towrite: Int64;
begin
  if not FBufferModified then
    // Nothing to do
    Exit;

  Source.Position:= FBufferStart;
  towrite:= Min(Length(FBuffer), FVirtualSize - FBufferStart);
  Source.WriteBuffer(FBuffer[0], towrite);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlPagedBufferStream.Read(var Buffer; Count: Integer): Integer;
var
  br, c: Int64;
  bp: Pointer;
begin
  br:= 0;
  bp:= @Buffer;
  while (br < Count) and (FVirtualPosition<FVirtualSize) do begin
    ReMapBuffer;
    // Wie viel Daten daraus brauchen wir bzw. können wir kriegen?
    c:= Min(Min(Count - br, Length(FBuffer) - (FVirtualPosition-FBufferStart)), FVirtualSize - FVirtualPosition);

    // das rausholen und buffer weiterschieben
    Move(FBuffer[FVirtualPosition-FBufferStart], bp^, c);
    Inc(Bp, c);
    Inc(br, c);
    Inc(FVirtualPosition, c);
  end;
  Result:= br;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlPagedBufferStream.Write(const Buffer; Count: Integer): Integer;
var
  bw, c: Int64;
  bp: Pointer;
begin
  bw:= 0;
  bp:= @Buffer;
  while (bw < Count) do begin
    ReMapBuffer;
    // Wie viel Daten können wir schreiben?
    c:= Min(Count - bw, Length(FBuffer) - (FVirtualPosition-FBufferStart));

    // das schreiben und buffer weiterschieben
    Move(bp^, FBuffer[FVirtualPosition-FBufferStart], c);
    Inc(Bp, c);
    Inc(bw, c);
    Inc(FVirtualPosition, c);
    if FVirtualPosition > FVirtualSize then
      FVirtualSize:= FVirtualPosition;
  end;      
  if bw > 0 then
    FBufferModified:= true;
  Result:= bw;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlPagedBufferStream.Seek(Offset: Integer; Origin: Word): Integer;
begin
  case Origin of
    soFromBeginning: FVirtualPosition := Offset;
    soFromCurrent: Inc(FVirtualPosition, Offset);
    soFromEnd: FVirtualPosition := Size + Offset;
  end;
  ReMapBuffer;
  Result := FVirtualPosition;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlPagedBufferStream.Create(
  const BaseStream: TStream;
  const BufferSize: Cardinal;
  const aOwnsStream: Boolean);
begin
  inherited Create(BaseStream);
  SourceOwner:= aOwnsStream;
  SetLength(FBuffer, BufferSize);
  FVirtualPosition:= 0;
  FVirtualSize:= Source.Size;
  FBufferStart:= -1;
  ReMapBuffer;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlPagedBufferStream.Destroy;
begin
  FlushBuffer;
  SetLength(FBuffer, 0);
  inherited;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlFIFOStream////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlFIFOStream.GetSize: Int64;
begin
  Result:= fTotalSize;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlFIFOStream.Read(var Buffer; Count: Longint): Longint;
begin
  BeginOperation;
  try
    Result:= Reserve(Buffer, Count);
    Discard(Result);
  finally
    EndOperation;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlFIFOStream.Reserve(var Buffer; Count: Longint): Longint;
var
  pbuf: PByteArray;
  mx: LongInt;
  rp: Int64;
  p: PPage;
begin
  BeginOperation;
  try
    pbuf:= @Buffer;
    Result:= 0;
    rp:= fReadPtr;
    p:= fPageFirst;
    while Count > 0 do begin
      mx:= MAX_PAGE_SIZE - rp;
      if mx > Count then mx:= Count;
      if (p=fPageLast) and (mx > fWritePtr-rp) then mx:= fWritePtr-rp;
      if mx=0 then exit;
      Move(p^.Data[rp], pbuf^[Result], mx);
      inc(rp, mx);
      inc(Result, mx);
      Dec(Count, mx);
      if rp = MAX_PAGE_SIZE then begin
        p:= p^.Next;
        rp:= 0;
      end;
    end;
  finally
    EndOperation;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlFIFOStream.Discard(Count: Longint): Longint;
var
  mx: LongInt;
  n: PPage;
begin
  BeginOperation;
  try
    Result:= 0;
    while Count > 0 do begin
      mx:= MAX_PAGE_SIZE - fReadPtr;
      if mx > Count then mx:= Count;
      if (fPageFirst=fPageLast) and (mx > fWritePtr-fReadPtr) then mx:= fWritePtr-fReadPtr;
      if mx=0 then exit;
      inc(fReadPtr, mx);
      inc(Result, mx);
      dec(Count, mx);
      dec(fTotalSize, mx);
      if fReadPtr=MAX_PAGE_SIZE then begin
        n:= fPageFirst^.Next;
        if Assigned(n) then begin
          Dispose(fPageFirst);
          fPageFirst:= n;
          fReadPtr:= 0;
        end;// else kann nicht passieren, das wird mit (mx > fWritePtr-fReadPtr) und (mx=0) schon bedient
      end;
    end;
  finally
    EndOperation;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlFIFOStream.Write(const Buffer; Count: Longint): Longint;
var
  mx: LongInt;
  pbuf: PByteArray;
begin
  BeginOperation;
  try
    pbuf:= @Buffer;
    Result:= 0;
    while Count > 0 do begin
      mx:= MAX_PAGE_SIZE - fWritePtr;
      if mx > Count then mx:= Count;
      Move(pbuf^[Result], fPageLast^.Data[fWritePtr], mx);
      inc(fWritePtr, mx);
      inc(fTotalSize, mx);
      dec(Count, mx);
      inc(Result, mx);

      if fWritePtr = MAX_PAGE_SIZE then begin
        New(fPageLast^.Next);
        fPageLast:= fPageLast^.Next;
        fPageLast^.Next:= nil;
        fWritePtr:= 0;
      end;
    end;
  finally
    EndOperation;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlFIFOStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
  Result:= 0;
  raise EStreamError.CreateFmt(SStreamInvalidSeek,[ClassName]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlFIFOStream.BeginOperation;
begin
  if not fLockFree then
    fDataLock.Acquire;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlFIFOStream.EndOperation;
begin
  if not fLockFree then
    fDataLock.Release;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlFIFOStream.Clear;
var
  p: PPage;
begin
  BeginOperation;
  try
    while fPageFirst<>fPageLast do begin
      p:= fPageFirst;
      fPageFirst:= fPageFirst^.Next;
      Dispose(p);
    end;
    fTotalSize:= 0;
    fReadPtr:= 0;
    fWritePtr:= 0;
  finally
    EndOperation;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlFIFOStream.Create(const aLockFree: boolean);
begin
  inherited Create;
  fDataLock:= TCriticalSection.Create;
  fTotalSize:= 0;
  New(fPageFirst);
  fPageFirst^.Next:= nil;
  fPageLast:= fPageFirst;
  fReadPtr:= 0;
  fWritePtr:= 0;
  fLockFree:= aLockFree;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlFIFOStream.Destroy;
begin
  Clear;
  Dispose(fPageFirst);
  FreeAndNil(fDataLock);
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlBase64Decoder/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlBase64Decoder.{%H-}Read(var Buffer; Count: Longint): Longint;
begin
  ReadNotImplemented;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlBase64Decoder.Decode(const aOutput: TStream): boolean;
var
  a: Integer;
  x: Integer;
  b: Integer;
  c: AnsiChar;
begin
  Result:= false;
  a := 0;
  b := 0;
  Position:= 0;
  while inherited Read(c{%H-}, sizeof(c)) = sizeof(c) do begin
    x := Pos(c, CODE64) - 1;
    if (x >= 0) then begin
      b := b * 64 + x;
      a := a + 6;
      if a >= 8 then begin
        a := a - 8;
        x := b shr a;
        b := b mod (1 shl a);
        aOutput.WriteByte(x);
      end;
    end else if c = PADDING_CHARACTER then
      break
    else
      Exit;
  end;
  Result:= true;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlBase64Decoder.Create;
begin
  inherited Create('');
end;

end.