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

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