- Timestamp:
- Aug 14, 2012, 7:04:04 AM (12 years ago)
- Location:
- Generics/TemplateGenerics
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
Generics/TemplateGenerics/Additional/UBinarySerializer.pas
r342 r405 1 1 unit UBinarySerializer; 2 2 3 {$mode objfpc}{$H+}3 {$mode delphi}{$H+} 4 4 5 5 interface … … 15 15 TBinarySerializer = class 16 16 private 17 FStream: TStreamByte; 17 FGrow: Boolean; 18 FList: TListByte; 18 19 FEndianness: TEndianness; 19 20 SwapData: Boolean; … … 21 22 procedure ReverseByteOrder(var Buffer; Count: Integer); 22 23 public 24 Position: Integer; 25 OwnsList: Boolean; 26 procedure Write(var Buffer; Count: Integer); inline; 27 procedure Read(var Buffer; Count: Integer); inline; 28 23 29 procedure Assign(Source: TBinarySerializer); 24 30 procedure WriteByte(Data: Byte); … … 48 54 procedure ReadStream(AStream: TStream; Count: Integer); 49 55 procedure ReadStreamPart(AStream: TStream; Count: Integer); 56 procedure ReadList(List: TListByte; StartIndex, Count: Integer); 50 57 constructor Create; overload; 51 constructor Create(AStream: TStreamByte); overload;52 58 procedure Clear; 53 59 destructor Destroy; override; 54 60 property Endianness: TEndianness read FEndianness write SetEndianness; 55 property Stream: TStreamByte read FStream write FStream; 61 property List: TListByte read FList write FList; 62 property Grow: Boolean read FGrow write FGrow; 56 63 end; 57 64 … … 65 72 StringLength: Longint; 66 73 begin 67 F Stream.ReadBuffer(StringLength, SizeOf(StringLength));74 FList.ReadBuffer(StringLength, SizeOf(StringLength)); 68 75 Result := ReadString(StringLength); 69 76 end; … … 75 82 OldPosition: Integer; 76 83 begin 77 OldPosition := FStream.Position;84 OldPosition := Position; 78 85 Result := ''; 79 86 I := 1; 80 87 repeat 81 if FStream.Position >= FStream.Sizethen Break;88 if Position >= FList.Count then Break; 82 89 Data := Chr(ReadByte); 83 90 if Data <> Terminator[I] then begin … … 88 95 if not (I > Length(Terminator)) then begin 89 96 Result := ''; 90 FStream.Position := OldPosition;97 Position := OldPosition; 91 98 end; 92 99 end; … … 94 101 function TBinarySerializer.ReadByte: Byte; 95 102 begin 96 FStream.ReadBuffer(Result, SizeOf(Byte));103 Read(Result, SizeOf(Byte)); 97 104 end; 98 105 99 106 function TBinarySerializer.ReadCardinal: Cardinal; 100 107 begin 101 FStream.ReadBuffer(Result, SizeOf(Cardinal));108 Read(Result, SizeOf(Cardinal)); 102 109 if SwapData then Result := SwapEndian(Result); 103 110 end; … … 105 112 function TBinarySerializer.ReadInt64: Int64; 106 113 begin 107 FStream.ReadBuffer(Result, SizeOf(Int64));114 Read(Result, SizeOf(Int64)); 108 115 if SwapData then Result := SwapEndian(Result); 109 116 end; … … 113 120 if Length > 0 then begin 114 121 SetLength(Result, Length); 115 FStream.ReadBuffer(Result[1], Length);122 Read(Result[1], Length); 116 123 end else Result := ''; 117 124 end; … … 121 128 Count: Byte; 122 129 begin 123 FStream.ReadBuffer(Count, 1);130 Read(Count, 1); 124 131 Result := ReadString(Count); 125 132 end; … … 131 138 if Count > 0 then begin 132 139 SetLength(Buffer, Count); 133 FStream.ReadBuffer(Buffer[0], Count);140 Read(Buffer[0], Count); 134 141 AStream.Size := Count; 135 142 AStream.Position := 0; … … 144 151 if Count > 0 then begin 145 152 SetLength(Buffer, Count); 146 FStream.ReadBuffer(Buffer[0], Count);153 Read(Buffer[0], Count); 147 154 if AStream.Size < (AStream.Position + Count) then 148 155 AStream.Size := AStream.Position + Count; 149 AStream.Write(Buffer[0], Count); 156 Write(Buffer[0], Count); 157 end; 158 end; 159 160 procedure TBinarySerializer.ReadList(List: TListByte; StartIndex, Count: Integer 161 ); 162 var 163 Buffer: array of Byte; 164 begin 165 if Count > (List.Count - StartIndex) then Count := (List.Count - StartIndex); // Limit max. stream size 166 if Count > 0 then begin 167 SetLength(Buffer, Count); 168 Read(Pointer(Buffer)^, Count); 169 List.ReplaceBuffer(StartIndex, Pointer(Buffer)^, Count); 150 170 end; 151 171 end; … … 159 179 SetLength(Buffer, Count); 160 180 AStream.ReadBuffer(Pointer(Buffer)^, Count); 161 FStream.WriteBuffer(Pointer(Buffer)^, Count);181 Write(Pointer(Buffer)^, Count); 162 182 end; 163 183 end; … … 170 190 if Count > 0 then begin 171 191 SetLength(Buffer, Count); 172 List. ReadBuffer(Pointer(Buffer)^, Count);173 FStream.WriteBuffer(Pointer(Buffer)^, Count);192 List.GetBuffer(StartIndex, PByte(Buffer), Count); 193 Write(Pointer(Buffer)^, Count); 174 194 end; 175 195 end; … … 179 199 inherited; 180 200 Endianness := enLittle; 181 FStream := nil; 182 end; 183 184 constructor TBinarySerializer.Create(AStream: TStreamByte); 185 begin 186 inherited Create; 187 Endianness := enLittle; 188 FStream := AStream; 201 FList := nil; 202 FGrow := True; 189 203 end; 190 204 191 205 procedure TBinarySerializer.Clear; 192 206 begin 193 Stream.Size:= 0;207 FList.Count := 0; 194 208 end; 195 209 196 210 destructor TBinarySerializer.Destroy; 197 211 begin 212 if OwnsList then FList.Free; 198 213 inherited Destroy; 199 214 end; … … 206 221 function TBinarySerializer.ReadDouble: Double; 207 222 begin 208 FStream.ReadBuffer(Result, SizeOf(Double));223 Read(Result, SizeOf(Double)); 209 224 end; 210 225 211 226 function TBinarySerializer.ReadSingle: Single; 212 227 begin 213 FStream.ReadBuffer(Result, SizeOf(Single));228 Read(Result, SizeOf(Single)); 214 229 end; 215 230 216 231 function TBinarySerializer.ReadWord: Word; 217 232 begin 218 FStream.ReadBuffer(Result, SizeOf(Word));233 Read(Result, SizeOf(Word)); 219 234 if SwapData then Result := SwapEndian(Result); 220 235 end; … … 246 261 end; 247 262 263 procedure TBinarySerializer.Write(var Buffer; Count: Integer); 264 var 265 NewCount: Integer; 266 begin 267 if FGrow then begin 268 NewCount := Position + Count; 269 if FList.Count < NewCount then 270 FList.Count := NewCount; 271 end; 272 FList.ReplaceBuffer(Position, Buffer, Count); 273 Inc(Position, Count); 274 end; 275 276 procedure TBinarySerializer.Read(var Buffer; Count: Integer); 277 begin 278 FList.GetBuffer(Position, Buffer, Count); 279 Inc(Position, Count); 280 end; 281 248 282 procedure TBinarySerializer.Assign(Source: TBinarySerializer); 249 283 begin 250 F Stream := Source.FStream;284 FList := Source.FList; 251 285 end; 252 286 … … 262 296 procedure TBinarySerializer.WriteByte(Data: Byte); 263 297 begin 264 FStream.WriteBuffer(Data, SizeOf(Byte));298 Write(Data, SizeOf(Byte)); 265 299 end; 266 300 … … 298 332 SetLength(Buffer, Count); 299 333 AStream.ReadBuffer(Pointer(Buffer)^, Count); 300 FStream.WriteBuffer(Pointer(Buffer)^, Count);334 Write(Pointer(Buffer)^, Count); 301 335 end; 302 336 end; -
Generics/TemplateGenerics/Generic/GenericList.inc
r383 r405 39 39 procedure SetCount(const AValue: TGListIndex); virtual; 40 40 public 41 type 42 PItem = ^TGListItem; 41 43 function CompareMem(P1, P2: Pointer; Length: cardinal): Boolean; inline; 42 44 function Add(Item: TGListItem): TGListIndex; … … 57 59 function GetArray(Index, ACount: TGListIndex): TGListItemArray; 58 60 procedure GetList(List: TGList; Index, ACount: TGListIndex); 61 procedure GetBuffer(Index: TGListIndex; var Buffer; Count: TGListIndex); 59 62 function Implode(Separator: string; Converter: TGListToStringConverter): string; 60 63 function IndexOf(Item: TGListItem; Start: TGListIndex = 0): TGListIndex; virtual; … … 73 76 procedure ReplaceListPart(Index: TGListIndex; Source: TGList; 74 77 SourceIndex, SourceCount: TGListIndex); 78 procedure ReplaceBuffer(Index: TGListIndex; var Buffer; Count: TGListIndex); 75 79 procedure Sort(Compare: TGListSortCompare); 76 80 procedure SetArray(Values: array of TGListItem); … … 102 106 begin 103 107 FCount := 0; 108 end; 109 110 procedure TGList.GetBuffer(Index: TGListIndex; var Buffer; Count: TGListIndex); 111 var 112 P: PItem; 113 I: TGListIndex; 114 begin 115 if (Index + Count) > FCount then 116 raise EListError.CreateFmt(SListIndexError, [Index + Count]); 117 P := PItem(@Buffer); 118 I := 0; 119 while I < Count do begin 120 P^ := Items[Index + I]; 121 Inc(P, 1); 122 I := I + 1; 123 end; 124 end; 125 126 procedure TGList.ReplaceBuffer(Index: TGListIndex; var Buffer; Count: TGListIndex); 127 var 128 P: PItem; 129 I: TGListIndex; 130 begin 131 if (Index + Count) > FCount then 132 raise EListError.CreateFmt(SListIndexError, [Index + Count]); 133 P := PItem(@Buffer); 134 I := 0; 135 while I < Count do begin 136 Items[Index + I] := P^; 137 Inc(P, 1); 138 I := I + 1; 139 end; 104 140 end; 105 141
Note:
See TracChangeset
for help on using the changeset viewer.