source: trunk/XmlClasses.pas

Last change on this file was 32, checked in by chronos, 6 months ago
  • Modified: Removed U prefix from units names.
  • Modified: Use TFormEx for all forms.
File size: 4.5 KB
Line 
1unit XmlClasses;
2
3interface
4
5uses
6 Classes, SysUtils, StrUtils, Generics.Collections, Generics;
7
8type
9 TXmlElement = class
10 private
11 function GetAsString: string; virtual;
12 public
13 property AsString: string read GetAsString;
14 end;
15
16 TXmlTag = class;
17 TXmlString = class;
18
19 { TXmlElements }
20
21 TXmlElements = class(TObjectList<TXmlElement>)
22 function AddTag(Name: string): TXmlTag;
23 function AddString(Text: string): TXmlString;
24 end;
25
26 TXmlString = class(TXmlElement)
27 private
28 function GetAsString: string; override;
29 public
30 Text: string;
31 end;
32
33 TXmlTag = class(TXmlElement)
34 private
35 function GetAsString: string; override;
36 public
37 EndTagSymbol: string;
38 ShringEmpty: Boolean;
39 Name: string;
40 Attributes: TDictionaryStringString;
41 SubElements: TXmlElements;
42 constructor Create;
43 destructor Destroy; override;
44 end;
45
46 TXmlDocument = class
47 private
48 MainTag: TXmlTag;
49 function FormatStructure(Text: string): string;
50 function GetAsString: string;
51 public
52 Formated: Boolean;
53 Content: TXmlTag;
54 XmlVersion: string;
55 Encoding: string;
56 constructor Create;
57 destructor Destroy; override;
58 property AsString: string read GetAsString;
59 end;
60
61
62implementation
63
64{ TXmlElements }
65
66function TXmlElements.AddTag(Name: string): TXmlTag;
67begin
68 Result := TXmlTag.Create;
69 Result.Name := Name;
70 Add(Result);
71end;
72
73function TXmlElements.AddString(Text: string): TXmlString;
74begin
75 Result := TXmlString.Create;
76 Result.Text := Text;
77 Add(Result);
78end;
79
80{ THtmlElement }
81
82constructor TXmlTag.Create;
83begin
84 ShringEmpty := True;
85 Attributes := TDictionaryStringString.Create;
86 SubElements := TXmlElements.Create;
87 EndTagSymbol := '/';
88end;
89
90destructor TXmlTag.Destroy;
91begin
92 FreeAndNil(Attributes);
93 FreeAndNil(SubElements);
94 inherited;
95end;
96
97function TXmlTag.GetAsString: string;
98var
99 AttributesText: string;
100 I: Integer;
101 Content: string;
102 Attribute: TPair<string, string>;
103begin
104 Content := '';
105 for I := 0 to SubElements.Count - 1 do
106 Content := Content + TXmlElement(SubElements[I]).AsString;
107
108 AttributesText := '';
109 for Attribute in Attributes do
110 AttributesText := AttributesText + ' ' + Attribute.Key + '="' + Attribute.Value + '"';
111
112 if Name <> '' then begin
113 if (Content <> '') or not ShringEmpty then
114 Result := '<' + Name + AttributesText + '>' + Content + '<' + EndTagSymbol + Name + '>'
115 else Result := '<' + Name + AttributesText + EndTagSymbol + '>';
116 end else Result := Content;
117end;
118
119{ TXmlString }
120
121function TXmlString.GetAsString: string;
122begin
123 Result := Text;
124end;
125
126{ TXmlElement }
127
128function TXmlElement.GetAsString: string;
129begin
130 Result := ''; // dodelat
131end;
132
133{ TXmlDocument }
134
135constructor TXmlDocument.Create;
136begin
137 inherited;
138 Encoding := 'utf-8';
139 XmlVersion := '1.0';
140 MainTag := TXmlTag.Create;
141 with MainTag do begin
142 Name := '?xml';
143 EndTagSymbol := '?';
144 Attributes.Add('version', '1.0');
145 Attributes.Add('encoding', 'utf-8');
146 end;
147 Content := TXmlTag.Create;
148end;
149
150destructor TXmlDocument.Destroy;
151begin
152 FreeAndNil(Content);
153 FreeAndNil(MainTag);
154 inherited;
155end;
156
157function TXmlDocument.FormatStructure(Text: string): string;
158const
159 NewLine = #13#10;
160var
161 IndentCount: Integer;
162 I: Integer;
163 LastPos: Integer;
164 Content: string;
165begin
166 IndentCount := 0;
167 Result := '';
168 LastPos := 1;
169 I := 1;
170 while I < Length(Text) do begin
171 if Text[I] = '<' then begin
172 Content := Trim(Copy(Text, LastPos, I - LastPos));
173 if Length(Content) > 0 then
174 Result := Result + DupeString(' ', IndentCount) + Content + NewLine;
175 LastPos := I;
176 end;
177 if Text[I] = '>' then begin
178 if Text[LastPos + 1] = '/' then Dec(IndentCount);
179 Result := Result + DupeString(' ', IndentCount) + Copy(Text, LastPos, I - LastPos + 1)
180 + NewLine;
181 if (Text[LastPos + 1] <> '/') and (Text[I - 1] <> '/') and
182 (Text[I - 1] <> '?') and (Text[LastPos + 1] <> '!') then Inc(IndentCount);
183 LastPos := I + 1;
184 end;
185 Inc(I);
186 end;
187 if Text[LastPos + 1] = '/' then Dec(IndentCount);
188 Result := Result + DupeString(' ', IndentCount) + Copy(Text, LastPos, I - LastPos + 1)
189 + NewLine;
190end;
191
192function TXmlDocument.GetAsString: string;
193begin
194 Result := MainTag.AsString + Content.AsString;
195 if Formated then Result := FormatStructure(Result);
196end;
197
198end.
Note: See TracBrowser for help on using the repository browser.