Changeset 405

Timestamp:

Aug 14, 2012, 7:04:04 AM (12 years ago)

Author:

chronos

Message:

• Modified: TemplateGenerics TBinarySerializer now use TListByte class instead TStreamByte.

Files:

• Common/UMemory.pas (modified) (2 diffs)
• CoolStreaming/CoolStreaming.lpk (modified) (1 diff)
• CoolStreaming/UVarBlockSerializer.pas (modified) (6 diffs)
• Generics/TemplateGenerics/Additional/UBinarySerializer.pas (modified) (20 diffs)
• Generics/TemplateGenerics/Generic/GenericList.inc (modified) (4 diffs)

Common/UMemory.pas

@@ -24 +24 @@
     constructor Create;
     destructor Destroy; override;
+    procedure WriteMemory(Position: Integer; Memory: TMemory);
+    procedure ReadMemory(Position: Integer; Memory: TMemory);
     property Data: PByte read FData;
     property Size: Integer read FSize write SetSize;
@@ -108 +110 @@
 end;
 
+procedure TMemory.WriteMemory(Position: Integer; Memory: TMemory);
+begin
+  Move(Memory.FData, PByte(@FData + Position)^, Memory.Size);
+end;
+
+procedure TMemory.ReadMemory(Position: Integer; Memory: TMemory);
+begin
+  Move(PByte(@FData + Position)^, Memory.FData, Memory.Size);
+end;
+
 end.
 

CoolStreaming/CoolStreaming.lpk

@@ -50 +50 @@
     </Files>
     <Type Value="RunAndDesignTime"/>
-    <RequiredPkgs Count="3">
+    <RequiredPkgs Count="2">
       <Item1>
         <PackageName Value="Common"/>
       </Item1>
       <Item2>
-        <PackageName Value="TemplateGenerics"/>
-      </Item2>
-      <Item3>
         <PackageName Value="FCL"/>
         <MinVersion Major="1" Valid="True"/>
-      </Item3>
+      </Item2>
     </RequiredPkgs>
     <UsageOptions>

CoolStreaming/UVarBlockSerializer.pas

@@ -38 +38 @@
     procedure WriteVarStream(AStream: TStream);
     procedure ReadVarStream(AStream: TStream);
+    procedure WriteVarList(List: TListByte);
+    procedure ReadVarList(List: TListByte);
     function GetVarSize: Integer;
     function GetVarCount: Integer;
@@ -80 +82 @@
     procedure WriteVarStream(Index: Integer; Stream: TStream);
     procedure ReadVarStream(Index: Integer; Stream: TStream);
+    procedure WriteVarList(Index: Integer; List: TListByte);
+    procedure ReadVarList(Index: Integer; List: TListByte);
     procedure WriteVarIndexedBlock(Index: Integer; Block: TVarBlockIndexed);
     procedure ReadVarIndexedBlock(Index: Integer; Block: TVarBlockIndexed);
@@ -101 +105 @@
     procedure WriteToStream(Stream: TStream);
     procedure ReadFromStream(Stream: TStream);
+    procedure WriteToList(List: TListByte);
+    procedure ReadFromList(List: TListByte);
     constructor Create;
     destructor Destroy; override;
@@ -413 +419 @@
 end;
 
+procedure TVarBlockSerializer.WriteVarList(List: TListByte);
+var
+  Mem: TMemoryStream;
+begin
+  try
+    Mem := TMemoryStream.Create;
+    List.WriteToStream(Mem);
+    WriteVarStream(Mem);
+  finally
+    Mem.Free
+  end;
+end;
+
+procedure TVarBlockSerializer.ReadVarList(List: TListByte);
+var
+  Mem: TMemoryStream;
+begin
+  try
+    Mem := TMemoryStream.Create;
+    ReadVarStream(Mem);
+    List.Count := Mem.Size;
+    List.ReplaceStream(Mem);
+  finally
+    Mem.Free
+  end;
+end;
+
 function TVarBlockSerializer.GetVarSize: Integer;
 var
