Changeset 18
- Timestamp:
- May 14, 2010, 6:57:22 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
VarIntSerializer/UVarIntSerializer.pas
r17 r18 3 3 unit UVarIntSerializer; 4 4 5 {$mode delphi}{$H+} 5 {$mode Delphi}{$H+} 6 7 // One recursive VarInt size level supported 8 // Biggest UInt type is QWord (64-bit) 6 9 7 10 interface … … 18 21 19 22 TVarIntSerializer = class(TMemoryStreamEx) 23 private 24 procedure TrimLeft; 25 function GetUnaryLengthMask(Length: Integer): Byte; 26 function DecodeUnaryLength(Data: Byte): Integer; 27 public 20 28 // Base 21 29 procedure WriteVarUInt(Value: QWord); 22 30 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; 25 34 26 35 // Advanced data types … … 32 41 function ReadVarString: string; 33 42 43 // Misc methods 34 44 function TestMask(Mask, BitIndex: Integer): Boolean; 45 procedure ReadItemByMaskIndex(Index: Integer; Data: TVarIntSerializer); 46 procedure BlockEnclose; 47 procedure BlockUnclose; 35 48 constructor Create; 36 49 end; … … 40 53 { TVarIntSerializer } 41 54 55 procedure TVarIntSerializer.TrimLeft; 56 var 57 Temp: TVarIntSerializer; 58 Length: Integer; 59 Data: Byte; 60 begin 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); 79 end; 80 81 function TVarIntSerializer.GetUnaryLengthMask(Length: Integer): Byte; 82 begin 83 Result := ((1 shl (BitAlignment - Length)) - 1) xor $ff; 84 end; 85 86 function TVarIntSerializer.DecodeUnaryLength(Data:Byte):Integer; 87 begin 88 Result := 1; 89 while (((Data shr (BitAlignment - Result)) and 1) = 1) and 90 (Result < (BitAlignment + 1)) do Inc(Result); 91 end; 92 42 93 procedure TVarIntSerializer.WriteVarUInt(Value: QWord); 43 94 var … … 45 96 Data: Byte; 46 97 I: Integer; 98 LengthMask: Byte; 47 99 begin 48 100 // Get bit length 49 Length := 31;101 Length := SizeOf(QWord) * BitAlignment; 50 102 while (((Value shr Length) and 1) = 0) and (Length > 0) do 51 103 Dec(Length); 52 104 Inc(Length); 53 105 Length := Ceil(Length / (BitAlignment - 1)); 106 LengthMask := GetUnaryLengthMask(Length); 54 107 55 108 // Copy data 56 109 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); 62 113 WriteByte(Data); 63 //ShowMessage(IntToStr(Length) + ' ' + IntToHex(Data, 2));64 114 end; 65 115 end; … … 70 120 Length: Integer; 71 121 I: Integer; 122 LengthMask: Byte; 72 123 begin 73 124 Result := 0; … … 77 128 Data := ReadByte; 78 129 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); 84 134 end; 85 Result := Result or (Data shl ((Length - I - 1) * 8));135 Result := Result or (Data shl ((Length - I - 1) * BitAlignment)); 86 136 Inc(I); 87 137 end; … … 124 174 for I := 1 to Length(Value) do 125 175 Stream.WriteVarUInt(Integer(Value[I])); 126 WriteVar IntStream(Stream);176 WriteVarBlock(Stream); 127 177 Stream.Destroy; 128 178 end; … … 134 184 begin 135 185 Stream := TVarIntSerializer.Create; 136 ReadVar IntStream(Stream);186 ReadVarBlock(Stream); 137 187 Stream.Position := 0; 138 188 while Stream.Position < Stream.Size do begin … … 143 193 end; 144 194 145 procedure TVarIntSerializer.WriteVar IntStream(Stream: TMemoryStream);146 var 147 Length: Byte; // Count of data bytes148 Data: Byte; 149 I: Cardinal;150 begin 151 // Get bit length 195 procedure TVarIntSerializer.WriteVarBlock(Stream: TStream); 196 var 197 Length: Integer; // Count of data bytes 198 Data: Byte; 199 I: Integer; 200 LengthMask: Byte; 201 begin 152 202 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; 167 204 168 205 // Copy data 169 Stream.Position := 0;170 for I := Length downto 1 dobegin171 if I <= Stream.Sizethen Data := Stream.ReadByte206 if Length = 0 then WriteByte(0) 207 else begin 208 if Stream.Size > 0 then Data := Stream.ReadByte 172 209 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; 178 221 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)); 183 224 end; 184 225 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; 240 end; 241 242 procedure TVarIntSerializer.ReadVarBlock(Stream: TStream); 190 243 var 191 244 Data: Byte; 192 245 Length: Cardinal; 193 246 I: Cardinal; 194 begin 195 Stream.Clear; 247 LengthMask: Byte; 248 begin 249 Stream.Size := 0; 250 I := 0; 196 251 Length := 1; 197 I := 0;198 252 while I < Length do begin 199 253 Data := ReadByte; 200 254 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 205 256 // 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); 213 279 Inc(I); 214 280 end; … … 216 282 end; 217 283 284 function TVarIntSerializer.GetVarSize: Integer; 285 var 286 Data: Byte; 287 I: Cardinal; 288 StoredPosition: Integer; 289 begin 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; 298 end; 299 218 300 procedure TVarIntSerializer.WriteVarSInt(Value: Int64); 219 301 begin 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)) 222 304 end; 223 305 … … 234 316 end; 235 317 318 procedure TVarIntSerializer.ReadItemByMaskIndex(Index:Integer;Data: 319 TVarIntSerializer); 320 var 321 Mask: Integer; 322 I: Integer; 323 begin 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); 333 end; 334 335 procedure TVarIntSerializer.BlockEnclose; 336 var 337 Temp: TVarIntSerializer; 338 begin 339 Temp := TVarIntSerializer.Create; 340 Temp.WriteStream(Self, Size); 341 Clear; 342 WriteVarBlock(Temp); 343 Temp.Destroy; 344 end; 345 346 procedure TVarIntSerializer.BlockUnclose; 347 var 348 Temp: TVarIntSerializer; 349 begin 350 Temp := TVarIntSerializer.Create; 351 ReadVarBlock(Temp); 352 Clear; 353 WriteStream(Temp, Temp.Size); 354 Temp.Destroy; 355 Position := 0; 356 end; 357 236 358 constructor TVarIntSerializer.Create; 237 359 begin
Note:
See TracChangeset
for help on using the changeset viewer.