Changeset 18


Ignore:
Timestamp:
May 14, 2010, 6:57:22 AM (14 years ago)
Author:
george
Message:
  • Upraveno: Při dekódování pokud je v prvním bajtu obsahujícím unární délku nulová datová hodnota, tak se tato nula nevloží do výsledného bloku dat. Díky tomu kódovaná hodnota 00 se dekóduje jako prázdný řetězec.
  • Přidáno: Funkce pro čtení surového bloku v struktuře record dle indexu položky.
  • Přidáno: Funkce pro zabalení a rozbalení bloku.
File:
1 edited

Legend:

Unmodified
Added
Removed
  • VarIntSerializer/UVarIntSerializer.pas

    r17 r18  
    33unit UVarIntSerializer;
    44
    5 {$mode delphi}{$H+}
     5{$mode Delphi}{$H+}
     6
     7// One recursive VarInt size level supported
     8// Biggest UInt type is QWord (64-bit)
    69
    710interface
     
    1821
    1922  TVarIntSerializer = class(TMemoryStreamEx)
     23  private
     24    procedure TrimLeft;
     25    function GetUnaryLengthMask(Length: Integer): Byte;
     26    function DecodeUnaryLength(Data: Byte): Integer;
     27  public
    2028    // Base
    2129    procedure WriteVarUInt(Value: QWord);
    2230    function ReadVarUInt: QWord;
    23     procedure WriteVarIntStream(Stream: TMemoryStream);
    24     procedure ReadVarIntStream(Stream: TMemoryStream);
     31    procedure WriteVarBlock(Stream: TStream);
     32    procedure ReadVarBlock(Stream: TStream);
     33    function GetVarSize: Integer;
    2534
    2635    // Advanced data types
     
    3241    function ReadVarString: string;
    3342
     43    // Misc methods
    3444    function TestMask(Mask, BitIndex: Integer): Boolean;
     45    procedure ReadItemByMaskIndex(Index: Integer; Data: TVarIntSerializer);
     46    procedure BlockEnclose;
     47    procedure BlockUnclose;
    3548    constructor Create;
    3649  end;
     
    4053{ TVarIntSerializer }
    4154
     55procedure TVarIntSerializer.TrimLeft;
     56var
     57  Temp: TVarIntSerializer;
     58  Length: Integer;
     59  Data: Byte;
     60begin
     61  Temp := TVarIntSerializer.Create;
     62  Position := 0;
     63  Length := Size * 8;
     64  Data := 0;
     65  while (Length > 0) and
     66  (((Data shr (Length and 7)) and 1) = 0) do begin
     67    Data := ReadByte;
     68    Dec(Length); // set 7. bit in byte
     69    while (((Data shr (Length and 7)) and 1) = 0) and ((Length and 7) > 0) do
     70      Dec(Length);
     71  end;
     72  Inc(Length);
     73  Length := Ceil(Length / 8);
     74  Position := Size - Length;
     75  ReadStream(TStream(Temp), Length);
     76  Clear;
     77  Position := 0;
     78  WriteStream(Temp, Temp.Size);
     79end;
     80
     81function TVarIntSerializer.GetUnaryLengthMask(Length: Integer): Byte;
     82begin
     83  Result := ((1 shl (BitAlignment - Length)) - 1) xor $ff;
     84end;
     85
     86function TVarIntSerializer.DecodeUnaryLength(Data:Byte):Integer;
     87begin
     88  Result := 1;
     89  while (((Data shr (BitAlignment - Result)) and 1) = 1) and
     90    (Result < (BitAlignment + 1)) do Inc(Result);
     91end;
     92
    4293procedure TVarIntSerializer.WriteVarUInt(Value: QWord);
    4394var
     
    4596  Data: Byte;
    4697  I: Integer;
     98  LengthMask: Byte;
    4799begin
    48100  // Get bit length
    49   Length := 31;
     101  Length := SizeOf(QWord) * BitAlignment;
    50102  while (((Value shr Length) and 1) = 0) and (Length > 0) do
    51103    Dec(Length);
    52104  Inc(Length);
    53105  Length := Ceil(Length / (BitAlignment - 1));
     106  LengthMask := GetUnaryLengthMask(Length);
    54107
    55108  // Copy data
    56109  for I := Length downto 1 do begin
    57     Data := (Value shr (8 * (I - 1))) and $ff;
    58     //ShowMessage(IntToStr(Length) + ' ' + IntToHex(Data, 2));
    59     if I = Length then Data := Data and
    60       ((1 shl (BitAlignment - Length)) - 1)
    61       or (((1 shl (BitAlignment - Length + 1)) - 1) xor $ff);
     110    Data := (Value shr (BitAlignment * (I - 1))) and $ff;
     111    if I = Length then Data := (Data and
     112      (LengthMask xor $ff)) or ((LengthMask shl 1) and $ff);
    62113    WriteByte(Data);
    63     //ShowMessage(IntToStr(Length) + ' ' + IntToHex(Data, 2));
    64114  end;
    65115end;
     
    70120  Length: Integer;
    71121  I: Integer;
     122  LengthMask: Byte;
    72123begin
    73124  Result := 0;
     
    77128    Data := ReadByte;
    78129    if I = 0 then begin
    79       Length := 1;
    80       while ((Data shr (BitAlignment - Length)) = 1) and (Length < 9) do
    81         Inc(Length);
    82       if Length > 8 then raise Exception.Create('VarInt 64-bit read overflow');
    83       Data := Data and ((1 shl (BitAlignment - Length)) - 1);
     130      Length := DecodeUnaryLength(Data);
     131      if Length > (BitAlignment - 1) then raise Exception.Create('64-bit UInt read overflow');
     132      LengthMask := GetUnaryLengthMask(Length);
     133      Data := Data and (LengthMask xor $ff);
    84134    end;
    85     Result := Result or (Data shl ((Length - I - 1) * 8));
     135    Result := Result or (Data shl ((Length - I - 1) * BitAlignment));
    86136    Inc(I);
    87137  end;
     
    124174  for I := 1 to Length(Value) do
    125175    Stream.WriteVarUInt(Integer(Value[I]));
    126   WriteVarIntStream(Stream);
     176  WriteVarBlock(Stream);
    127177  Stream.Destroy;
    128178end;
     
    134184begin
    135185  Stream := TVarIntSerializer.Create;
    136   ReadVarIntStream(Stream);
     186  ReadVarBlock(Stream);
    137187  Stream.Position := 0;
    138188  while Stream.Position < Stream.Size do begin
     
    143193end;
    144194
    145 procedure TVarIntSerializer.WriteVarIntStream(Stream: TMemoryStream);
    146 var
    147   Length: Byte; // Count of data bytes
    148   Data: Byte;
    149   I: Cardinal;
    150 begin
    151   // Get bit length
     195procedure TVarIntSerializer.WriteVarBlock(Stream: TStream);
     196var
     197  Length: Integer; // Count of data bytes
     198  Data: Byte;
     199  I: Integer;
     200  LengthMask: Byte;
     201begin
    152202  Stream.Position := 0;
    153   if Stream.Size < 8 then begin
    154     // Unary length
    155     Length := Stream.Size * 8;
    156     Data := 0;
    157     while (Length > 0) and
    158     (((Data shr (Length and 7)) and 1) = 0) do begin
    159       Data := Stream.ReadByte;
    160       Dec(Length); // set 7. bit in byte
    161       while (((Data shr (Length and 7)) and 1) = 0) and ((Length and 7) > 0) do
    162         Dec(Length);
    163     end;
    164     Inc(Length);
    165     Length := Ceil(Length / (BitAlignment - 1));
    166   end else Length := Stream.Size + 1; // Recursive length
     203  Length := Stream.Size;
    167204
    168205  // Copy data
    169   Stream.Position := 0;
    170   for I := Length downto 1 do begin
    171     if I <= Stream.Size then Data := Stream.ReadByte
     206  if Length = 0 then WriteByte(0)
     207  else begin
     208    if Stream.Size > 0 then Data := Stream.ReadByte
    172209      else Data := 0;
    173     if I = Length then begin
    174       if Length < 8 then begin
    175         Data := Data and
    176         ((1 shl (BitAlignment - Length)) - 1)
    177         or (((1 shl (BitAlignment - Length + 1)) - 1) xor $ff);
     210    if (Length < BitAlignment) then begin
     211      LengthMask := GetUnaryLengthMask(Length);
     212      if ((Data and (LengthMask xor $ff)) <> Data) or (Data = 0) then begin
     213        // First data starts by zero or
     214        // first data byte not fit to length byte
     215        Inc(Length);
     216        if Length < 8 then begin
     217          LengthMask := GetUnaryLengthMask(Length);
     218          WriteByte((LengthMask shl 1) and $ff);
     219          WriteByte(Data);
     220        end;
    178221      end else begin
    179         // Recursive length
    180         WriteByte($ff);
    181         WriteVarUInt(Length - 8);
    182         Continue;
     222        // First data byte fit to length byte
     223        WriteByte((Data and (LengthMask xor $ff)) or ((LengthMask shl 1) and $ff));
    183224      end;
    184225    end;
    185     WriteByte(Data);
    186   end;
    187 end;
    188 
    189 procedure TVarIntSerializer.ReadVarIntStream(Stream: TMemoryStream);
     226    if Length >= BitAlignment then begin
     227      // Recursive length
     228      WriteByte($ff);
     229      WriteVarUInt(Stream.Size);
     230      WriteByte(Data);
     231    end;
     232
     233    // Copy rest of data
     234    for I := 1 to Stream.Size - 1 do begin
     235      if I < Stream.Size then Data := Stream.ReadByte
     236        else Data := 0;
     237      WriteByte(Data);
     238    end;
     239  end;
     240end;
     241
     242procedure TVarIntSerializer.ReadVarBlock(Stream: TStream);
    190243var
    191244  Data: Byte;
    192245  Length: Cardinal;
    193246  I: Cardinal;
    194 begin
    195   Stream.Clear;
     247  LengthMask: Byte;
     248begin
     249  Stream.Size := 0;
     250  I := 0;
    196251  Length := 1;
    197   I := 0;
    198252  while I < Length do begin
    199253    Data := ReadByte;
    200254    if I = 0 then begin
    201       Length := 1;
    202       while (((Data shr (BitAlignment - Length)) and 1) = 1) and (Length < 9) do
    203         Inc(Length);
    204       if Length > 8 then begin
     255      if Data = $ff then begin
    205256        // Read recursive length
    206         Length := ReadVarUInt + 8;
    207         Inc(I);
    208         Continue;
    209       end else Data := Data and ((1 shl (BitAlignment - Length)) - 1);
    210       Stream.Size := Length;
    211     end;
    212     Stream.WriteByte(Data);
     257        Length := ReadVarUInt;
     258        Stream.Size := Length;
     259        Data := ReadByte;
     260        Stream.WriteByte(Data);
     261      end else begin
     262        // Read unary length
     263        Length := DecodeUnaryLength(Data);
     264        Stream.Size := Length;
     265        LengthMask := GetUnaryLengthMask(Length);
     266        Data := Data and (LengthMask xor $ff);
     267        // Drop first byte if first data zero
     268        if Data <> 0 then Stream.WriteByte(Data)
     269          else begin
     270            Dec(Length);
     271            Stream.Size := Length;
     272            if Length > 0 then begin
     273              Data := ReadByte;
     274              Stream.WriteByte(Data);
     275            end;
     276          end;
     277      end;
     278    end else Stream.WriteByte(Data);
    213279    Inc(I);
    214280  end;
     
    216282end;
    217283
     284function TVarIntSerializer.GetVarSize: Integer;
     285var
     286  Data: Byte;
     287  I: Cardinal;
     288  StoredPosition: Integer;
     289begin
     290  StoredPosition := Position;
     291  Result := 1; // Byte block length
     292  Data := ReadByte;
     293  if Data = $ff then Result := ReadVarUInt + 2
     294  else begin
     295    Result := DecodeUnaryLength(Data);
     296  end;
     297  Position := StoredPosition;
     298end;
     299
    218300procedure TVarIntSerializer.WriteVarSInt(Value: Int64);
    219301begin
    220   if Value < 0 then WriteVarUInt((Abs(Value) shl 1) - 1)
    221     else WriteVarUInt((Abs(Value) shl 1))
     302  if Value < 0 then WriteVarUInt(((-Value) shl 1) - 1)
     303    else WriteVarUInt((Value shl 1))
    222304end;
    223305
     
    234316end;
    235317
     318procedure TVarIntSerializer.ReadItemByMaskIndex(Index:Integer;Data:
     319  TVarIntSerializer);
     320var
     321  Mask: Integer;
     322  I: Integer;
     323begin
     324  Position := 0;
     325  Mask := ReadVarUInt;
     326  I := 0;
     327  while (Position < Size) and (I < Index) do begin
     328    if TestMask(Mask, I) then Position := Position + GetVarSize;
     329    Inc(I);
     330  end;
     331  if TestMask(Mask, Index) then
     332    ReadStream(TStream(Data), GetVarSize);
     333end;
     334
     335procedure TVarIntSerializer.BlockEnclose;
     336var
     337  Temp: TVarIntSerializer;
     338begin
     339  Temp := TVarIntSerializer.Create;
     340  Temp.WriteStream(Self, Size);
     341  Clear;
     342  WriteVarBlock(Temp);
     343  Temp.Destroy;
     344end;
     345
     346procedure TVarIntSerializer.BlockUnclose;
     347var
     348  Temp: TVarIntSerializer;
     349begin
     350  Temp := TVarIntSerializer.Create;
     351  ReadVarBlock(Temp);
     352  Clear;
     353  WriteStream(Temp, Temp.Size);
     354  Temp.Destroy;
     355  Position := 0;
     356end;
     357
    236358constructor TVarIntSerializer.Create;
    237359begin
Note: See TracChangeset for help on using the changeset viewer.