Develop and Download Open Source Software

Browse CVS Repository

Contents of /gikonavigoeson/gikonavi/GikoXMLDoc.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.5 - (show annotations) (download) (as text)
Thu Nov 27 13:04:18 2003 UTC (20 years, 4 months ago) by yoffy
Branch: MAIN
CVS Tags: b44, b46
Changes since 1.4: +19 -2 lines
File MIME type: text/x-pascal
・コンストラクタやデストラクタといった細かいところの調整。

1 unit GikoXMLDoc;
2
3 {
4 XMLIntf, XMLDoc ?????????????若??/span>
5 Delphi 6 Personal ??/span>
6 }
7 interface
8
9 //==================================================
10 uses
11 //==================================================
12
13 Classes, SysUtils,
14 YofUtils;
15
16 //==================================================
17 type
18 //==================================================
19
20 // ??????????篏??c???????????違??????????
21 XMLDictionary = Record
22 Name : string;
23 Value : string;
24 end;
25
26 IXMLNode = class
27 private
28 FNodeName : string;
29 FCount : Integer;
30 FAttributeCount : Integer;
31 FChildNodes : IXMLNode;
32 FNodes : array of IXMLNode;
33 FAttributes : array of XMLDictionary;
34 function GetAttribute( const Name : string ) : string;
35 function GetNode( Index : Integer ) : IXMLNode;
36 public
37 constructor Create;
38 destructor Destroy; override;
39
40 property NodeName : string read FNodeName write FNodeName;
41 property Attributes[ const Name : string ] : string read GetAttribute;
42 property Node[ Index : Integer ] : IXMLNode read GetNode; default;
43 property ChildNodes : IXMLNode read FChildNodes write FChildNodes;
44 property Count : Integer read FCount write FCount;
45 procedure Add( node : IXMLNode );
46 procedure AddAttribute( const Name : string; const Value : string );
47 end;
48
49 IXMLDocument = class( IXMLNode )
50 private
51 function GetDocumentElement() : IXMLNode;
52 public
53 property DocumentElement : IXMLNode read GetDocumentElement;
54 end;
55
56 function XMLCloseCheck(
57 var f : TFileStream;
58 var node : IXMLNode;
59 ch : char;
60 out tag : string;
61 out closed : boolean // ?若?喝?冴???????若???潟?? node ?????????鴻?????? true
62 ) : boolean; // ch ?????????若???潟?????????????? true
63
64 function XMLReadNode(
65 var f : TFileStream;
66 var node : IXMLNode
67 ) : string; // node 篁ュ??????若???????????????翫???????若????
68
69 function LoadXMLDocument(
70 const fileName : string
71 ) : IXMLDocument;
72
73 //==================================================
74 const
75 //==================================================
76 kXMLWhite : TSysCharSet = [#0..#$20];
77 kXMLDQuote : TSysCharSet = ['"'];
78 kXMLTagStart : TSysCharSet = ['<'];
79 kXMLTagEnd : TSysCharSet = ['>'];
80 kXMLKanji : TSysCharSet = [#$80..#$A0, #$E0..#$ff];
81
82 //==================================================
83 implementation
84 //==================================================
85
86 // Constructor
87 constructor IXMLNode.Create;
88 begin
89
90 inherited;
91
92 FCount := 0;
93
94 end;
95
96 // Destructor
97 destructor IXMLNode.Destroy;
98 var
99 i : Integer;
100 begin
101
102 for i := FCount - 1 downto 0 do
103 FNodes[ i ].Free;
104 FChildNodes.Free;
105
106 inherited;
107
108 end;
109
110 function IXMLNode.GetAttribute( const Name : string ) : string;
111 var
112 i : Integer;
113 begin
114
115 i := 0;
116 while i < FAttributeCount do
117 begin
118 if Name = FAttributes[ i ].Name then
119 begin
120 Result := FAttributes[ i ].Value;
121 exit;
122 end;
123
124 Inc( i );
125 end;
126
127 end;
128
129 function IXMLNode.GetNode( Index : Integer ) : IXMLNode;
130 begin
131
132 Result := FNodes[ Index ];
133
134 end;
135
136 procedure IXMLNode.Add( node : IXMLNode );
137 begin
138
139 Inc( FCount );
140 SetLength( FNodes, FCount );
141 FNodes[ FCount - 1 ] := node;
142
143 end;
144
145 procedure IXMLNode.AddAttribute(
146 const Name : string;
147 const Value : string
148 );
149 var
150 index : Integer;
151 begin
152
153 index := FAttributeCount;
154 Inc( FAttributeCount );
155 SetLength( FAttributes, FAttributeCount );
156 FAttributes[ index ].Name := Name;
157 FAttributes[ index ].Value := Value;
158
159 end;
160
161 function IXMLDocument.GetDocumentElement() : IXMLNode;
162 begin
163
164 Result := FChildNodes[ 0 ];
165
166 end;
167
168 // untilSet ???????障?ч??違??
169 procedure FileThruUntil(
170 var f : TFileStream;
171 const untilSet : TSysCharSet
172 );
173 var
174 ch : char;
175 begin
176
177 while f.Position < f.Size do
178 begin
179 f.ReadBuffer( ch, 1 );
180 if ch in untilSet then
181 begin
182 f.Seek( -1, soFromCurrent );
183 exit;
184 end else if ch in kXMLKanji then
185 f.Seek( 1, soFromCurrent );
186 end;
187
188 end;
189
190 // whileSet ????蕋??違??
191 procedure FileThruWhile(
192 var f : TFileStream;
193 const whileSet : TSysCharSet
194 );
195 var
196 ch : char;
197 begin
198
199 while f.Position < f.Size do
200 begin
201 f.ReadBuffer( ch, 1 );
202 if ch in whileSet then
203 begin
204 if ch in kXMLKanji then
205 f.ReadBuffer( ch, 1 );
206 end else begin
207 f.Seek( -1, soFromCurrent );
208 exit;
209 end;
210 end;
211
212 end;
213
214 function XMLCloseCheck(
215 var f : TFileStream;
216 var node : IXMLNode;
217 ch : char;
218 out tag : string;
219 out closed : boolean
220 ) : boolean; // ch ?????????若???潟?????????????? true
221 var
222 last : Integer;
223 tagLen : Integer;
224 begin
225
226 closed := false;
227 Result := false;
228 tag := '';
229
230 if ch = '>' then
231 begin
232 // ??紮??帥?違????緇??障?ц?????
233 Result := true;
234 end else if ch = '?' then
235 begin
236 // <?xml?> ?帥?????????ゃ?????c???∴?
237 FileThruUntil( f, kXMLTagEnd );
238 FileThruUntil( f, kXMLTagStart );
239 f.Seek( 1, soFromCurrent );
240 FileThruWhile( f, kXMLWhite );
241 //closed := true;
242 Result := true;
243 end else if ch = '/' then
244 begin
245 // ?帥?医????茯??粋昭???ц???
246 last := f.Position;
247 FileThruUntil( f, kXMLTagEnd );
248 tagLen := f.Position - last;
249 SetLength( tag, tagLen );
250
251 f.Seek( last, soFromBeginning );
252 f.ReadBuffer( PChar( tag )^, tagLen );
253
254 f.Seek( f.Position + 1, soFromBeginning ); // '>' 蕋??違??
255 closed := true;
256 Result := true;
257 end;
258
259 end;
260
261 function XMLReadNode(
262 var f : TFileStream;
263 var node : IXMLNode
264 ) : string; // node 篁ュ??????若???????????????翫???????若????
265 var
266 child : IXMLNode;
267
268 last : Integer;
269 tag : string;
270 tagLen : Integer;
271
272 isClosed : boolean;
273
274 attributeName : string;
275 attributeValue : string;
276
277 ch : char;
278 label
279 NextNode;
280 begin
281 try
282 // node ????粋昭??1 ???若?????ゃ?? 1 ???若??)
283 node.ChildNodes := IXMLNode.Create;
284
285 while f.Position < f.Size do
286 begin
287 // NodeName 茯??粋昭??/span>
288 FileThruWhile( f, kXMLWhite );
289
290 while f.Position < f.Size do
291 begin
292 f.ReadBuffer( ch, 1 );
293
294 if XMLCloseCheck( f, node, ch, tag, isClosed ) then
295 begin
296 if isClosed then
297 begin
298 Result := tag;
299 exit;
300 end;
301
302 goto NextNode;
303 end else if ch = '<' then
304 begin
305 // ?域????若??
306 child := IXMLNode.Create;
307 tag := XMLReadNode( f, child );
308 node.ChildNodes.Add( child );
309
310 // ?帥?違????????????
311 if Length( tag ) > 0 then
312 begin
313 // ???????????????с???????????????域Κ?????
314 if tag <> node.NodeName then
315 Result := tag;
316 exit;
317 end;
318
319 goto NextNode;
320 end else if ch in kXMLWhite then
321 begin
322 // NodeName 絎?篋?
323 break;
324 end else begin
325 node.NodeName := node.NodeName + ch;
326
327 if ch in kXMLKanji then
328 begin
329 f.ReadBuffer( ch, 1 );
330 node.NodeName := node.NodeName + ch;
331 end;
332 end;
333 end;
334
335 // Attribute ????粋昭??/span>
336 while f.Position < f.Size do
337 begin
338 // Attribute ????????茯??粋昭??/span>
339 attributeName := '';
340 attributeValue := '';
341
342 FileThruWhile( f, kXMLWhite );
343
344 while f.Position < f.Size do
345 begin
346 f.ReadBuffer( ch, 1 );
347
348 if XMLCloseCheck( f, node, ch, tag, isClosed ) then
349 begin
350 if isClosed then
351 begin
352 // ?帥?違???????????????с???帥?若??/span>
353 // ??odeName ???????????????ч??筝??ч????????????????????
354 // ???c????????若????
355 exit;
356 end;
357
358 // 罨<?????若????/span>
359 goto NextNode;
360 end else if ch = '=' then
361 begin
362 // ???????????ゃ??紮??障?????у???????篋?
363 break;
364 end else if ch in kXMLWhite then
365 begin
366 // Value ??絖?????????(荀?弱?)???ф??????若????/span>
367 goto NextNode;
368 end else begin
369 attributeName := attributeName + ch;
370
371 if ch in kXMLKanji then
372 begin
373 f.ReadBuffer( ch, 1 );
374 attributeName := attributeName + ch;
375 end;
376 end;
377 end;
378
379 // Attribute ???ゃ??茯??粋昭??/span>
380 FileThruWhile( f, kXMLWhite );
381
382 while f.Position < f.Size do
383 begin
384 f.ReadBuffer( ch, 1 );
385
386 if XMLCloseCheck( f, node, ch, tag, isClosed ) then
387 begin
388 if isClosed then
389 begin
390 if Length( attributeName ) > 0 then
391 // 荀?弱?????????/span>
392 node.AddAttribute( attributeName, attributeValue );
393
394 // ?帥?違???????????????с???帥?若??/span>
395 // ??odeName ???????????????ч??筝??ч????????????????????
396 // ???c????????若????
397 exit;
398 end;
399
400 // 罨<?????若????/span>
401 goto NextNode;
402 end else if ch = '"' then
403 begin
404 // ?ゃ?? "" ?ф????????????????????????????????????????????????????
405 // ?ゃ??筝?????粋昭??/span>
406 last := f.Position;
407 FileThruUntil( f, kXMLDQuote );
408 tagLen := f.Position - last;
409 SetLength( attributeValue, tagLen );
410
411 f.Seek( last, soFromBeginning );
412 f.ReadBuffer( PChar( attributeValue )^, tagLen );
413
414 node.AddAttribute( attributeName, HtmlDecode( attributeValue ) );
415
416 // ?ゃ??茯??睡???c?????х?篋?
417 f.Seek( f.Position + 1, soFromBeginning ); // '"' 蕋??違??
418 break;
419 end else if ch in kXMLWhite then
420 begin
421 // 荀?弱?????????/span>
422 node.AddAttribute( attributeName, HtmlDecode( attributeValue ) );
423
424 goto NextNode;
425 end else begin
426 // 荀?弱????????綽????c??????span>
427 attributeValue := attributeValue + ch;
428
429 if ch in kXMLKanji then
430 begin
431 f.ReadBuffer( ch, 1 );
432 attributeValue := attributeValue + ch;
433 end;
434 end;
435 end;
436 end; // Attribute ????粋昭??/span>
437
438 NextNode:;
439 end; // // node ????粋昭??1 ???若?????ゃ?? 1 ???若??)
440 finally
441 end;
442 end;
443
444 function LoadXMLDocument(
445 const fileName : string
446 ) : IXMLDocument;
447 type
448 xmlMode = ( xmlHoge );
449 var
450 xmlFile : TFileStream;
451 doc : IXMLDocument;
452 begin
453
454 doc := IXMLDocument.Create;
455
456 xmlFile := TFileStream.Create( fileName, fmOpenRead );
457 XMLReadNode( xmlFile, IXMLNode( doc ) );
458 xmlFile.Free;
459
460 Result := doc;
461
462 end;
463
464 end.
465

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26