Develop and Download Open Source Software

Browse CVS Repository

Annotation of /gikonavigoeson/gikonavi/GikoXMLDoc.pas

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


Revision 1.6 - (hide 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 yoffy 1.1 unit GikoXMLDoc;
2    
3     {
4     XMLIntf, XMLDoc ?????????????若??/span>
5 yoffy 1.2 Delphi 6 Personal ??/span>
6 yoffy 1.1 }
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 yoffy 1.5 constructor Create;
38     destructor Destroy; override;
39 yoffy 1.1
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 h677 1.6 procedure LoadXMLDocument(
70     const fileName : string;
71     var doc : IXMLDocument
72     );
73 yoffy 1.1
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 yoffy 1.5 constructor IXMLNode.Create;
89 yoffy 1.1 begin
90    
91 yoffy 1.5 inherited;
92    
93 yoffy 1.1 FCount := 0;
94 yoffy 1.5
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 yoffy 1.1
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 yoffy 1.4 node.AddAttribute( attributeName, HtmlDecode( attributeValue ) );
416 yoffy 1.1
417     // ?ゃ??茯??睡???c?????х?篋?
418     f.Seek( f.Position + 1, soFromBeginning ); // '"' 蕋??違??
419     break;
420     end else if ch in kXMLWhite then
421     begin
422     // 荀?弱?????????/span>
423 yoffy 1.4 node.AddAttribute( attributeName, HtmlDecode( attributeValue ) );
424 yoffy 1.1
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 h677 1.6 procedure LoadXMLDocument(
446     const fileName : string;
447     var doc : IXMLDocument
448     );
449 yoffy 1.1 type
450     xmlMode = ( xmlHoge );
451     var
452     xmlFile : TFileStream;
453     begin
454 h677 1.6 //Result := IXMLDocument.Create;
455     //doc := IXMLDocument.Create;
456 yoffy 1.1
457 h677 1.6 xmlFile := TFileStream.Create( fileName, fmOpenRead );
458 yoffy 1.1
459 h677 1.6 try
460     XMLReadNode( xmlFile, IXMLNode( doc ) );
461     //XMLReadNode( xmlFile, IXMLNode( Result ) );
462     finally
463     xmlFile.Free;
464     end;
465 yoffy 1.1
466 h677 1.6 //Result := doc;
467 yoffy 1.1
468     end;
469    
470     end.

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