@@ -697 +730 @@
 end;
 
+procedure TVarBlockIndexed.WriteVarList(Index: Integer; List: TListByte);
+begin
+  CheckItem(Index);
+  TVarBlockSerializer(Items[Index]).WriteVarList(List);
+end;
+
+procedure TVarBlockIndexed.ReadVarList(Index: Integer; List: TListByte);
+begin
+  TVarBlockSerializer(Items[Index]).ReadVarList(List);
+end;
+
 procedure TVarBlockIndexed.WriteVarIndexedBlock(Index: Integer;
   Block: TVarBlockIndexed);
@@ -915 +959 @@
 end;
 
+procedure TVarBlockIndexed.WriteToList(List: TListByte);
+var
+  Mem: TMemoryStream;
+begin
+  try
+    Mem := TMemoryStream.Create;
+    WriteToStream(Mem);
+    List.Count := Mem.Size;
+    List.ReplaceStream(Mem);
+  finally
+    Mem.Free;
+  end;
+end;
+
+procedure TVarBlockIndexed.ReadFromList(List: TListByte);
+var
+  Mem: TMemoryStream;
+begin
+  try
+    Mem := TMemoryStream.Create;
+    List.WriteToStream(Mem);
+    ReadFromStream(Mem);
+  finally
+    Mem.Free;
+  end;
+end;
+
 constructor TVarBlockIndexed.Create;
 begin

Generics/TemplateGenerics/Additional/UBinarySerializer.pas

@@ -1 +1 @@
 unit UBinarySerializer;
 
-{$mode objfpc}{$H+}
+{$mode delphi}{$H+}
 
 interface
@@ -15 +15 @@
   TBinarySerializer = class
   private
-    FStream: TStreamByte;
+    FGrow: Boolean;
+    FList: TListByte;
     FEndianness: TEndianness;
     SwapData: Boolean;
@@ -21 +22 @@
     procedure ReverseByteOrder(var Buffer; Count: Integer);
   public
+    Position: Integer;
+    OwnsList: Boolean;
+    procedure Write(var Buffer; Count: Integer); inline;
+    procedure Read(var Buffer; Count: Integer); inline;
+
     procedure Assign(Source: TBinarySerializer);
     procedure WriteByte(Data: Byte);
@@ -48 +54 @@
     procedure ReadStream(AStream: TStream; Count: Integer);
     procedure ReadStreamPart(AStream: TStream; Count: Integer);
+    procedure ReadList(List: TListByte; StartIndex, Count: Integer);
     constructor Create; overload;
-    constructor Create(AStream: TStreamByte); overload;
     procedure Clear;
     destructor Destroy; override;
     property Endianness: TEndianness read FEndianness write SetEndianness;
-    property Stream: TStreamByte read FStream write FStream;
+    property List: TListByte read FList write FList;
+    property Grow: Boolean read FGrow write FGrow;
   end;
 
@@ -65 +72 @@
   StringLength: Longint;
 begin
-  FStream.ReadBuffer(StringLength, SizeOf(StringLength));
+  FList.ReadBuffer(StringLength, SizeOf(StringLength));
   Result := ReadString(StringLength);
 end;
@@ -75 +82 @@
   OldPosition: Integer;
 begin
-  OldPosition := FStream.Position;
+  OldPosition := Position;
   Result := '';
   I := 1;
   repeat
-    if FStream.Position >= FStream.Size then Break;
+    if Position >= FList.Count then Break;
     Data := Chr(ReadByte);
     if Data <> Terminator[I] then begin
@@ -88 +95 @@
   if not (I > Length(Terminator)) then begin
     Result := '';
-    FStream.Position := OldPosition;
+    Position := OldPosition;
   end;
 end;
@@ -94 +101 @@
 function TBinarySerializer.ReadByte: Byte;
 begin
