Changeset 116
- Timestamp:
- Jan 5, 2011, 7:58:26 AM (14 years ago)
- Location:
- VarBlockSerializer
- Files:
-
- 2 added
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
VarBlockSerializer/UVarBlockSerializer.pas
r113 r116 1 1 // 2010-03-30 2 2 3 unit UVar IntSerializer;3 unit UVarBlockSerializer; 4 4 5 5 {$mode Delphi}{$H+} … … 11 11 12 12 uses 13 Classes, DateUtils, UMemoryStreamEx, Math, Dialogs, SysUtils, USubStream; 13 Classes, DateUtils, UStreamHelper, Math, Dialogs, SysUtils, USubStream, 14 Contnrs, SpecializedList; 14 15 15 16 const … … 18 19 19 20 type 20 { TVarIntSerializer } 21 22 TVarIntSerializer = class(TMemoryStreamEx) 21 22 { TVarBlockSerializer } 23 24 TVarBlockSerializer = class 23 25 private 26 FStream: TStream; 27 procedure SetStream(const AValue: TStream); 24 28 procedure TrimLeft; 25 29 function GetUnaryLengthMask(Length: Integer): Byte; 26 30 function DecodeUnaryLength(Data: Byte): Integer; 27 31 public 32 OwnsStream: Boolean; 33 28 34 // Base 29 35 procedure WriteVarUInt(Value: QWord); 30 36 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); 33 41 function GetVarSize: Integer; 34 42 … … 43 51 // Misc methods 44 52 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); 46 55 procedure ReadItemRefByMaskIndex(Index: Integer; Data: TSubStream); 47 56 procedure BlockEnclose; 48 57 procedure BlockUnclose; 49 58 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; 50 100 end; 51 101 52 102 implementation 53 103 54 { TVarIntSerializer } 55 56 procedure TVarIntSerializer.TrimLeft; 57 var 58 Temp: TVarIntSerializer; 104 resourcestring 105 SMaskedValueReadError = 'Error reading masked variable length block.'; 106 SUInt64Overflow = '64-bit UInt read overflow.'; 107 108 { TVarBlockSerializer } 109 110 procedure TVarBlockSerializer.TrimLeft; 111 var 112 Temp: TVarBlockSerializer; 59 113 Length: Integer; 60 114 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; 116 begin 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; 141 end; 142 143 procedure TVarBlockSerializer.SetStream(const AValue: TStream); 144 begin 145 if OwnsStream and Assigned(FStream) then 146 FStream.Free; 147 OwnsStream := False; 148 FStream := AValue; 149 end; 150 151 function TVarBlockSerializer.GetUnaryLengthMask(Length: Integer): Byte; 83 152 begin 84 153 Result := ((1 shl (BitAlignment - Length)) - 1) xor $ff; 85 154 end; 86 155 87 function TVar IntSerializer.DecodeUnaryLength(Data:Byte):Integer;156 function TVarBlockSerializer.DecodeUnaryLength(Data:Byte):Integer; 88 157 begin 89 158 Result := 1; … … 92 161 end; 93 162 94 procedure TVar IntSerializer.WriteVarUInt(Value: QWord);163 procedure TVarBlockSerializer.WriteVarUInt(Value: QWord); 95 164 var 96 165 Length: Byte; … … 112 181 if I = Length then Data := (Data and 113 182 (LengthMask xor $ff)) or ((LengthMask shl 1) and $ff); 114 WriteByte(Data);115 end; 116 end; 117 118 function TVar IntSerializer.ReadVarUInt: QWord;183 Stream.WriteByte(Data); 184 end; 185 end; 186 187 function TVarBlockSerializer.ReadVarUInt: QWord; 119 188 var 120 189 Data: Byte; … … 127 196 I := 0; 128 197 while I < Length do begin 129 Data := ReadByte;198 Data := Stream.ReadByte; 130 199 if I = 0 then begin 131 200 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); 133 203 LengthMask := GetUnaryLengthMask(Length); 134 204 Data := Data and (LengthMask xor $ff); 135 205 end; 136 Result := Result or ( Datashl ((Length - I - 1) * BitAlignment));206 Result := Result or (QWord(Data) shl ((Length - I - 1) * BitAlignment)); 137 207 Inc(I); 138 208 end; 139 209 end; 140 210 141 procedure TVarIntSerializer.WriteVarFloat(Value: Double); 211 procedure TVarBlockSerializer.WriteVarBlock(Block: TVarBlockSerializer); 212 begin 213 WriteVarStream(Block.Stream); 214 end; 215 216 procedure TVarBlockSerializer.ReadVarBlock(Block: TVarBlockSerializer); 217 begin 218 ReadVarStream(Block.Stream); 219 end; 220 221 procedure TVarBlockSerializer.WriteVarFloat(Value: Double); 142 222 var 143 223 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; 225 begin 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; 245 end; 246 247 function TVarBlockSerializer.ReadVarFloat: Double; 160 248 var 161 249 Significant: Int64; 162 250 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; 252 begin 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; 262 end; 263 264 procedure TVarBlockSerializer.WriteVarString(Value: string); 265 var 266 Stream: TVarBlockSerializer; 267 I: Integer; 268 begin 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; 277 end; 278 279 function TVarBlockSerializer.ReadVarString: string; 280 var 281 Block: TVarBlockSerializer; 184 282 Character: Integer; 185 283 begin 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; 295 end; 296 297 procedure TVarBlockSerializer.WriteVarStream(AStream: TStream); 197 298 var 198 299 Length: Integer; // Count of data bytes … … 201 302 LengthMask: Byte; 202 303 begin 203 Stream.Position := 0;204 Length := Stream.Size;304 AStream.Position := 0; 305 Length := AStream.Size; 205 306 206 307 // Copy data 207 if Length = 0 then WriteByte(0)308 if Length = 0 then Stream.WriteByte(0) 208 309 else begin 209 if Stream.Size > 0 then Data :=Stream.ReadByte310 if AStream.Size > 0 then Data := AStream.ReadByte 210 311 else Data := 0; 211 312 if (Length < BitAlignment) then begin … … 217 318 if Length < 8 then begin 218 319 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); 221 322 end; 222 323 end else begin 223 324 // 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)); 225 326 end; 226 327 end; 227 328 if Length >= BitAlignment then begin 228 329 // Recursive length 229 WriteByte($ff);230 WriteVarUInt( Stream.Size);231 WriteByte(Data);330 Stream.WriteByte($ff); 331 WriteVarUInt(AStream.Size); 332 Stream.WriteByte(Data); 232 333 end; 233 334 234 335 // Copy rest of data 235 for I := 1 to Stream.Size - 1 do begin236 if I < Stream.Size then Data :=Stream.ReadByte336 for I := 1 to AStream.Size - 1 do begin 337 if I < AStream.Size then Data := AStream.ReadByte 237 338 else Data := 0; 238 WriteByte(Data);239 end; 240 end; 241 end; 242 243 procedure TVar IntSerializer.ReadVarBlock(Stream: TStream);339 Stream.WriteByte(Data); 340 end; 341 end; 342 end; 343 344 procedure TVarBlockSerializer.ReadVarStream(AStream: TStream); 244 345 var 245 346 Data: Byte; … … 248 349 LengthMask: Byte; 249 350 begin 250 Stream.Size := 0;351 AStream.Size := 0; 251 352 I := 0; 252 353 Length := 1; 253 354 while I < Length do begin 254 Data := ReadByte;355 Data := Stream.ReadByte; 255 356 if I = 0 then begin 256 357 if Data = $ff then begin 257 358 // Read recursive length 258 359 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); 262 363 end else begin 263 364 // Read unary length 264 365 Length := DecodeUnaryLength(Data); 265 Stream.Size := Length;366 AStream.Size := Length; 266 367 LengthMask := GetUnaryLengthMask(Length); 267 368 Data := Data and (LengthMask xor $ff); 268 369 // Drop first byte if first data zero 269 if Data <> 0 then Stream.WriteByte(Data)370 if Data <> 0 then AStream.WriteByte(Data) 270 371 else begin 271 372 Dec(Length); 272 Stream.Size := Length;373 AStream.Size := Length; 273 374 if Length > 0 then begin 274 Data := ReadByte;275 Stream.WriteByte(Data);375 Data := Stream.ReadByte; 376 AStream.WriteByte(Data); 276 377 end; 277 378 end; 278 379 end; 279 end else Stream.WriteByte(Data);380 end else AStream.WriteByte(Data); 280 381 Inc(I); 281 382 end; 282 Stream.Position := 0;283 end; 284 285 function TVar IntSerializer.GetVarSize: Integer;383 AStream.Position := 0; 384 end; 385 386 function TVarBlockSerializer.GetVarSize: Integer; 286 387 var 287 388 Data: Byte; 288 389 StoredPosition: Integer; 289 390 begin 290 StoredPosition := Position;391 StoredPosition := Stream.Position; 291 392 Result := 1; // Byte block length 292 Data := ReadByte;393 Data := Stream.ReadByte; 293 394 if Data = $ff then Result := ReadVarUInt + 2 294 395 else begin 295 396 Result := DecodeUnaryLength(Data); 296 397 end; 297 Position := StoredPosition;298 end; 299 300 procedure TVar IntSerializer.WriteVarSInt(Value: Int64);398 Stream.Position := StoredPosition; 399 end; 400 401 procedure TVarBlockSerializer.WriteVarSInt(Value: Int64); 301 402 begin 302 403 if Value < 0 then WriteVarUInt(((-Value) shl 1) - 1) … … 304 405 end; 305 406 306 function TVar IntSerializer.ReadVarSInt: Int64;407 function TVarBlockSerializer.ReadVarSInt: Int64; 307 408 begin 308 409 Result := ReadVarUInt; … … 311 412 end; 312 413 313 function TVar IntSerializer.TestMask(Mask: QWord; BitIndex: Byte): Boolean;414 function TVarBlockSerializer.TestMask(Mask: QWord; BitIndex: Byte): Boolean; 314 415 begin 315 416 Result := ((Mask shr BitIndex) and 1) = 1; 316 417 end; 317 418 318 procedure TVarIntSerializer.ReadItemByMaskIndex(Index:Integer;Data: 319 TVarIntSerializer); 419 function TVarBlockSerializer.BuildMask(Bits:array of Integer):Integer; 420 var 421 I: Integer; 422 begin 423 Result := 0; 424 for I := 0 to High(Bits) do 425 Result := Result or (1 shl Bits[I]); 426 end; 427 428 procedure TVarBlockSerializer.ReadItemByMaskIndex(Index:Integer; Data: 429 TVarBlockSerializer); 320 430 var 321 431 Mask: Integer; 322 432 I: Integer; 323 begin 324 Position := 0; 325 Data.Size := 0; 326 Mask := ReadVarUInt; 433 StreamHelper: TStreamHelper; 434 begin 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; 455 end; 456 457 procedure TVarBlockSerializer.ReadItemRefByMaskIndex(Index:Integer;Data:TSubStream 458 ); 459 var 460 Mask: Integer; 461 I: Integer; 462 begin 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; 487 end; 488 489 procedure TVarBlockSerializer.BlockEnclose; 490 var 491 Temp: TVarBlockSerializer; 492 StreamHelper: TStreamHelper; 493 begin 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; 504 end; 505 506 procedure TVarBlockSerializer.BlockUnclose; 507 var 508 Temp: TVarBlockSerializer; 509 StreamHelper: TStreamHelper; 510 begin 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; 522 end; 523 524 constructor TVarBlockSerializer.Create; 525 begin 526 inherited Create; 527 Stream := TStreamHelper.Create; 528 OwnsStream := True; 529 TStreamHelper(Stream).Endianness := enBig; 530 end; 531 532 destructor TVarBlockSerializer.Destroy; 533 begin 534 if OwnsStream then begin 535 Stream.Free; 536 end; 537 inherited Destroy; 538 end; 539 540 { TVarBlockIndexed } 541 542 procedure TVarBlockIndexed.CheckItem(Index:Integer); 543 begin 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; 552 end; 553 554 procedure TVarBlockIndexed.WriteVarUInt(Index:Integer;Value:QWord); 555 begin 556 CheckItem(Index); 557 TVarBlockSerializer(Items[Index]).WriteVarUInt(Value); 558 end; 559 560 function TVarBlockIndexed.ReadVarUInt(Index:Integer):QWord; 561 begin 562 TVarBlockSerializer(Items[Index]).Stream.Position := 0; 563 Result := TVarBlockSerializer(Items[Index]).ReadVarUInt; 564 end; 565 566 procedure TVarBlockIndexed.WriteVarBlock(Index: Integer; Block: TVarBlockSerializer); 567 begin 568 CheckItem(Index); 569 TVarBlockSerializer(Items[Index]).WriteVarBlock(Block); 570 end; 571 572 procedure TVarBlockIndexed.ReadVarBlock(Index: Integer; Block: TVarBlockSerializer); 573 begin 574 TVarBlockSerializer(Items[Index]).Stream.Position := 0; 575 TVarBlockSerializer(Items[Index]).ReadVarBlock(Block); 576 end; 577 578 procedure TVarBlockIndexed.WriteVarStream(Index: Integer; Stream: TStream); 579 begin 580 CheckItem(Index); 581 TVarBlockSerializer(Items[Index]).WriteVarStream(Stream); 582 end; 583 584 procedure TVarBlockIndexed.ReadVarStream(Index: Integer; Stream: TStream); 585 begin 586 TVarBlockSerializer(Items[Index]).Stream.Position := 0; 587 TVarBlockSerializer(Items[Index]).ReadVarStream(Stream); 588 end; 589 590 procedure TVarBlockIndexed.WriteVarIndexedBlock(Index: Integer; 591 Block: TVarBlockIndexed); 592 var 593 Temp: TStreamHelper; 594 begin 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; 603 end; 604 605 procedure TVarBlockIndexed.ReadVarIndexedBlock(Index: Integer; 606 Block: TVarBlockIndexed); 607 var 608 Temp: TStreamHelper; 609 begin 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; 618 end; 619 620 procedure TVarBlockIndexed.WriteVarSInt(Index: Integer; Value:Int64); 621 begin 622 CheckItem(Index); 623 TVarBlockSerializer(Items[Index]).WriteVarSInt(Value); 624 end; 625 626 function TVarBlockIndexed.ReadVarSInt(Index: Integer): Int64; 627 begin 628 TVarBlockSerializer(Items[Index]).Stream.Position := 0; 629 Result := TVarBlockSerializer(Items[Index]).ReadVarSInt; 630 end; 631 632 procedure TVarBlockIndexed.WriteVarFloat(Index: Integer; Value:Double); 633 begin 634 CheckItem(Index); 635 TVarBlockSerializer(Items[Index]).WriteVarFloat(Value); 636 end; 637 638 function TVarBlockIndexed.ReadVarFloat(Index: Integer):Double; 639 begin 640 TVarBlockSerializer(Items[Index]).Stream.Position := 0; 641 Result := TVarBlockSerializer(Items[Index]).ReadVarFloat; 642 end; 643 644 procedure TVarBlockIndexed.WriteVarString(Index: Integer; Value:string); 645 begin 646 CheckItem(Index); 647 TVarBlockSerializer(Items[Index]).WriteVarString(Value); 648 end; 649 650 function TVarBlockIndexed.ReadVarString(Index: Integer):string; 651 begin 652 TVarBlockSerializer(Items[Index]).Stream.Position := 0; 653 Result := TVarBlockSerializer(Items[Index]).ReadVarString; 654 end; 655 656 procedure TVarBlockIndexed.WriteVarIntegerArray(Index: Integer; 657 List: TListInteger); 658 var 659 I: Integer; 660 Temp: TVarBlockSerializer; 661 begin 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; 670 end; 671 672 procedure TVarBlockIndexed.ReadVarIntegerArray(Index: Integer; 673 List: TListInteger); 674 var 675 Temp: TVarBlockSerializer; 676 begin 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; 687 end; 688 689 procedure TVarBlockIndexed.Clear; 690 begin 691 Items.Clear; 692 end; 693 694 function TVarBlockIndexed.TestIndex(Index:Integer):Boolean; 695 begin 696 if (Index >= 0) and (Index < Items.Count) then 697 Result := Assigned(Items[Index]) 698 else Result := False 699 end; 700 701 procedure TVarBlockIndexed.WriteToVarBlock(Stream: TVarBlockSerializer); 702 var 703 Mask: Integer; 704 I: Integer; 705 StreamHelper: TStreamHelper; 706 begin 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; 721 end; 722 723 procedure TVarBlockIndexed.ReadFromVarBlock(Stream: TVarBlockSerializer); 724 var 725 Mask: Integer; 726 I: Integer; 727 begin 728 if Enclose then Stream.BlockUnclose; 729 Stream.Stream.Position := 0; 730 Mask := Stream.ReadVarUInt; 327 731 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; 330 739 Inc(I); 331 740 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; 741 end; 742 743 procedure TVarBlockIndexed.WriteToStream(Stream: TStream); 744 var 745 Temp: TVarBlockSerializer; 746 StreamHelper: TStreamHelper; 747 begin 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; 757 end; 758 759 procedure TVarBlockIndexed.ReadFromStream(Stream: TStream); 760 var 761 VarBlock: TVarBlockSerializer; 762 begin 763 try 764 VarBlock := TVarBlockSerializer.Create; 765 VarBlock.Stream := Stream; 766 ReadFromVarBlock(VarBlock); 767 finally 768 VarBlock.Free; 769 end; 770 end; 771 772 constructor TVarBlockIndexed.Create; 773 begin 774 Items := TObjectList.Create; 775 Enclose := True; 776 end; 777 778 destructor TVarBlockIndexed.Destroy; 779 begin 780 Items.Free; 781 inherited Destroy; 392 782 end; 393 783
Note:
See TracChangeset
for help on using the changeset viewer.