unit Bitstreams;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Math, TypInfo, Generics.Collections;
type
EUnsupportedTypeException = class(Exception);
TStreamList = class(specialize TObjectList<TStream>);
{ TMemoryBitstream }
TMemoryBitstream = class(TStream)
private
FData: PByte;
FPosition: SizeInt;
FSize: SizeInt;
protected
function GetSize: int64; override;
function GetPosition: int64; override;
public
constructor Create(const AData: Pointer; ASize: SizeInt);
function Read(var Buffer; Count: longint): longint; override; overload;
function Seek(const Offset: int64; Origin: TSeekOrigin): int64; override;
overload;
function Seek(Offset: longint; Origin: word): longint; override; overload;
end;
{ TCompositeBitstream }
TCompositeBitstream = class(TStream)
private
FElementStreams: TStreamList;
FPosition: SizeInt;
FSize: SizeInt;
FCurrentElement: SizeInt;
procedure SeekForward(Offset: SizeInt);
procedure SeekBackward(Offset: SizeInt);
protected
function GetSize: int64; override;
function GetPosition: int64; override;
public
constructor Create(Substreams: TStreamList; ownsObjects: Boolean=True);
function Read(var Buffer; Count: longint): longint; override; overload;
function Seek(const Offset: int64; Origin: TSeekOrigin): int64; override;
overload;
function Seek(Offset: longint; Origin: word): longint; override; overload;
destructor Destroy; override;
end;
{ TArrayBitstream }
TArrayBitstream = class(TCompositeBitstream)
public
constructor Create(const AData: Pointer; AElementType: PTypeInfo; ACount: SizeInt);
end;
{ TRecordBitstream }
TRecordBitstream = class(TCompositeBitstream)
public
constructor Create(const AData: Pointer; ATypeInfo: PTypeInfo);
end;
function RTTIBitStream(AData: Pointer; ATypeInfo: PTypeInfo; DataSize: SizeInt): TStream;
implementation
function FloatSize(AFloatType: TFloatType): SizeInt; inline;
begin
case AFloatType of
ftSingle: Result := SizeOf(single);
ftDouble: Result := SizeOf(double);
ftExtended: Result := SizeOf(extended);
ftComp: Result := SizeOf(comp);
ftCurr: Result := SizeOf(currency);
end;
end;
function RTTITypeSize(AInfo: PTypeInfo): SizeInt;
var
OrdType: TOrdType;
begin
case AInfo^.Kind of
tkInterface,
tkInterfaceRaw,
tkDynArray,
tkClass,
tkHelper,
tkLString,
tkAString,
tkWString,
tkUString,
tkProcVar,
tkClassRef,
tkPointer:
Result := SizeOf(Pointer);
tkChar, tkBool:
Result := SizeOf(char);
tkWChar, tkUChar:
Result := SizeOf(widechar);
tkSet,
tkEnumeration,
tkInteger:
begin
OrdType := GetTypeData(AInfo)^.OrdType;
case OrdType of
otSByte, otUByte: Result := SizeOf(byte);
otSWord, otUWord: Result := SizeOf(word);
else
Result := SizeOf(integer);
end;
end;
tkInt64, tkQword:
Result := SizeOf(int64);
tkFloat: FloatSize(GetTypeData(AInfo)^.FloatType);
tkMethod: Result := SizeOf(TMethod);
tkSString: Result := SizeOf(ShortString);
tkVariant: Result := SizeOf(variant);
tkArray: Result := GetTypeData(AInfo)^.ArrayData.Size;
tkRecord, tkObject: Result := GetTypeData(AInfo)^.RecSize;
tkFile: Result := SizeOf(TFileRec);
else
raise EUnsupportedTypeException.Create('Type not supported: ' + AInfo^.Name);
end;
end;
function AnsiStringStream(AData: PAnsiString): TStream; inline;
begin
Result := TMemoryBitstream.Create(Pointer(AData^), Length(AData^));
end;
function ShortStringStream(AData: PShortString): TStream; inline;
begin
Result := TMemoryBitstream.Create(Pointer(AData), Length(AData^));
end;
function WideStringStream(AData: PWideString): TStream; inline;
begin
Result := TMemoryBitstream.Create(Pointer(AData^), Length(AData^) * SizeOf(widechar));
end;
function ArrayStream(AData: Pointer; ATypeInfo: PTypeInfo): TStream; inline;
var
TypeData: PTypeData;
begin
TypeData := GetTypeData(ATypeInfo);
Result := TArrayBitstream.Create(AData, TypeData^.ArrayData.ElType,
TypeData^.ArrayData.ElCount);
end;
function DynArrayStream(AData: PPointer; ATypeInfo: PTypeInfo): TStream; inline;
var
TypeData: PTypeData;
begin
TypeData := GetTypeData(ATypeInfo);
Result := TArrayBitstream.Create(AData^, TypeData^.ElType, DynArraySize(AData^));
end;
function RTTIBitStream(AData: Pointer; ATypeInfo: PTypeInfo; DataSize: SizeInt): TStream;
begin
case ATypeInfo^.Kind of
tkSString: Result := ShortStringStream(AData);
tkLString,
tkAString: Result := AnsiStringStream(AData);
tkWString,
tkUString: Result := WideStringStream(AData);
tkRecord: Result := TRecordBitstream.Create(AData, ATypeInfo);
tkArray: Result := ArrayStream(AData, ATypeInfo);
tkDynArray: Result := DynArrayStream(AData, ATypeInfo);
tkObject, tkHelper, tkFile, tkClassRef, tkPointer, tkInterface, tkClass, tkInterfaceRaw:
raise EUnsupportedTypeException.Create('Type not supported: ' + ATypeInfo^.Name);
else
Result := TMemoryBitstream.Create(AData, DataSize);
end;
end;
{ TRecordBitstream }
constructor TRecordBitstream.Create(const AData: Pointer; ATypeInfo: PTypeInfo);
var
TypeData: PTypeData;
i: Integer;
EStreams: TStreamList;
FieldArray: PManagedField;
FieldData: Pointer;
FieldType: PTypeInfo;
FieldSize: SizeInt;
begin
TypeData := GetTypeData(ATypeInfo);
EStreams := TStreamList.Create(False);
try
FieldArray := @(TypeData^.TotalFieldCount) + SizeOf(TypeData^.TotalFieldCount);
for i:=0 to TypeData^.TotalFieldCount-1 do
begin
FieldData := AData + FieldArray[i].FldOffset;
FieldType := FieldArray[i].TypeRef;
FieldSize := RTTITypeSize(FieldType);
EStreams.Add(RTTIBitStream(FieldData, FieldType, FieldSize));
end;
inherited Create(EStreams);
finally
EStreams.Free;
end;
end;
{ TArrayBitstream }
constructor TArrayBitstream.Create(const AData: Pointer;
AElementType: PTypeInfo; ACount: SizeInt);
var
EStreams: TStreamList;
i, ElemSize: SizeInt;
begin
ElemSize := RTTITypeSize(AElementType);
EStreams := TStreamList.Create(False);
try
for i:=0 to ACount-1 do
EStreams.Add(RTTIBitStream(AData + ElemSize*i, AElementType, ElemSize));
inherited Create(EStreams);
finally
EStreams.Free;
end;
end;
{ TCompositeBitstream }
procedure TCompositeBitstream.SeekForward(Offset: SizeInt);
var
CurrStream: TStream;
streamMove: SizeInt;
begin
while (Offset > 0) and (FPosition < FSize) do
begin
Currstream := FElementStreams[FCurrentElement];
if CurrStream.Position >= CurrStream.Size then
begin
inc(FCurrentElement);
Continue;
end;
streamMove := Min(Offset, CurrStream.Size - CurrStream.Position);
CurrStream.Seek(streamMove, soCurrent);
FPosition += streamMove;
Offset -= streamMove;
end;
end;
procedure TCompositeBitstream.SeekBackward(Offset: SizeInt);
var
CurrStream: TStream;
streamMove: SizeInt;
begin
while (Offset > 0) and (FPosition > 0) do
begin
Currstream := FElementStreams[FCurrentElement];
if CurrStream.Position <= 0 then
begin
Dec(FCurrentElement);
Continue;
end;
streamMove := Min(Offset, CurrStream.Position);
CurrStream.Seek(streamMove*-1, soCurrent);
FPosition -= streamMove;
Offset -= streamMove;
end;
end;
function TCompositeBitstream.GetSize: int64;
begin
Result := FSize;
end;
function TCompositeBitstream.GetPosition: int64;
begin
Result := FPosition;
end;
constructor TCompositeBitstream.Create(Substreams: TStreamList;
ownsObjects: Boolean);
var
EStream: TStream;
begin
FElementStreams := TStreamList.Create(Substreams, ownsObjects);
FPosition:=0;
FCurrentElement:=0;
FSize := 0;
for EStream in FElementStreams do
FSize += EStream.Size;
end;
function TCompositeBitstream.Read(var Buffer; Count: longint): longint;
var
CurrStream: TStream;
BytesRead: LongInt;
begin
Result := 0;
while (Result < Count) and (FPosition < FSize) do
begin
Currstream := FElementStreams[FCurrentElement];
if CurrStream.Position >= CurrStream.Size then
begin
inc(FCurrentElement);
Continue;
end;
BytesRead := CurrStream.Read(PByte(@Buffer)[Result], Count-Result);
FPosition += BytesRead;
Result += BytesRead;
end;
end;
function TCompositeBitstream.Seek(const Offset: int64; Origin: TSeekOrigin): int64;
var
toMove: SizeInt;
begin
case Origin of
soBeginning: toMove := Offset - FPosition;
soCurrent: toMove:=Offset;
soEnd: toMove:=(FSize-Offset) - FPosition;
end;
if toMove > 0 then
SeekForward(toMove)
else if toMove < 0 then
SeekBackward(toMove * -1);
Result := FPosition;
end;
function TCompositeBitstream.Seek(Offset: longint; Origin: word): longint;
begin
Result := Seek(Int64(Offset), TSeekOrigin(Origin));
end;
destructor TCompositeBitstream.Destroy;
begin
FElementStreams.Free;
inherited Destroy;
end;
{ TMemoryBitstream }
function TMemoryBitstream.GetSize: int64;
begin
Result := FSize;
end;
function TMemoryBitstream.GetPosition: int64;
begin
Result := FPosition;
end;
constructor TMemoryBitstream.Create(const AData: Pointer; ASize: SizeInt);
begin
FData := AData;
FPosition := 0;
FSize := ASize;
end;
function TMemoryBitstream.Read(var Buffer; Count: longint): longint;
begin
Result := Min(Count, FSize - FPosition);
Move(PByte(FData)[FPosition], Buffer, Result);
Inc(FPosition, Result);
end;
function TMemoryBitstream.Seek(const Offset: int64; Origin: TSeekOrigin): int64;
begin
case Origin of
soBeginning: FPosition := Min(Offset, FSize);
soCurrent: FPosition := Min(FPosition + Offset, FSize);
soEnd: FPosition := Max(FSize - Offset, 0);
end;
Result := FPosition;
end;
function TMemoryBitstream.Seek(Offset: longint; Origin: word): longint;
begin
Result := Seek(int64(Offset), TSeekOrigin(Origin));
end;
end.