|
- 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.
|