-  FStream.ReadBuffer(Result, SizeOf(Byte));
+  Read(Result, SizeOf(Byte));
 end;
 
 function TBinarySerializer.ReadCardinal: Cardinal;
 begin
-  FStream.ReadBuffer(Result, SizeOf(Cardinal));
+  Read(Result, SizeOf(Cardinal));
   if SwapData then Result := SwapEndian(Result);
 end;
@@ -105 +112 @@
 function TBinarySerializer.ReadInt64: Int64;
 begin
-  FStream.ReadBuffer(Result, SizeOf(Int64));
+  Read(Result, SizeOf(Int64));
   if SwapData then Result := SwapEndian(Result);
 end;
@@ -113 +120 @@
   if Length > 0 then begin
     SetLength(Result, Length);
-    FStream.ReadBuffer(Result[1], Length);
+    Read(Result[1], Length);
   end else Result := '';
 end;
@@ -121 +128 @@
   Count: Byte;
 begin
-  FStream.ReadBuffer(Count, 1);
+  Read(Count, 1);
   Result := ReadString(Count);
 end;
@@ -131 +138 @@
   if Count > 0 then begin
     SetLength(Buffer, Count);
-    FStream.ReadBuffer(Buffer[0], Count);
+    Read(Buffer[0], Count);
     AStream.Size := Count;
     AStream.Position := 0;
@@ -144 +151 @@
   if Count > 0 then begin
     SetLength(Buffer, Count);
-    FStream.ReadBuffer(Buffer[0], Count);
+    Read(Buffer[0], Count);
     if AStream.Size < (AStream.Position + Count) then
       AStream.Size := AStream.Position + Count;
-    AStream.Write(Buffer[0], Count);
+    Write(Buffer[0], Count);
+  end;
+end;
+
+procedure TBinarySerializer.ReadList(List: TListByte; StartIndex, Count: Integer
+  );
+var
+  Buffer: array of Byte;
+begin
+  if Count > (List.Count - StartIndex) then Count := (List.Count - StartIndex); // Limit max. stream size
+  if Count > 0 then begin
+    SetLength(Buffer, Count);
+    Read(Pointer(Buffer)^, Count);
+    List.ReplaceBuffer(StartIndex, Pointer(Buffer)^, Count);
   end;
 end;
@@ -159 +179 @@
     SetLength(Buffer, Count);
     AStream.ReadBuffer(Pointer(Buffer)^, Count);
-    FStream.WriteBuffer(Pointer(Buffer)^, Count);
+    Write(Pointer(Buffer)^, Count);
   end;
 end;
@@ -170 +190 @@
   if Count > 0 then begin
     SetLength(Buffer, Count);
-    List.ReadBuffer(Pointer(Buffer)^, Count);
-    FStream.WriteBuffer(Pointer(Buffer)^, Count);
+    List.GetBuffer(StartIndex, PByte(Buffer), Count);
+    Write(Pointer(Buffer)^, Count);
   end;
 end;
@@ -179 +199 @@
   inherited;
   Endianness := enLittle;
-  FStream := nil;
-end;
-
-constructor TBinarySerializer.Create(AStream: TStreamByte);
-begin
-  inherited Create;
-  Endianness := enLittle;
-  FStream := AStream;
+  FList := nil;
+  FGrow := True;
 end;
 
 procedure TBinarySerializer.Clear;
 begin
-  Stream.Size := 0;
+  FList.Count := 0;
 end;
 
 destructor TBinarySerializer.Destroy;
 begin
+  if OwnsList then FList.Free;
   inherited Destroy;
 end;
@@ -206 +221 @@
 function TBinarySerializer.ReadDouble: Double;
 begin
-  FStream.ReadBuffer(Result, SizeOf(Double));
+  Read(Result, SizeOf(Double));
 end;
 
 function TBinarySerializer.ReadSingle: Single;
 begin
