Author: Jonas Bilinkevicius
How can I save properties of a TList to a stream? I need the entire list to be
saved as a whole and not as individual objects.
Answer:
Solve 1:
A TList doesn't have any intrinsic streaming capability built into it, but it is
very easy to stream anything that you want with a little elbow grease. Think about
it: a stream is data. Classes have properties, whose values are data. It isn't too
hard to write property data to a stream. Here's a simple example to get you going.
This is but just one of many possible approaches to saving object property data to
a stream:
1 unit uStreamableExample;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls,
8 Contnrs;
9
10 type
11 TStreamableObject = class(TPersistent)
12 protected
13 function ReadString(Stream: TStream): string;
14 function ReadLongInt(Stream: TStream): LongInt;
15 function ReadDateTime(Stream: TStream): TDateTime;
16 function ReadCurrency(Stream: TStream): Currency;
17 function ReadClassName(Stream: TStream): ShortString;
18 procedure WriteString(Stream: TStream; const Value: string);
19 procedure WriteLongInt(Stream: TStream; const Value: LongInt);
20 procedure WriteDateTime(Stream: TStream; const Value: TDateTime);
21 procedure WriteCurrency(Stream: TStream; const Value: Currency);
22 procedure WriteClassName(Stream: TStream; const Value: ShortString);
23 public
24 constructor CreateFromStream(Stream: TStream);
25 procedure LoadFromStream(Stream: TStream); virtual; abstract;
26 procedure SaveToStream(Stream: TStream); virtual; abstract;
27 end;
28
29 TStreamableObjectClass = class of TStreamableObject;
30
31 TPerson = class(TStreamableObject)
32 private
33 FName: string;
34 FBirthDate: TDateTime;
35 public
36 constructor Create(const AName: string; ABirthDate: TDateTime);
37 procedure LoadFromStream(Stream: TStream); override;
38 procedure SaveToStream(Stream: TStream); override;
39 property Name: string read FName write FName;
40 property BirthDate: TDateTime read FBirthDate write FBirthDate;
41 end;
42
43 TCompany = class(TStreamableObject)
44 private
45 FName: string;
46 FRevenues: Currency;
47 FEmployeeCount: LongInt;
48 public
49 constructor Create(const AName: string; ARevenues: Currency; AEmployeeCount:
50 LongInt);
51 procedure LoadFromStream(Stream: TStream); override;
52 procedure SaveToStream(Stream: TStream); override;
53 property Name: string read FName write FName;
54 property Revenues: Currency read FRevenues write FRevenues;
55 property EmployeeCount: LongInt read FEmployeeCount write FEmployeeCount;
56 end;
57
58 TStreamableList = class(TStreamableObject)
59 private
60 FItems: TObjectList;
61 function Get_Count: LongInt;
62 function Get_Objects(Index: LongInt): TStreamableObject;
63 public
64 constructor Create;
65 destructor Destroy; override;
66 function FindClass(const AClassName: string): TStreamableObjectClass;
67 procedure Add(Item: TStreamableObject);
68 procedure Delete(Index: LongInt);
69 procedure Clear;
70 procedure LoadFromStream(Stream: TStream); override;
71 procedure SaveToStream(Stream: TStream); override;
72 property Objects[Index: LongInt]: TStreamableObject read Get_Objects; default;
73 property Count: LongInt read Get_Count;
74 end;
75
76 TForm1 = class(TForm)
77 SaveButton: TButton;
78 LoadButton: TButton;
79 procedure SaveButtonClick(Sender: TObject);
80 procedure LoadButtonClick(Sender: TObject);
81 procedure FormCreate(Sender: TObject);
82 private
83 { Private declarations }
84 public
85 Path: string;
86 end;
87
88 var
89 Form1: TForm1;
90
91 implementation
92
93 {$R *.DFM}
94
95 resourcestring
96 DEFAULT_FILENAME = 'test.dat';
97
98 procedure TForm1.SaveButtonClick(Sender: TObject);
99 var
100 List: TStreamableList;
101 Stream: TStream;
102 begin
103 List := TStreamableList.Create;
104 try
105 List.Add(TPerson.Create('Rick Rogers', StrToDate('05/20/68')));
106 List.Add(TCompany.Create('Fenestra', 1000000, 7));
107 Stream := TFileStream.Create(Path + DEFAULT_FILENAME, fmCreate);
108 try
109 List.SaveToStream(Stream);
110 finally
111 Stream.Free;
112 end;
113 finally
114 List.Free;
115 end;
116 end;
117
118 { TPerson }
119
120 constructor TPerson.Create(const AName: string; ABirthDate: TDateTime);
121 begin
122 inherited Create;
123 FName := AName;
124 FBirthDate := ABirthDate;
125 end;
126
127 procedure TPerson.LoadFromStream(Stream: TStream);
128 begin
129 FName := ReadString(Stream);
130 FBirthDate := ReadDateTime(Stream);
131 end;
132
133 procedure TPerson.SaveToStream(Stream: TStream);
134 begin
135 WriteString(Stream, FName);
136 WriteDateTime(Stream, FBirthDate);
137 end;
138
139 { TStreamableList }
140
141 procedure TStreamableList.Add(Item: TStreamableObject);
142 begin
143 FItems.Add(Item);
144 end;
145
146 procedure TStreamableList.Clear;
147 begin
148 FItems.Clear;
149 end;
150
151 constructor TStreamableList.Create;
152 begin
153 FItems := TObjectList.Create;
154 end;
155
156 procedure TStreamableList.Delete(Index: LongInt);
157 begin
158 FItems.Delete(Index);
159 end;
160
161 destructor TStreamableList.Destroy;
162 begin
163 FItems.Free;
164 inherited;
165 end;
166
167 function TStreamableList.FindClass(const AClassName: string):
168 TStreamableObjectClass;
169 begin
170 Result := TStreamableObjectClass(Classes.FindClass(AClassName));
171 end;
172
173 function TStreamableList.Get_Count: LongInt;
174 begin
175 Result := FItems.Count;
176 end;
177
178 function TStreamableList.Get_Objects(Index: LongInt): TStreamableObject;
179 begin
180 Result := FItems[Index] as TStreamableObject;
181 end;
182
183 procedure TStreamableList.LoadFromStream(Stream: TStream);
184 var
185 StreamCount: LongInt;
186 I: Integer;
187 S: string;
188 ClassRef: TStreamableObjectClass;
189 begin
190 StreamCount := ReadLongInt(Stream);
191 for I := 0 to StreamCount - 1 do
192 begin
193 S := ReadClassName(Stream);
194 ClassRef := FindClass(S);
195 Add(ClassRef.CreateFromStream(Stream));
196 end;
197 end;
198
199 procedure TStreamableList.SaveToStream(Stream: TStream);
200 var
201 I: Integer;
202 begin
203 WriteLongInt(Stream, Count);
204 for I := 0 to Count - 1 do
205 begin
206 WriteClassName(Stream, Objects[I].ClassName);
207 Objects[I].SaveToStream(Stream);
208 end;
209 end;
210
211 { TStreamableObject }
212
213 constructor TStreamableObject.CreateFromStream(Stream: TStream);
214 begin
215 inherited Create;
216 LoadFromStream(Stream);
217 end;
218
219 function TStreamableObject.ReadClassName(Stream: TStream): ShortString;
220 begin
221 Result := ReadString(Stream);
222 end;
223
224 function TStreamableObject.ReadCurrency(Stream: TStream): Currency;
225 begin
226 Stream.read(Result, SizeOf(Currency));
227 end;
228
229 function TStreamableObject.ReadDateTime(Stream: TStream): TDateTime;
230 begin
231 Stream.read(Result, SizeOf(TDateTime));
232 end;
233
234 function TStreamableObject.ReadLongInt(Stream: TStream): LongInt;
235 begin
236 Stream.read(Result, SizeOf(LongInt));
237 end;
238
239 function TStreamableObject.ReadString(Stream: TStream): string;
240 var
241 L: LongInt;
242 begin
243 L := ReadLongInt(Stream);
244 SetLength(Result, L);
245 Stream.read(Result[1], L);
246 end;
247
248 procedure TStreamableObject.WriteClassName(Stream: TStream; const Value:
249 ShortString);
250 begin
251 WriteString(Stream, Value);
252 end;
253
254 procedure TStreamableObject.WriteCurrency(Stream: TStream; const Value: Currency);
255 begin
256 Stream.write(Value, SizeOf(Currency));
257 end;
258
259 procedure TStreamableObject.WriteDateTime(Stream: TStream; const Value: TDateTime);
260 begin
261 Stream.write(Value, SizeOf(TDateTime));
262 end;
263
264 procedure TStreamableObject.WriteLongInt(Stream: TStream; const Value: LongInt);
265 begin
266 Stream.write(Value, SizeOf(LongInt));
267 end;
268
269 procedure TStreamableObject.WriteString(Stream: TStream; const Value: string);
270 var
271 L: LongInt;
272 begin
273 L := Length(Value);
274 WriteLongInt(Stream, L);
275 Stream.write(Value[1], L);
276 end;
277
278 { TCompany }
279
280 constructor TCompany.Create(const AName: string; ARevenues: Currency;
281 AEmployeeCount: Integer);
282 begin
283 FName := AName;
284 FRevenues := ARevenues;
285 FEmployeeCount := AEmployeeCount;
286 end;
287
288 procedure TCompany.LoadFromStream(Stream: TStream);
289 begin
290 FName := ReadString(Stream);
291 FRevenues := ReadCurrency(Stream);
292 FEmployeeCount := ReadLongInt(Stream);
293 end;
294
295 procedure TCompany.SaveToStream(Stream: TStream);
296 begin
297 WriteString(Stream, FName);
298 WriteCurrency(Stream, FRevenues);
299 WriteLongInt(Stream, FEmployeeCount);
300 end;
301
302 procedure TForm1.LoadButtonClick(Sender: TObject);
303 var
304 List: TStreamableList;
305 Stream: TStream;
306 Instance: TStreamableObject;
307 I: Integer;
308 begin
309 Stream := TFileStream.Create(Path + DEFAULT_FILENAME, fmOpenRead);
310 try
311 List := TStreamableList.Create;
312 try
313 List.LoadFromStream(Stream);
314 for I := 0 to List.Count - 1 do
315 begin
316 Instance := List[I];
317 if Instance is TPerson then
318 ShowMessage(TPerson(Instance).Name);
319 if Instance is TCompany then
320 ShowMessage(TCompany(Instance).Name);
321 end;
322 finally
323 List.Free;
324 end;
325 finally
326 Stream.Free;
327 end;
328 end;
329
330 procedure TForm1.FormCreate(Sender: TObject);
331 begin
332 Path := ExtractFilePath(Application.ExeName);
333 end;
334
335 initialization
336 RegisterClasses([TPerson, TCompany]);
337
338 end.
Solve 2:
The solution above will work, but it forces you to implement streaming support for
each of the TStreamableObject objects. Delphi has already implemented this
mechanism in for the TPersistent class and the TComponent class, and you can use
this mechanism. The class I include here does the job. It holds classes that
inherit from TUmbCollectionItem (which in turn inherits from Delphi
TCollectionItem), and handles all the streaming of the items. As the items are
written with the Delphi mechanism, all published data is streamed.
Notes: This class does not support working within the delphi IDE like TCollection.
All objects inheriting from TUmbCollectionItem must be registered using the
Classes.RegisterClass function. All objects inheriting from TUmbCollectionItem must
implement the assign function. By default, the TUmbCollection owns its items (frees
them when the collection is freed), but this functionality can be changed.
339 unit UmbCollection;
340
341 interface
342
343 uses
344 Windows, Messages, SysUtils, Classes, contnrs;
345
346 type
347 TUmbCollectionItemClass = class of TUmbCollectionItem;
348 TUmbCollectionItem = class(TCollectionItem)
349 private
350 FPosition: Integer;
351 public
352 {when overriding this method, you must call the inherited assign.}
353 procedure Assign(Source: TPersistent); override;
354 published
355 {the position property is used by the streaming mechanism to place the object
356 in the
357 right position when reading the items. do not use this property.}
358 property Position: Integer read FPosition write FPosition;
359 end;
360
361 TUmbCollection = class(TObjectList)
362 private
363 procedure SetItems(Index: Integer; Value: TUmbCollectionItem);
364 function GetItems(Index: Integer): TUmbCollectionItem;
365 public
366 function Add(AObject: TUmbCollectionItem): Integer;
367 function Remove(AObject: TUmbCollectionItem): Integer;
368 function IndexOf(AObject: TUmbCollectionItem): Integer;
369 function FindInstanceOf(AClass: TUmbCollectionItemClass; AExact: Boolean = True;
370 AStartAt: Integer = 0): Integer;
371 procedure Insert(Index: Integer; AObject: TUmbCollectionItem);
372
373 procedure WriteToStream(AStream: TStream); virtual;
374 procedure ReadFromStream(AStream: TStream); virtual;
375
376 property Items[Index: Integer]: TUmbCollectionItem read GetItems write SetItems;
377 default;
378 published
379 property OwnsObjects;
380 end;
381
382 implementation
383
384 { TUmbCollection }
385
386 function ItemsCompare(Item1, Item2: Pointer): Integer;
387 begin
388 Result := TUmbCollectionItem(Item1).Position - TUmbCollectionItem(Item2).Position;
389 end;
390
391 function TUmbCollection.Add(AObject: TUmbCollectionItem): Integer;
392 begin
393 Result := inherited Add(AObject);
394 end;
395
396 function TUmbCollection.FindInstanceOf(AClass: TUmbCollectionItemClass;
397 AExact: Boolean; AStartAt: Integer): Integer;
398 begin
399 Result := inherited FindInstanceOf(AClass, AExact, AStartAt);
400 end;
401
402 function TUmbCollection.GetItems(Index: Integer): TUmbCollectionItem;
403 begin
404 Result := inherited Items[Index] as TUmbCollectionItem;
405 end;
406
407 function TUmbCollection.IndexOf(AObject: TUmbCollectionItem): Integer;
408 begin
409 Result := inherited IndexOf(AObject);
410 end;
411
412 procedure TUmbCollection.Insert(Index: Integer; AObject: TUmbCollectionItem);
413 begin
414 inherited Insert(Index, AObject);
415 end;
416
417 procedure TUmbCollection.ReadFromStream(AStream: TStream);
418 var
419 Reader: TReader;
420 Collection: TCollection;
421 ItemClassName: string;
422 ItemClass: TUmbCollectionItemClass;
423 Item: TUmbCollectionItem;
424 i: Integer;
425 begin
426 Clear;
427 Reader := TReader.Create(AStream, 1024);
428 try
429 Reader.ReadListBegin;
430 while not Reader.EndOfList do
431 begin
432 ItemClassName := Reader.ReadString;
433 ItemClass := TUmbCollectionItemClass(FindClass(ItemClassName));
434 Collection := TCollection.Create(ItemClass);
435 try
436 Reader.ReadValue;
437 Reader.ReadCollection(Collection);
438 for i := 0 to Collection.Count - 1 do
439 begin
440 item := ItemClass.Create(nil);
441 item.Assign(Collection.Items[i]);
442 Add(Item);
443 end;
444 finally
445 Collection.Free;
446 end;
447 end;
448 Sort(ItemsCompare);
449 Reader.ReadListEnd;
450 finally
451 Reader.Free;
452 end;
453 end;
454
455 function TUmbCollection.Remove(AObject: TUmbCollectionItem): Integer;
456 begin
457 Result := inherited Remove(AObject);
458 end;
459
460 procedure TUmbCollection.SetItems(Index: Integer; Value: TUmbCollectionItem);
461 begin
462 inherited Items[Index] := Value;
463 end;
464
465 procedure TUmbCollection.WriteToStream(AStream: TStream);
466 var
467 Writer: TWriter;
468 CollectionList: TObjectList;
469 Collection: TCollection;
470 ItemClass: TUmbCollectionItemClass;
471 ObjectWritten: array of Boolean;
472 i, j: Integer;
473 begin
474 Writer := TWriter.Create(AStream, 1024);
475 CollectionList := TObjectList.Create(True);
476 try
477 Writer.WriteListBegin;
478 {init the flag array and the position property of the TCollectionItem objects.}
479 SetLength(ObjectWritten, Count);
480 for i := 0 to Count - 1 do
481 begin
482 ObjectWritten[i] := False;
483 Items[i].Position := i;
484 end;
485 {write the TCollectionItem objects. we write first the name of the objects
486 class,
487 then write all the object of the same class.}
488 for i := 0 to Count - 1 do
489 begin
490 if ObjectWritten[i] then
491 Continue;
492 ItemClass := TUmbCollectionItemClass(Items[i].ClassType);
493 Collection := TCollection.Create(ItemClass);
494 CollectionList.Add(Collection);
495 {write the items class name}
496 Writer.WriteString(Items[i].ClassName);
497 {insert the items to the collection}
498 for j := i to Count - 1 do
499 if ItemClass = Items[j].ClassType then
500 begin
501 ObjectWritten[j] := True;
502 (Collection.Add as ItemClass).Assign(Items[j]);
503 end;
504 {write the collection}
505 Writer.WriteCollection(Collection);
506 end;
507 finally
508 CollectionList.Free;
509 Writer.WriteListEnd;
510 Writer.Free;
511 end;
512 end;
513
514 { TUmbCollectionItem }
515
516 procedure TUmbCollectionItem.Assign(Source: TPersistent);
517 begin
518 if Source is TUmbCollectionItem then
519 Position := (Source as TUmbCollectionItem).Position
520 else
521 inherited;
522 end;
523
524 end.
|
