1{
2    This file is part of the Free Component Library
3
4    XML serialisation driver
5    Copyright (c) 2000 by Sebastian Guenther, sg@freepascal.org
6
7    See the file COPYING.FPC, included in this distribution,
8    for details about the copyright.
9
10    This program is distributed in the hope that it will be useful,
11    but WITHOUT ANY WARRANTY; without even the implied warranty of
12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
13
14 **********************************************************************}
15
16
17unit XMLStreaming;
18
19{$MODE objfpc}
20{$H+}
21
22interface
23
24uses SysUtils, Classes, DOM;
25
26type
27
28  TXMLObjectWriterStackElType = (elUnknown, elPropertyList, elChildrenList);
29
30  TXMLObjectWriterStackEl = class
31  public
32    Element, Parent: TDOMElement;
33    ElType: TXMLObjectWriterStackElType;
34    CurName: String;
35  end;
36
37  TXMLObjectWriter = class(TAbstractObjectWriter)
38  private
39    FDoc: TDOMDocument;
40    FRootEl: TDOMElement;
41    FStack: TList;
42    StackEl: TXMLObjectWriterStackEl;
43    procedure StackPush;
44    procedure StackPop;
45    function GetPropertyElement(const TypeName: String): TDOMElement;
46  public
47    constructor Create(ADoc: TDOMDocument);
48    procedure BeginCollection; override;
49    procedure BeginComponent(Component: TComponent; Flags: TFilerFlags;
50      ChildPos: Integer); override;
51    procedure BeginList; override;
52    procedure EndList; override;
53    procedure BeginProperty(const PropName: String); override;
54    procedure EndProperty; override;
55    procedure Write(const Buffer; Count: LongInt); override;
56    procedure WriteBinary(const Buffer; Count: Longint); override;
57    procedure WriteBoolean(Value: Boolean); override;
58    // procedure WriteChar(Value: Char);
59    procedure WriteFloat(const Value: Extended); override;
60    procedure WriteSingle(const Value: Single); override;
61    procedure WriteCurrency(const Value: Currency); override;
62    procedure WriteDate(const Value: TDateTime); override;
63    procedure WriteIdent(const Ident: string); override;
64    procedure WriteInteger(Value: Int64); override;
65    procedure WriteMethodName(const Name: String); override;
66    procedure WriteSet(Value: LongInt; SetType: Pointer); override;
67    procedure WriteString(const Value: String); override;
68    procedure WriteWideString(const Value: WideString); override;
69  end;
70
71
72
73implementation
74
75
76procedure TXMLObjectWriter.StackPush;
77var
78  Parent: TDOMElement;
79begin
80  if Assigned(FStack) then
81  begin
82    Parent := StackEl.Element;
83    FStack.Add(StackEl);
84    StackEl := TXMLObjectWriterStackEl.Create;
85    StackEl.Parent := Parent;
86  end else
87  begin
88    FStack := TList.Create;
89    StackEl := TXMLObjectWriterStackEl.Create;
90    StackEl.Parent := FRootEl;
91  end;
92end;
93
94procedure TXMLObjectWriter.StackPop;
95begin
96  StackEl.Free;
97  if FStack.Count > 0 then
98  begin
99    StackEl := TXMLObjectWriterStackEl(FStack[FStack.Count - 1]);
100    FStack.Delete(FStack.Count - 1);
101  end else
102  begin
103    FStack.Free;
104    FStack := nil;
105    StackEl := nil;
106  end;
107end;
108
109function TXMLObjectWriter.GetPropertyElement(const TypeName: String): TDOMElement;
110begin
111  if not Assigned(StackEl.Element) then
112  begin
113    StackEl.Element := FDoc.CreateElement(TypeName);
114    StackEl.Parent.AppendChild(StackEl.Element);
115    StackEl.Element['name'] := StackEl.CurName;
116    Result := StackEl.Element;
117  end else
118    Result := nil;
119end;
120
121constructor TXMLObjectWriter.Create(ADoc: TDOMDocument);
122begin
123  inherited Create;
124  FDoc := ADoc;
125  FRootEl := FDoc.CreateElement('fcl-persistent');
126  FDoc.AppendChild(FRootEl);
127end;
128
129procedure TXMLObjectWriter.BeginCollection;
130begin
131  WriteLn('BeginCollection');
132end;
133
134procedure TXMLObjectWriter.BeginComponent(Component: TComponent; Flags: TFilerFlags;
135  ChildPos: Integer);
136begin
137  StackPush;
138  StackEl.Element := FDoc.CreateElement('component');
139  StackEl.Parent.AppendChild(StackEl.Element);
140
141  if Length(Component.Name) > 0 then
142    StackEl.Element['name'] := Component.Name;
143  StackEl.Element['class'] := Component.ClassName;
144
145  StackPush;
146  StackEl.Element := FDoc.CreateElement('properties');
147  StackEl.Parent.AppendChild(StackEl.Element);
148  StackEl.ElType := elPropertyList;
149end;
150
151procedure TXMLObjectWriter.BeginList;
152begin
153  WriteLn('BeginList');
154end;
155
156procedure TXMLObjectWriter.EndList;
157begin
158  if StackEl.ElType = elPropertyList then
159  begin
160    if not StackEl.Element.HasChildNodes then
161      StackEl.Parent.RemoveChild(StackEl.Element);
162    StackPop;
163
164    StackPush;
165    StackEl.Element := FDoc.CreateElement('children');
166    StackEl.Parent.AppendChild(StackEl.Element);
167    StackEl.ElType := elChildrenList;
168  end else if StackEl.ElType = elChildrenList then
169  begin
170    if not StackEl.Element.HasChildNodes then
171      StackEl.Parent.RemoveChild(StackEl.Element);
172    StackPop;
173  end else
174    StackPop;
175end;
176
177procedure TXMLObjectWriter.BeginProperty(const PropName: String);
178begin
179  StackPush;
180  StackEl.CurName := PropName;
181end;
182
183procedure TXMLObjectWriter.EndProperty;
184begin
185  StackPop;
186end;
187
188procedure TXMLObjectWriter.WriteBinary(const Buffer; Count: Longint);
189begin
190  WriteLn('WriteBinary (', Count, ' Bytes)');
191end;
192procedure TXMLObjectWriter.Write(const Buffer; Count: Longint);
193begin
194  WriteLn('WriteBinary (', Count, ' Bytes)');
195end;
196
197procedure TXMLObjectWriter.WriteBoolean(Value: Boolean);
198begin
199  WriteLn('WriteBoolean: ', Value);
200end;
201
202procedure TXMLObjectWriter.WriteFloat(const Value: Extended);
203begin
204  WriteLn('WriteFloat: ', Value);
205end;
206
207procedure TXMLObjectWriter.WriteSingle(const Value: Single);
208begin
209  WriteLn('WriteSingle: ', Value);
210end;
211
212procedure TXMLObjectWriter.WriteDate(const Value: TDateTime);
213begin
214  WriteLn('WriteDate: ', Value);
215end;
216
217procedure TXMLObjectWriter.WriteIdent(const Ident: string);
218begin
219  GetPropertyElement('ident')['value'] := Ident;
220end;
221
222procedure TXMLObjectWriter.WriteCurrency(const Value : Currency);
223begin
224  Writeln('WriteCurrency',Value);
225end;
226
227procedure TXMLObjectWriter.WriteInteger(Value: Int64);
228begin
229  GetPropertyElement('integer')['value'] := IntToStr(Value);
230end;
231
232procedure TXMLObjectWriter.WriteMethodName(const Name: String);
233begin
234  GetPropertyElement('method-name')['value'] := Name;
235end;
236
237procedure TXMLObjectWriter.WriteSet(Value: LongInt; SetType: Pointer);
238begin
239  WriteLn('WriteSet: ', Value);
240end;
241
242procedure TXMLObjectWriter.WriteString(const Value: String);
243begin
244  GetPropertyElement('string')['value'] := Value;
245end;
246
247procedure TXMLObjectWriter.WriteWideString(const Value: WideString);
248begin
249  GetPropertyElement('widestring')['value'] := Value;
250end;
251
252
253end.
254