-  FStream.ReadBuffer(Result, SizeOf(Single));
+  Read(Result, SizeOf(Single));
 end;
 
 function TBinarySerializer.ReadWord: Word;
 begin
-  FStream.ReadBuffer(Result, SizeOf(Word));
+  Read(Result, SizeOf(Word));
   if SwapData then Result := SwapEndian(Result);
 end;
@@ -246 +261 @@
 end;
 
+procedure TBinarySerializer.Write(var Buffer; Count: Integer);
+var
+  NewCount: Integer;
+begin
+  if FGrow then begin
+    NewCount := Position + Count;
+    if FList.Count < NewCount then
+      FList.Count := NewCount;
+  end;
+  FList.ReplaceBuffer(Position, Buffer, Count);
+  Inc(Position, Count);
+end;
+
+procedure TBinarySerializer.Read(var Buffer; Count: Integer);
+begin
+  FList.GetBuffer(Position, Buffer, Count);
+  Inc(Position, Count);
+end;
+
 procedure TBinarySerializer.Assign(Source: TBinarySerializer);
 begin
-  FStream := Source.FStream;
+  FList := Source.FList;
 end;
 
@@ -262 +296 @@
 procedure TBinarySerializer.WriteByte(Data: Byte);
 begin
-  FStream.WriteBuffer(Data, SizeOf(Byte));
+  Write(Data, SizeOf(Byte));
 end;
 
@@ -298 +332 @@
     SetLength(Buffer, Count);
     AStream.ReadBuffer(Pointer(Buffer)^, Count);
-    FStream.WriteBuffer(Pointer(Buffer)^, Count);
+    Write(Pointer(Buffer)^, Count);
   end;
 end;

Generics/TemplateGenerics/Generic/GenericList.inc

@@ -39 +39 @@
     procedure SetCount(const AValue: TGListIndex); virtual;
   public
+    type
+      PItem = ^TGListItem;
     function CompareMem(P1, P2: Pointer; Length: cardinal): Boolean; inline;
     function Add(Item: TGListItem): TGListIndex;
@@ -57 +59 @@
     function GetArray(Index, ACount: TGListIndex): TGListItemArray;
     procedure GetList(List: TGList; Index, ACount: TGListIndex);
+    procedure GetBuffer(Index: TGListIndex; var Buffer; Count: TGListIndex);
     function Implode(Separator: string; Converter: TGListToStringConverter): string;
     function IndexOf(Item: TGListItem; Start: TGListIndex = 0): TGListIndex; virtual;
@@ -73 +76 @@
     procedure ReplaceListPart(Index: TGListIndex; Source: TGList;
       SourceIndex, SourceCount: TGListIndex);
+    procedure ReplaceBuffer(Index: TGListIndex; var Buffer; Count: TGListIndex);
     procedure Sort(Compare: TGListSortCompare);
     procedure SetArray(Values: array of TGListItem);
@@ -102 +106 @@
 begin
   FCount := 0;
+end;
+
+procedure TGList.GetBuffer(Index: TGListIndex; var Buffer; Count: TGListIndex);
+var
+  P: PItem;
+  I: TGListIndex;
+begin
+  if (Index + Count) > FCount then
+    raise EListError.CreateFmt(SListIndexError, [Index + Count]);
+  P := PItem(@Buffer);
+  I := 0;
+  while I < Count do begin
+    P^ := Items[Index + I];
+    Inc(P, 1);
+    I := I + 1;
+  end;
+end;
+
+procedure TGList.ReplaceBuffer(Index: TGListIndex; var Buffer; Count: TGListIndex);
+var
+  P: PItem;
+  I: TGListIndex;
+begin
+  if (Index + Count) > FCount then
+    raise EListError.CreateFmt(SListIndexError, [Index + Count]);
+  P := PItem(@Buffer);
+  I := 0;
+  while I < Count do begin
+    Items[Index + I] := P^;
+    Inc(P, 1);
+    I := I + 1;
+  end;
 end;