1 | unit XmlClasses;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Classes, SysUtils, StrUtils, Generics.Collections, Generics;
|
---|
7 |
|
---|
8 | type
|
---|
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 |
|
---|
62 | implementation
|
---|
63 |
|
---|
64 | { TXmlElements }
|
---|
65 |
|
---|
66 | function TXmlElements.AddTag(Name: string): TXmlTag;
|
---|
67 | begin
|
---|
68 | Result := TXmlTag.Create;
|
---|
69 | Result.Name := Name;
|
---|
70 | Add(Result);
|
---|
71 | end;
|
---|
72 |
|
---|
73 | function TXmlElements.AddString(Text: string): TXmlString;
|
---|
74 | begin
|
---|
75 | Result := TXmlString.Create;
|
---|
76 | Result.Text := Text;
|
---|
77 | Add(Result);
|
---|
78 | end;
|
---|
79 |
|
---|
80 | { THtmlElement }
|
---|
81 |
|
---|
82 | constructor TXmlTag.Create;
|
---|
83 | begin
|
---|
84 | ShringEmpty := True;
|
---|
85 | Attributes := TDictionaryStringString.Create;
|
---|
86 | SubElements := TXmlElements.Create;
|
---|
87 | EndTagSymbol := '/';
|
---|
88 | end;
|
---|
89 |
|
---|
90 | destructor TXmlTag.Destroy;
|
---|
91 | begin
|
---|
92 | FreeAndNil(Attributes);
|
---|
93 | FreeAndNil(SubElements);
|
---|
94 | inherited;
|
---|
95 | end;
|
---|
96 |
|
---|
97 | function TXmlTag.GetAsString: string;
|
---|
98 | var
|
---|
99 | AttributesText: string;
|
---|
100 | I: Integer;
|
---|
101 | Content: string;
|
---|
102 | Attribute: TPair<string, string>;
|
---|
103 | begin
|
---|
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;
|
---|
117 | end;
|
---|
118 |
|
---|
119 | { TXmlString }
|
---|
120 |
|
---|
121 | function TXmlString.GetAsString: string;
|
---|
122 | begin
|
---|
123 | Result := Text;
|
---|
124 | end;
|
---|
125 |
|
---|
126 | { TXmlElement }
|
---|
127 |
|
---|
128 | function TXmlElement.GetAsString: string;
|
---|
129 | begin
|
---|
130 | Result := ''; // dodelat
|
---|
131 | end;
|
---|
132 |
|
---|
133 | { TXmlDocument }
|
---|
134 |
|
---|
135 | constructor TXmlDocument.Create;
|
---|
136 | begin
|
---|
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;
|
---|
148 | end;
|
---|
149 |
|
---|
150 | destructor TXmlDocument.Destroy;
|
---|
151 | begin
|
---|
152 | FreeAndNil(Content);
|
---|
153 | FreeAndNil(MainTag);
|
---|
154 | inherited;
|
---|
155 | end;
|
---|
156 |
|
---|
157 | function TXmlDocument.FormatStructure(Text: string): string;
|
---|
158 | const
|
---|
159 | NewLine = #13#10;
|
---|
160 | var
|
---|
161 | IndentCount: Integer;
|
---|
162 | I: Integer;
|
---|
163 | LastPos: Integer;
|
---|
164 | Content: string;
|
---|
165 | begin
|
---|
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;
|
---|
190 | end;
|
---|
191 |
|
---|
192 | function TXmlDocument.GetAsString: string;
|
---|
193 | begin
|
---|
194 | Result := MainTag.AsString + Content.AsString;
|
---|
195 | if Formated then Result := FormatStructure(Result);
|
---|
196 | end;
|
---|
197 |
|
---|
198 | end.
|
---|