Ignore:
Timestamp:
Jan 5, 2011, 7:58:26 AM (14 years ago)
Author:
george
Message:
  • Added: Unit UStreamHelper as replacement to TMemoryStreamEx. Helper class can extend TStream functionality without affecting base class itself.
  • Modified: Class TVarIntSerializer renamed to TVarBlockSerializer as Variable Block is more precise term for serialized elements. Variable integer is special case of Variable block (block with coded variable length).
  • Added: Class TVarBlockIndexed which handle access to indexed items in VarBlocks. It Use first item in block as BitArray field which determine presence of rest of items.
File:
1 moved

Legend:

Unmodified
Added
Removed

  • VarBlockSerializer/UVarBlockSerializer.pas

    r113 r116  
    11// 2010-03-30
    22
    3 unit UVarIntSerializer;
     3unit UVarBlockSerializer;
    44
    55{$mode Delphi}{$H+}
    … …  
    1111
    1212uses
    13   Classes, DateUtils, UMemoryStreamEx, Math, Dialogs, SysUtils, USubStream;
     13  Classes, DateUtils, UStreamHelper, Math, Dialogs, SysUtils, USubStream,
     14  Contnrs, SpecializedList;
    1415
    1516const
    … …  
    1819
    1920type
    20   { TVarIntSerializer }
    21 
    22   TVarIntSerializer = class(TMemoryStreamEx)
     21
     22  { TVarBlockSerializer }
     23
     24  TVarBlockSerializer = class
    2325  private
     26    FStream: TStream;
     27    procedure SetStream(const AValue: TStream);
    2428    procedure TrimLeft;
    2529    function GetUnaryLengthMask(Length: Integer): Byte;
    2630    function DecodeUnaryLength(Data: Byte): Integer;
    2731  public
     32    OwnsStream: Boolean;
     33
    2834    // Base
    2935    procedure WriteVarUInt(Value: QWord);
    3036    function ReadVarUInt: QWord;
    31     procedure WriteVarBlock(Stream: TStream);
    32     procedure ReadVarBlock(Stream: TStream);
     37    procedure WriteVarBlock(Block: TVarBlockSerializer);
     38    procedure ReadVarBlock(Block: TVarBlockSerializer);
     39    procedure WriteVarStream(AStream: TStream);
     40    procedure ReadVarStream(AStream: TStream);
    3341    function GetVarSize: Integer;
    3442
    … …  
    4351    // Misc methods
    4452    function TestMask(Mask: QWord; BitIndex: Byte): Boolean;
    45     procedure ReadItemByMaskIndex(Index: Integer; Data: TVarIntSerializer);
     53    function BuildMask(Bits: array of Integer): Integer;
     54    procedure ReadItemByMaskIndex(Index: Integer; Data: TVarBlockSerializer);
    4655    procedure ReadItemRefByMaskIndex(Index: Integer; Data: TSubStream);
    4756    procedure BlockEnclose;
    4857    procedure BlockUnclose;
    4958    constructor Create;
     59    destructor Destroy; override;
     60    property Stream: TStream read FStream write SetStream;
     61  end;
     62
     63  { TVarBlockIndexed }
     64
     65  TVarBlockIndexed = class
     66  private
     67  public
     68    Items: TObjectList; // TObjectList<TVarBlockSerializer>
     69    Enclose: Boolean;
     70    procedure CheckItem(Index: Integer);
     71
     72    // Base
     73    procedure WriteVarUInt(Index: Integer; Value: QWord);
     74    function ReadVarUInt(Index: Integer): QWord;
     75    procedure WriteVarBlock(Index: Integer; Block: TVarBlockSerializer);
     76    procedure ReadVarBlock(Index: Integer; Block: TVarBlockSerializer);
     77    procedure WriteVarStream(Index: Integer; Stream: TStream);
     78    procedure ReadVarStream(Index: Integer; Stream: TStream);
     79    procedure WriteVarIndexedBlock(Index: Integer; Block: TVarBlockIndexed);
     80    procedure ReadVarIndexedBlock(Index: Integer; Block: TVarBlockIndexed);
     81
     82    // Advanced data types
     83    procedure WriteVarSInt(Index: Integer; Value: Int64);
     84    function ReadVarSInt(Index: Integer): Int64;
     85    procedure WriteVarFloat(Index: Integer; Value: Double);
     86    function ReadVarFloat(Index: Integer): Double;
     87    procedure WriteVarString(Index: Integer; Value: string);
     88    function ReadVarString(Index: Integer): string;
     89    procedure WriteVarIntegerArray(Index: Integer; List: TListInteger);
     90    procedure ReadVarIntegerArray(Index: Integer; List: TListInteger);
     91
     92    procedure Clear;
     93    function TestIndex(Index: Integer): Boolean;
     94    procedure WriteToVarBlock(Stream: TVarBlockSerializer);
     95    procedure ReadFromVarBlock(Stream: TVarBlockSerializer);
     96    procedure WriteToStream(Stream: TStream);
     97    procedure ReadFromStream(Stream: TStream);
     98    constructor Create;
     99    destructor Destroy; override;
    50100  end;
    51101
    52102implementation
    53103
    54 { TVarIntSerializer }
    55 
    56 procedure TVarIntSerializer.TrimLeft;
    57 var
    58   Temp: TVarIntSerializer;
     104resourcestring
     105  SMaskedValueReadError = 'Error reading masked variable length block.';
     106  SUInt64Overflow = '64-bit UInt read overflow.';
     107
     108{ TVarBlockSerializer }
     109
     110procedure TVarBlockSerializer.TrimLeft;
     111var
     112  Temp: TVarBlockSerializer;
    59113  Length: Integer;
    60114  Data: Byte;
    61 begin
    62   Temp := TVarIntSerializer.Create;
    63   Position := 0;
    64   Length := Size * 8;
    65   Data := 0;
    66   while (Length > 0) and
    67   (((Data shr (Length and 7)) and 1) = 0) do begin
    68     Data := ReadByte;
    69     Dec(Length); // set 7. bit in byte
    70     while (((Data shr (Length and 7)) and 1) = 0) and ((Length and 7) > 0) do
    71       Dec(Length);
    72   end;
    73   Inc(Length);
    74   Length := Ceil(Length / 8);
    75   Position := Size - Length;
    76   ReadStream(TStream(Temp), Length);
    77   Clear;
    78   Position := 0;
    79   WriteStream(Temp, Temp.Size);
    80 end;
    81 
    82 function TVarIntSerializer.GetUnaryLengthMask(Length: Integer): Byte;
     115  StreamHelper: TStreamHelper;
     116begin
     117  try
     118    Temp := TVarBlockSerializer.Create;
     119    Stream.Position := 0;
     120    Length := Stream.Size * 8;
     121    Data := 0;
     122    while (Length > 0) and
     123    (((Data shr (Length and 7)) and 1) = 0) do begin
     124      Data := Stream.ReadByte;
     125      Dec(Length); // set 7. bit in byte
     126      while (((Data shr (Length and 7)) and 1) = 0) and ((Length and 7) > 0) do
     127        Dec(Length);
     128    end;
     129    Inc(Length);
     130    Length := Ceil(Length / 8);
     131    Stream.Position := Stream.Size - Length;
     132    StreamHelper := TStreamHelper.Create(Stream);
     133    StreamHelper.ReadStream(Temp.Stream, Length);
     134    Temp.Stream.Size := 0;
     135    Stream.Position := 0;
     136    StreamHelper.WriteStream(Temp.Stream, Temp.Stream.Size);
     137  finally
     138    StreamHelper.Free;
     139    Temp.Free;
     140  end;
     141end;
     142
     143procedure TVarBlockSerializer.SetStream(const AValue: TStream);
     144begin
     145  if OwnsStream and Assigned(FStream) then
     146    FStream.Free;
     147  OwnsStream := False;
     148  FStream := AValue;
     149end;
     150
     151function TVarBlockSerializer.GetUnaryLengthMask(Length: Integer): Byte;
    83152begin
    84153  Result := ((1 shl (BitAlignment - Length)) - 1) xor $ff;
    85154end;
    86155
    87 function TVarIntSerializer.DecodeUnaryLength(Data:Byte):Integer;
     156function TVarBlockSerializer.DecodeUnaryLength(Data:Byte):Integer;
    88157begin
    89158  Result := 1;
    … …  
    92161end;
    93162
    94 procedure TVarIntSerializer.WriteVarUInt(Value: QWord);
     163procedure TVarBlockSerializer.WriteVarUInt(Value: QWord);
    95164var
    96165  Length: Byte;
    … …  
    112181    if I = Length then Data := (Data and
    113182      (LengthMask xor $ff)) or ((LengthMask shl 1) and $ff);
    114     WriteByte(Data);
    115   end;
    116 end;
    117 
    118 function TVarIntSerializer.ReadVarUInt: QWord;
     183    Stream.WriteByte(Data);
     184  end;
     185end;
     186
     187function TVarBlockSerializer.ReadVarUInt: QWord;
    119188var
    120189  Data: Byte;
    … …  
    127196  I := 0;
    128197  while I < Length do begin
    129     Data := ReadByte;
     198    Data := Stream.ReadByte;
    130199    if I = 0 then begin
    131200      Length := DecodeUnaryLength(Data);
    132       if Length > (BitAlignment - 1) then raise Exception.Create('64-bit UInt read overflow');
     201      if Length > (BitAlignment) then
     202        raise Exception.Create(SUInt64Overflow);
    133203      LengthMask := GetUnaryLengthMask(Length);
    134204      Data := Data and (LengthMask xor $ff);
    135205    end;
    136     Result := Result or (Data shl ((Length - I - 1) * BitAlignment));
     206    Result := Result or (QWord(Data) shl ((Length - I - 1) * BitAlignment));
    137207    Inc(I);
    138208  end;
    139209end;
    140210
    141 procedure TVarIntSerializer.WriteVarFloat(Value: Double);
     211procedure TVarBlockSerializer.WriteVarBlock(Block: TVarBlockSerializer);
     212begin
     213  WriteVarStream(Block.Stream);
     214end;
     215
     216procedure TVarBlockSerializer.ReadVarBlock(Block: TVarBlockSerializer);
     217begin
     218  ReadVarStream(Block.Stream);
     219end;
     220
     221procedure TVarBlockSerializer.WriteVarFloat(Value: Double);
    142222var
    143223  Exponent: Integer;
    144 begin
    145   // Normalize to integer number with base 10 exponent
    146   Exponent := 0;
    147   while Frac(Value) > 0 do begin
    148     Value := Value * RealBase;
    149     Dec(Exponent);
    150   end;
    151   while Frac(Value / RealBase) = 0 do begin
    152     Value := Value / RealBase;
    153     Inc(Exponent);
    154   end;
    155   WriteVarSInt(Trunc(Value));
    156   WriteVarSInt(Exponent);
    157 end;
    158 
    159 function TVarIntSerializer.ReadVarFloat: Double;
     224  Block: TVarBlockSerializer;
     225begin
     226  try
     227    Block := TVarBlockSerializer.Create;
     228
     229    // Normalize to integer number with base 10 exponent
     230    Exponent := 0;
     231    while Frac(Value) > 0 do begin
     232      Value := Value * RealBase;
     233      Dec(Exponent);
     234    end;
     235    while Frac(Value / RealBase) = 0 do begin
     236      Value := Value / RealBase;
     237      Inc(Exponent);
     238    end;
     239    Block.WriteVarSInt(Trunc(Value));
     240    Block.WriteVarSInt(Exponent);
     241    WriteVarBlock(Block);
     242  finally
     243    Block.Free;
     244  end;
     245end;
     246
     247function TVarBlockSerializer.ReadVarFloat: Double;
    160248var
    161249  Significant: Int64;
    162250  Exponent: Integer;
    163 begin
    164   Significant := ReadVarSInt;
    165   Exponent := ReadVarSInt;
    166   Result := Significant * IntPower(RealBase, Exponent);
    167 end;
    168 
    169 procedure TVarIntSerializer.WriteVarString(Value: string);
    170 var
    171   Stream: TVarIntSerializer;
    172   I: Integer;
    173 begin
    174   Stream := TVarIntSerializer.Create;
    175   for I := 1 to Length(Value) do
    176     Stream.WriteVarUInt(Integer(Value[I]));
    177   WriteVarBlock(Stream);
    178   Stream.Destroy;
    179 end;
    180 
    181 function TVarIntSerializer.ReadVarString: string;
    182 var
    183   Stream: TVarIntSerializer;
     251  Block: TVarBlockSerializer;
     252begin
     253  try
     254    Block := TVarBlockSerializer.Create;
     255    ReadVarBlock(Block);
     256    Significant := Block.ReadVarSInt;
     257    Exponent := Block.ReadVarSInt;
     258    Result := Significant * IntPower(RealBase, Exponent);
     259  finally
     260    Block.Free;
     261  end;
     262end;
     263
     264procedure TVarBlockSerializer.WriteVarString(Value: string);
     265var
     266  Stream: TVarBlockSerializer;
     267  I: Integer;
     268begin
     269  try
     270    Stream := TVarBlockSerializer.Create;
     271    for I := 1 to Length(Value) do
     272      Stream.WriteVarUInt(Integer(Value[I]));
     273    WriteVarBlock(Stream);
     274  finally
     275    Stream.Free;
     276  end;
     277end;
     278
     279function TVarBlockSerializer.ReadVarString: string;
     280var
     281  Block: TVarBlockSerializer;
    184282  Character: Integer;
    185283begin
    186   Stream := TVarIntSerializer.Create;
    187   ReadVarBlock(Stream);
    188   Stream.Position := 0;
    189   while Stream.Position < Stream.Size do begin
    190     Character := Stream.ReadVarUInt;
    191     Result := Result + Char(Character);
    192   end;
    193   Stream.Destroy;
    194 end;
    195 
    196 procedure TVarIntSerializer.WriteVarBlock(Stream: TStream);
     284  try
     285    Block := TVarBlockSerializer.Create;
     286    ReadVarBlock(Block);
     287    Block.Stream.Position := 0;
     288    while Block.Stream.Position < Block.Stream.Size do begin
     289      Character := Block.ReadVarUInt;
     290      Result := Result + Char(Character);
     291    end;
     292  finally
     293    Block.Free;
     294  end;
     295end;
     296
     297procedure TVarBlockSerializer.WriteVarStream(AStream: TStream);
    197298var
    198299  Length: Integer; // Count of data bytes
    … …  
    201302  LengthMask: Byte;
    202303begin
    203   Stream.Position := 0;
    204   Length := Stream.Size;
     304  AStream.Position := 0;
     305  Length := AStream.Size;
    205306
    206307  // Copy data
    207   if Length = 0 then WriteByte(0)
     308  if Length = 0 then Stream.WriteByte(0)
    208309  else begin
    209     if Stream.Size > 0 then Data := Stream.ReadByte
     310    if AStream.Size > 0 then Data := AStream.ReadByte
    210311      else Data := 0;
    211312    if (Length < BitAlignment) then begin
    … …  
    217318        if Length < 8 then begin
    218319          LengthMask := GetUnaryLengthMask(Length);
    219           WriteByte((LengthMask shl 1) and $ff);
    220           WriteByte(Data);
     320          Stream.WriteByte((LengthMask shl 1) and $ff);
     321          Stream.WriteByte(Data);
    221322        end;
    222323      end else begin
    223324        // First data byte fit to length byte
    224         WriteByte((Data and (LengthMask xor $ff)) or ((LengthMask shl 1) and $ff));
     325        Stream.WriteByte((Data and (LengthMask xor $ff)) or ((LengthMask shl 1) and $ff));
    225326      end;
    226327    end;
    227328    if Length >= BitAlignment then begin
    228329      // Recursive length
    229       WriteByte($ff);
    230       WriteVarUInt(Stream.Size);
    231       WriteByte(Data);
     330      Stream.WriteByte($ff);
     331      WriteVarUInt(AStream.Size);
     332      Stream.WriteByte(Data);
    232333    end;
    233334
    234335    // Copy rest of data
    235     for I := 1 to Stream.Size - 1 do begin
    236       if I < Stream.Size then Data := Stream.ReadByte
     336    for I := 1 to AStream.Size - 1 do begin
     337      if I < AStream.Size then Data := AStream.ReadByte
    237338        else Data := 0;
    238       WriteByte(Data);
    239     end;
    240   end;
    241 end;
    242 
    243 procedure TVarIntSerializer.ReadVarBlock(Stream: TStream);
     339      Stream.WriteByte(Data);
     340    end;
     341  end;
     342end;
     343
     344procedure TVarBlockSerializer.ReadVarStream(AStream: TStream);
    244345var
    245346  Data: Byte;
    … …  
    248349  LengthMask: Byte;
    249350begin
    250   Stream.Size := 0;
     351  AStream.Size := 0;
    251352  I := 0;
    252353  Length := 1;
    253354  while I < Length do begin
    254     Data := ReadByte;
     355    Data := Stream.ReadByte;
    255356    if I = 0 then begin
    256357      if Data = $ff then begin
    257358        // Read recursive length
    258359        Length := ReadVarUInt;
    259         Stream.Size := Length;
    260         Data := ReadByte;
    261         Stream.WriteByte(Data);
     360        AStream.Size := Length;
     361        Data := Stream.ReadByte;
     362        AStream.WriteByte(Data);
    262363      end else begin
    263364        // Read unary length
    264365        Length := DecodeUnaryLength(Data);
    265         Stream.Size := Length;
     366        AStream.Size := Length;
    266367        LengthMask := GetUnaryLengthMask(Length);
    267368        Data := Data and (LengthMask xor $ff);
    268369        // Drop first byte if first data zero
    269         if Data <> 0 then Stream.WriteByte(Data)
     370        if Data <> 0 then AStream.WriteByte(Data)
    270371          else begin
    271372            Dec(Length);
    272             Stream.Size := Length;
     373            AStream.Size := Length;
    273374            if Length > 0 then begin
    274               Data := ReadByte;
    275               Stream.WriteByte(Data);
     375              Data := Stream.ReadByte;
     376              AStream.WriteByte(Data);
    276377            end;
    277378          end;
    278379      end;
    279     end else Stream.WriteByte(Data);
     380    end else AStream.WriteByte(Data);
    280381    Inc(I);
    281382  end;
    282   Stream.Position := 0;
    283 end;
    284 
    285 function TVarIntSerializer.GetVarSize: Integer;
     383  AStream.Position := 0;
     384end;
     385
     386function TVarBlockSerializer.GetVarSize: Integer;
    286387var
    287388  Data: Byte;
    288389  StoredPosition: Integer;
    289390begin
    290   StoredPosition := Position;
     391  StoredPosition := Stream.Position;
    291392  Result := 1; // Byte block length
    292   Data := ReadByte;
     393  Data := Stream.ReadByte;
    293394  if Data = $ff then Result := ReadVarUInt + 2
    294395  else begin
    295396    Result := DecodeUnaryLength(Data);
    296397  end;
    297   Position := StoredPosition;
    298 end;
    299 
    300 procedure TVarIntSerializer.WriteVarSInt(Value: Int64);
     398  Stream.Position := StoredPosition;
     399end;
     400
     401procedure TVarBlockSerializer.WriteVarSInt(Value: Int64);
    301402begin
    302403  if Value < 0 then WriteVarUInt(((-Value) shl 1) - 1)
    … …  
    304405end;
    305406
    306 function TVarIntSerializer.ReadVarSInt: Int64;
     407function TVarBlockSerializer.ReadVarSInt: Int64;
    307408begin
    308409  Result := ReadVarUInt;
    … …  
    311412end;
    312413
    313 function TVarIntSerializer.TestMask(Mask: QWord; BitIndex: Byte): Boolean;
     414function TVarBlockSerializer.TestMask(Mask: QWord; BitIndex: Byte): Boolean;
    314415begin
    315416  Result := ((Mask shr BitIndex) and 1) = 1;
    316417end;
    317418
    318 procedure TVarIntSerializer.ReadItemByMaskIndex(Index:Integer;Data:
    319   TVarIntSerializer);
     419function TVarBlockSerializer.BuildMask(Bits:array of Integer):Integer;
     420var
     421  I: Integer;
     422begin
     423  Result := 0;
     424  for I := 0 to High(Bits) do
     425    Result := Result or (1 shl Bits[I]);
     426end;
     427
     428procedure TVarBlockSerializer.ReadItemByMaskIndex(Index:Integer; Data:
     429  TVarBlockSerializer);
    320430var
    321431  Mask: Integer;
    322432  I: Integer;
    323 begin
    324   Position := 0;
    325   Data.Size := 0;
    326   Mask := ReadVarUInt;
     433  StreamHelper: TStreamHelper;
     434begin
     435  try
     436    StreamHelper := TStreamHelper.Create(Stream);
     437    try
     438      Stream.Position := 0;
     439      Data.Stream.Size := 0;
     440      Mask := ReadVarUInt;
     441      I := 0;
     442      while (Stream.Position < Stream.Size) and (I < Index) do begin
     443        if TestMask(Mask, I) then Stream.Position := Stream.Position + GetVarSize;
     444        Inc(I);
     445      end;
     446      if TestMask(Mask, Index) then
     447        StreamHelper.ReadStream(Data.Stream, GetVarSize);
     448    except
     449      raise Exception.Create(SMaskedValueReadError);
     450    end;
     451  finally
     452    StreamHelper.Free;
     453    Data.Stream.Position := 0;
     454  end;
     455end;
     456
     457procedure TVarBlockSerializer.ReadItemRefByMaskIndex(Index:Integer;Data:TSubStream
     458  );
     459var
     460  Mask: Integer;
     461  I: Integer;
     462begin
     463  try
     464    Stream.Position := 0;
     465    Data.Size := 0;
     466    Mask := ReadVarUInt;
     467    I := 0;
     468    while (Stream.Position < Stream.Size) and (I < Index) do begin
     469      if TestMask(Mask, I) then Stream.Position := Stream.Position + GetVarSize;
     470      Inc(I);
     471    end;
     472    if TestMask(Mask, Index) then begin
     473      if Stream is TSubStream then begin
     474        // Recalculate substream
     475        Data.Source := TSubStream(Stream).Source;
     476        Data.SourcePosition := TSubStream(Stream).SourcePosition + Stream.Position;
     477      end else begin
     478        Data.Source := Self.Stream;
     479        Data.SourcePosition := Stream.Position;
     480      end;
     481      Data.Size := GetVarSize;
     482    end;
     483    Data.Position := 0;
     484  except
     485    raise Exception.Create(SMaskedValueReadError);
     486  end;
     487end;
     488
     489procedure TVarBlockSerializer.BlockEnclose;
     490var
     491  Temp: TVarBlockSerializer;
     492  StreamHelper: TStreamHelper;
     493begin
     494  try
     495    Temp := TVarBlockSerializer.Create;
     496    StreamHelper := TStreamHelper.Create(Temp.Stream);
     497    StreamHelper.WriteStream(Stream, Stream.Size);
     498    Stream.Size := 0;
     499    WriteVarBlock(Temp);
     500  finally
     501    StreamHelper.Free;
     502    Temp.Free;
     503  end;
     504end;
     505
     506procedure TVarBlockSerializer.BlockUnclose;
     507var
     508  Temp: TVarBlockSerializer;
     509  StreamHelper: TStreamHelper;
     510begin
     511  try
     512    Temp := TVarBlockSerializer.Create;
     513    StreamHelper := TStreamHelper.Create(Stream);
     514    ReadVarBlock(Temp);
     515    Stream.Size := 0;
     516    StreamHelper.WriteStream(Temp.Stream, Temp.Stream.Size);
     517  finally
     518    Stream.Position := 0;
     519    StreamHelper.Free;
     520    Temp.Free;
     521  end;
     522end;
     523
     524constructor TVarBlockSerializer.Create;
     525begin
     526  inherited Create;
     527  Stream := TStreamHelper.Create;
     528  OwnsStream := True;
     529  TStreamHelper(Stream).Endianness := enBig;
     530end;
     531
     532destructor TVarBlockSerializer.Destroy;
     533begin
     534  if OwnsStream then begin
     535    Stream.Free;
     536  end;
     537  inherited Destroy;
     538end;
     539
     540{ TVarBlockIndexed }
     541
     542procedure TVarBlockIndexed.CheckItem(Index:Integer);
     543begin
     544  if Items.Count > Index then begin
     545    if not Assigned(Items[Index]) then
     546      Items[Index] := TVarBlockSerializer.Create;
     547    TVarBlockSerializer(Items[Index]).Stream.Size := 0;
     548  end else begin
     549    Items.Count := Index + 1;
     550    Items[Index] := TVarBlockSerializer.Create;
     551  end;
     552end;
     553
     554procedure TVarBlockIndexed.WriteVarUInt(Index:Integer;Value:QWord);
     555begin
     556  CheckItem(Index);
     557  TVarBlockSerializer(Items[Index]).WriteVarUInt(Value);
     558end;
     559
     560function TVarBlockIndexed.ReadVarUInt(Index:Integer):QWord;
     561begin
     562  TVarBlockSerializer(Items[Index]).Stream.Position := 0;
     563  Result := TVarBlockSerializer(Items[Index]).ReadVarUInt;
     564end;
     565
     566procedure TVarBlockIndexed.WriteVarBlock(Index: Integer; Block: TVarBlockSerializer);
     567begin
     568  CheckItem(Index);
     569  TVarBlockSerializer(Items[Index]).WriteVarBlock(Block);
     570end;
     571
     572procedure TVarBlockIndexed.ReadVarBlock(Index: Integer; Block: TVarBlockSerializer);
     573begin
     574  TVarBlockSerializer(Items[Index]).Stream.Position := 0;
     575  TVarBlockSerializer(Items[Index]).ReadVarBlock(Block);
     576end;
     577
     578procedure TVarBlockIndexed.WriteVarStream(Index: Integer; Stream: TStream);
     579begin
     580  CheckItem(Index);
     581  TVarBlockSerializer(Items[Index]).WriteVarStream(Stream);
     582end;
     583
     584procedure TVarBlockIndexed.ReadVarStream(Index: Integer; Stream: TStream);
     585begin
     586  TVarBlockSerializer(Items[Index]).Stream.Position := 0;
     587  TVarBlockSerializer(Items[Index]).ReadVarStream(Stream);
     588end;
     589
     590procedure TVarBlockIndexed.WriteVarIndexedBlock(Index: Integer;
     591  Block: TVarBlockIndexed);
     592var
     593  Temp: TStreamHelper;
     594begin
     595  try
     596    Temp := TStreamHelper.Create;
     597    Block.Enclose := False;
     598    Block.WriteToStream(Temp);
     599    WriteVarStream(Index, Temp);
     600  finally
     601    Temp.Free;
     602  end;
     603end;
     604
     605procedure TVarBlockIndexed.ReadVarIndexedBlock(Index: Integer;
     606  Block: TVarBlockIndexed);
     607var
     608  Temp: TStreamHelper;
     609begin
     610  try
     611    Temp := TStreamHelper.Create;
     612    Block.Enclose := False;
     613    ReadVarStream(Index, Temp);
     614    Block.ReadFromStream(Temp);
     615  finally
     616    Temp.Free;
     617  end;
     618end;
     619
     620procedure TVarBlockIndexed.WriteVarSInt(Index: Integer; Value:Int64);
     621begin
     622  CheckItem(Index);
     623  TVarBlockSerializer(Items[Index]).WriteVarSInt(Value);
     624end;
     625
     626function TVarBlockIndexed.ReadVarSInt(Index: Integer): Int64;
     627begin
     628  TVarBlockSerializer(Items[Index]).Stream.Position := 0;
     629  Result := TVarBlockSerializer(Items[Index]).ReadVarSInt;
     630end;
     631
     632procedure TVarBlockIndexed.WriteVarFloat(Index: Integer; Value:Double);
     633begin
     634  CheckItem(Index);
     635  TVarBlockSerializer(Items[Index]).WriteVarFloat(Value);
     636end;
     637
     638function TVarBlockIndexed.ReadVarFloat(Index: Integer):Double;
     639begin
     640  TVarBlockSerializer(Items[Index]).Stream.Position := 0;
     641  Result := TVarBlockSerializer(Items[Index]).ReadVarFloat;
     642end;
     643
     644procedure TVarBlockIndexed.WriteVarString(Index: Integer; Value:string);
     645begin
     646  CheckItem(Index);
     647  TVarBlockSerializer(Items[Index]).WriteVarString(Value);
     648end;
     649
     650function TVarBlockIndexed.ReadVarString(Index: Integer):string;
     651begin
     652  TVarBlockSerializer(Items[Index]).Stream.Position := 0;
     653  Result := TVarBlockSerializer(Items[Index]).ReadVarString;
     654end;
     655
     656procedure TVarBlockIndexed.WriteVarIntegerArray(Index: Integer;
     657  List: TListInteger);
     658var
     659  I: Integer;
     660  Temp: TVarBlockSerializer;
     661begin
     662  try
     663    Temp := TVarBlockSerializer.Create;
     664    for I := 0 to List.Count - 1 do
     665      Temp.WriteVarUInt(Integer(List[I]));
     666    WriteVarBlock(Index, Temp);
     667  finally
     668    Temp.Free;
     669  end;
     670end;
     671
     672procedure TVarBlockIndexed.ReadVarIntegerArray(Index: Integer;
     673  List: TListInteger);
     674var
     675  Temp: TVarBlockSerializer;
     676begin
     677  try
     678    Temp := TVarBlockSerializer.Create;
     679    List.Clear;
     680    ReadVarBlock(Index, Temp);
     681    while Temp.Stream.Position < Temp.Stream.Size do begin
     682      List.Add(Temp.ReadVarUInt);
     683    end;
     684  finally
     685    Temp.Free;
     686  end;
     687end;
     688
     689procedure TVarBlockIndexed.Clear;
     690begin
     691  Items.Clear;
     692end;
     693
     694function TVarBlockIndexed.TestIndex(Index:Integer):Boolean;
     695begin
     696  if (Index >= 0) and (Index < Items.Count) then
     697    Result := Assigned(Items[Index])
     698    else Result := False
     699end;
     700
     701procedure TVarBlockIndexed.WriteToVarBlock(Stream: TVarBlockSerializer);
     702var
     703  Mask: Integer;
     704  I: Integer;
     705  StreamHelper: TStreamHelper;
     706begin
     707  try
     708    StreamHelper := TStreamHelper.Create(Stream.Stream);
     709    Stream.Stream.Size := 0;
     710    Mask := 0;
     711    for I := 0 to Items.Count - 1 do
     712      if Assigned(Items[I]) then Mask := Mask or (1 shl I);
     713    Stream.WriteVarUInt(Mask);
     714    for I := 0 to Items.Count - 1 do
     715      if Assigned(Items[I]) then StreamHelper.WriteStream(TVarBlockSerializer(Items[I]).Stream,
     716        TVarBlockSerializer(Items[I]).Stream.Size);
     717    if Enclose then Stream.BlockEnclose;
     718  finally
     719    StreamHelper.Free;
     720  end;
     721end;
     722
     723procedure TVarBlockIndexed.ReadFromVarBlock(Stream: TVarBlockSerializer);
     724var
     725  Mask: Integer;
     726  I: Integer;
     727begin
     728  if Enclose then Stream.BlockUnclose;
     729  Stream.Stream.Position := 0;
     730  Mask := Stream.ReadVarUInt;
    327731  I := 0;
    328   while (Position < Size) and (I < Index) do begin
    329     if TestMask(Mask, I) then Position := Position + GetVarSize;
     732  while Mask <> 0 do begin
     733    if Stream.TestMask(Mask, I) then begin
     734      if Items.Count <= I then Items.Count := I + 1;
     735      Items[I] := TVarBlockSerializer.Create;
     736      Stream.ReadItemByMaskIndex(I, TVarBlockSerializer(Items[I]));
     737      Mask := Mask xor (1 shl I); // Clear bit on current index
     738    end;
    330739    Inc(I);
    331740  end;
    332   if TestMask(Mask, Index) then
    333     ReadStream(TStream(Data), GetVarSize);
    334   Data.Position := 0;
    335 end;
    336 
    337 procedure TVarIntSerializer.ReadItemRefByMaskIndex(Index:Integer;Data:TSubStream
    338   );
    339 var
    340   Mask: Integer;
    341   I: Integer;
    342 begin
    343   Position := 0;
    344   Data.Size := 0;
    345   Mask := ReadVarUInt;
    346   I := 0;
    347   while (Position < Size) and (I < Index) do begin
    348     if TestMask(Mask, I) then Position := Position + GetVarSize;
    349     Inc(I);
    350   end;
    351   if TestMask(Mask, Index) then begin
    352     if TStream(Self) is TSubStream then begin
    353       // Recalculate substream
    354       Data.Source := TSubStream(Self).Source;
    355       Data.SourcePosition := TSubStream(Self).SourcePosition + Position;
    356     end else begin
    357       Data.Source := Self;
    358       Data.SourcePosition := Position;
    359     end;
    360     Data.Size := GetVarSize;
    361   end;
    362   Data.Position := 0;
    363 end;
    364 
    365 procedure TVarIntSerializer.BlockEnclose;
    366 var
    367   Temp: TVarIntSerializer;
    368 begin
    369   Temp := TVarIntSerializer.Create;
    370   Temp.WriteStream(Self, Size);
    371   Clear;
    372   WriteVarBlock(Temp);
    373   Temp.Destroy;
    374 end;
    375 
    376 procedure TVarIntSerializer.BlockUnclose;
    377 var
    378   Temp: TVarIntSerializer;
    379 begin
    380   Temp := TVarIntSerializer.Create;
    381   ReadVarBlock(Temp);
    382   Clear;
    383   WriteStream(Temp, Temp.Size);
    384   Temp.Destroy;
    385   Position := 0;
    386 end;
    387 
    388 constructor TVarIntSerializer.Create;
    389 begin
    390   inherited Create;
    391   Endianness := enBig;
     741end;
     742
     743procedure TVarBlockIndexed.WriteToStream(Stream: TStream);
     744var
     745  Temp: TVarBlockSerializer;
     746  StreamHelper: TStreamHelper;
     747begin
     748  try
     749    Temp := TVarBlockSerializer.Create;
     750    StreamHelper := TStreamHelper.Create(Stream);
     751    WriteToVarBlock(Temp);
     752    StreamHelper.WriteStream(Temp.Stream, Temp.Stream.Size);
     753  finally
     754    StreamHelper.Free;
     755    Temp.Free;
     756  end;
     757end;
     758
     759procedure TVarBlockIndexed.ReadFromStream(Stream: TStream);
     760var
     761  VarBlock: TVarBlockSerializer;
     762begin
     763  try
     764    VarBlock := TVarBlockSerializer.Create;
     765    VarBlock.Stream := Stream;
     766    ReadFromVarBlock(VarBlock);
     767  finally
     768    VarBlock.Free;
     769  end;
     770end;
     771
     772constructor TVarBlockIndexed.Create;
     773begin
     774  Items := TObjectList.Create;
     775  Enclose := True;
     776end;
     777
     778destructor TVarBlockIndexed.Destroy;
     779begin
     780  Items.Free;
     781  inherited Destroy;
    392782end;
    393783
Note: See TracChangeset for help on using the changeset viewer.