|
- 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
- Classes, Contnrs, syncobjs;
-
- type
- TutlFourCC = string[4];
-
- { TutlStreamUtility }
-
- TutlStreamUtility = class
- private
- FStream: TStream;
- FOwnsStream: boolean;
- FPositions: TStack;
- protected
- public
- constructor Create(BaseStream: TStream; OwnsStream: Boolean=false);
- destructor Destroy; override;
- property Stream: TStream read FStream;
- procedure Push;
- procedure Pop;
- procedure Drop;
- end;
-
- { TutlStreamReader }
-
- TutlStreamReader = class(TutlStreamUtility)
- protected
- function ReadBuffer(Var Buffer; Size: int64): int64;
- public
- function ReadFourCC: TutlFourCC;
- function CheckFourCC(Correct: TutlFourCC): boolean;
- function ReadByte: Byte;
- function ReadWord: Word;
- function ReadCardinal: Cardinal;
- function ReadInteger: Integer;
- function ReadInt64: Int64;
- function ReadSingle: Single;
- function ReadDouble: Double;
- function ReadAnsiString: AnsiString;
- function ReadLine: AnsiString;
- function IsEOF: boolean;
- end;
-
- { TutlStreamWriter }
-
- TutlStreamWriter = class(TutlStreamUtility)
- protected
- procedure WriteBuffer(var Data; Size: int64);
- public
- procedure WriteFourCC(FCC: TutlFourCC);
- procedure WriteByte(A: Byte);
- procedure WriteWord(A: Word);
- procedure WriteCardinal(A: Cardinal);
- procedure WriteInteger(A: Integer);
- procedure WriteInt64(A: Int64);
- procedure WriteSingle(A: Single);
- procedure WriteDouble(A: Double);
- procedure WriteAnsiString(A: AnsiString);
- procedure WriteAnsiBytes(A: AnsiString);
- procedure WriteLine(A: AnsiString);
- end;
-
- { TutlReadBufferStream }
-
- TutlReadBufferStream = class(TStream)
- private
- FBaseStream: TStream;
- FBuffer: Pointer;
- FBufferValid: boolean;
- FBufferStart, FBufferLen, FBufferAvail: Int64;
- FPosition: int64;
- protected
- function GetSize: Int64; override;
- procedure SetSize(const NewSize: Int64); override;
- public
- constructor Create(const BaseStream: TStream; const BufferSize: Cardinal);
- destructor Destroy; override;
- function Read(var Buffer; Count: Integer): Integer; override;
- function Write(const Buffer; Count: Integer): Integer; override;
- function Seek(Offset: Integer; Origin: Word): Integer; override;
- end;
-
- { TutlFIFOStream }
-
- 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
- constructor Create(const aLockFree: boolean = false);
- destructor Destroy; override;
- 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;
- property LockFree: boolean read fLockFree;
- end;
-
- TutlBase64Decoder = class(TStringStream)
- public const
- CODE64 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
- PADDING_CHARACTER = '=';
- protected
- public
- function Read(var Buffer; Count: Longint): Longint; override;
- function Decode(const aOutput: TStream): boolean;
- constructor Create;
- end;
-
- implementation
-
- uses SysUtils,RtlConsts, uutlExceptions;
-
- type
- TPositionData = class
- Position: Int64;
- constructor Create(Pos: Int64);
- end;
-
- constructor TPositionData.Create(Pos: Int64);
- begin
- inherited Create;
- Position:= Pos;
- end;
-
- { TutlStreamUtility }
-
- constructor TutlStreamUtility.Create(BaseStream: TStream; OwnsStream: Boolean);
- begin
- inherited Create;
- FStream:= BaseStream;
- FOwnsStream:= OwnsStream;
- FPositions:= TStack.Create;
- end;
-
- destructor TutlStreamUtility.Destroy;
- begin
- if FOwnsStream then
- FreeAndNil(FStream)
- else
- FStream:= nil;
- while FPositions.AtLeast(1) do
- TPositionData(FPositions.Pop).Free;
- FreeAndNil(FPositions);
- inherited;
- end;
-
- procedure TutlStreamUtility.Pop;
- var
- p: TPositionData;
- begin
- p:= TPositionData(FPositions.Pop);
- FStream.Position:= p.Position;
- p.Free;
- end;
-
- procedure TutlStreamUtility.Drop;
- var
- p: TPositionData;
- begin
- p:= TPositionData(FPositions.Pop);
- if Assigned(p) then
- p.Free;
- end;
-
- procedure TutlStreamUtility.Push;
- begin
- FPositions.Push(TPositionData.Create(FStream.Position));
- 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(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;
- 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:= FStream.Read(Result[rl + 1], READ_LENGTH);
- inc(rl, r);
- EOF:= r <> READ_LENGTH;
- cp:= @Result[rp];
- end;
-
- begin
- Result:= '';
- rl:= 0;
- bpos:= FStream.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;
- FStream.Position:= bpos;
- SetLength(Result, rp-1);
- Exit;
- end;
- inc(cp);
- inc(rp);
- end;
- until EOF;
- SetLength(Result, rl);
- 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;
-
- { TutlReadBufferStream }
-
- constructor TutlReadBufferStream.Create(const BaseStream: TStream; const BufferSize: Cardinal);
- begin
- inherited Create;
- FBaseStream:= BaseStream;
- FBufferLen:= BufferSize;
- FBuffer:= GetMemory(FBufferLen);
- FPosition:= 0;
- end;
-
- destructor TutlReadBufferStream.Destroy;
- begin
- FBufferValid:= false;
- //FBaseStream.Free;
- FreeMemory(FBuffer);
- inherited;
- end;
-
- function TutlReadBufferStream.Seek(Offset: Integer; Origin: Word): Integer;
- begin
- case Origin of
- soFromBeginning: FPosition := Offset;
- soFromCurrent: Inc(FPosition, Offset);
- soFromEnd: FPosition := Size + Offset;
- end;
- Result := FPosition;
- end;
-
- function TutlReadBufferStream.GetSize: Int64;
- begin
- Result:= FBaseStream.Size;
- end;
-
- procedure TutlReadBufferStream.SetSize(const NewSize: Int64);
- begin
- FBaseStream.Size:= NewSize;
- end;
-
- function TutlReadBufferStream.Write(const Buffer; Count: Integer): Integer;
- begin
- FBufferValid:= false;
- FBaseStream.Position:= FPosition;
- Result:= FBaseStream.Write(Buffer, Count);
- FPosition:= FBaseStream.Position;
- end;
-
- function TutlReadBufferStream.Read(var Buffer; Count: Integer): Integer;
- var
- rp, br, c: Int64;
- bp: Pointer;
- begin
- br:= 0;
- bp:= @Buffer;
- while (br < Count) and (FPosition<Size) do begin
- // Welches Buffer-Segment wird gesucht?
- rp:= (FPosition div FBufferLen) * FBufferLen;
- // ist das das aktuelle?
- if not FBufferValid or (FBufferStart <> rp) then begin
- // Segment holen
- FBaseStream.Position:= rp;
- FBufferAvail:= FBaseStream.Read(FBuffer^, FBufferLen);
- FBufferStart:= rp;
- FBufferValid:= true;
- end;
-
- // Wie viel Daten daraus brauchen wir bzw. können wir kriegen?
- c:= Count - br;
- if c > FBufferAvail - (FPosition-FBufferStart) then
- c:= FBufferAvail - (FPosition-FBufferStart);
-
- // das rausholen und buffer weiterschieben
- {$IFDEF FPC}
- // FPC: kein Cast, direkt mit Pointer in richtiger Größe rechnen
- Move(Pointer(FBuffer + (FPosition-FBufferStart))^, bp^, c);
- Inc(Bp, c);
- {$ELSE}
- // Delphi ist eh nur i386, also fix 32bit
- Move(Pointer(Cardinal(FBuffer) + (FPosition-FBufferStart))^, bp^, c);
- Inc(Cardinal(Bp), c);
- {$ENDIF}
- Inc(br, c);
- Inc(FPosition, c);
- end;
- Result:= br;
- end;
-
- { TutlFIFOStream }
-
- 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;
- var
- p,q: PPage;
- begin
- BeginOperation;
- try
- fTotalSize:= 0;
- fReadPtr:= 0;
- fWritePtr:= 0;
- p:= fPageFirst;
- while p<>nil do begin
- q:= p;
- p:= p^.Next;
- Dispose(q);
- end;
- finally
- EndOperation;
- end;
- FreeAndNil(fDataLock);
- inherited Destroy;
- end;
-
- 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;
-
- { 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.
|