Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to save object property data to a stream Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
18-Oct-02
Category
Object Pascal
Language
Delphi 2.x
Views
220
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			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.



			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC