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.1 - (hide annotations) (download) (as text)
Sun Sep 21 08:45:31 2003 UTC (20 years, 7 months ago) by yoffy
Branch: MAIN
File MIME type: text/x-pascal
・コード整理

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

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