Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to Build an Easy-to-Use Parser/Parsing Framework (Part II) Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
07-Jul-03
Category
Algorithm
Language
Delphi 2.x
Views
141
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			Author: Marc Hoffmann

How to create a simple parsing framework to parse any kind of data?

Answer:

Welcome to the second part of my article "Building an Easy-to-Use Parser/Parsing 
Framework". This time, I want to show you how to create a real working dtd parser 
as exemplified in the first part. If you don't read my first article, please make 
up for this now: 

Building an Easy-to-Use Parser/Parsing Framework (Part I) 

As mentioned earlier, we need a dtd document which holds up all our parsed 
informations in an easy-to-access object model. Take a look at the following 
interface section: 

1   type
2     { TDTDAttributeTyp }
3   
4     TDTDAttributeTyp =
5       (atData, atID, atIDRef, atEnumeration);
6   
7     { TDTDAttributeStatus }
8   
9     TDTDAttributeStatus =
10      (asDefault, asImplied, asRequired, asFixed);
11  
12    { TDTDChildTyp }
13  
14    TDTDChildTyp =
15      (ctElement, ctChoice, ctSequence);
16  
17    { TDTDElementTyp }
18  
19    TDTDElementTyp =
20      (etAny, etEmpty, etData, etContainer);
21  
22    { TDTDElementStatus }
23  
24    TDTDElementStatus =
25      (esRequired, esRequiredSeq, esOptional, esOptionalSeq);
26  
27    { TDTDItem }
28  
29    TDTDItem = class(TCollectionItem)
30    private
31      { Private declarations }
32      FName: string;
33    public
34      { Public declarations }
35      procedure Assign(Source: TPersistent); override;
36    published
37      { Published declarations }
38      property Name: string read FName write FName;
39    end;
40  
41    { TDTDItems }
42  
43    TDTDItems = class(TCollection)
44    private
45      { Private declarations }
46      function GetItem(Index: Integer): TDTDItem;
47      procedure SetItem(Index: Integer; Value: TDTDItem);
48    public
49      { Public declarations }
50      function Add: TDTDItem;
51      function Find(const Name: string): TDTDItem;
52      property Items[Index: Integer]: TDTDItem read GetItem write SetItem;
53      default;
54    end;
55  
56    { TDTDEntity }
57  
58    TDTDEntity = class(TDTDItem)
59    private
60      { Private declarations }
61    public
62      { Public declarations }
63      procedure Assign(Source: TPersistent); override;
64    published
65      { Published declarations }
66    end;
67  
68    { TDTDEntities }
69  
70    TDTDEntities = class(TDTDItems)
71    private
72      { Private declarations }
73      function GetItem(Index: Integer): TDTDEntity;
74      procedure SetItem(Index: Integer; Value: TDTDEntity);
75    public
76      { Public declarations }
77      function Add: TDTDEntity;
78      function Find(const Name: string): TDTDEntity;
79      property Items[Index: Integer]: TDTDEntity read GetItem write SetItem;
80      default;
81    end;
82  
83    { TDTDEnum }
84  
85    TDTDEnum = class(TDTDItem)
86    private
87      { Private declarations }
88    public
89      { Public declarations }
90      procedure Assign(Source: TPersistent); override;
91    published
92      { Published declarations }
93    end;
94  
95    { TDTDEnums }
96  
97    TDTDEnums = class(TDTDItems)
98    private
99      { Private declarations }
100     function GetItem(Index: Integer): TDTDEnum;
101     procedure SetItem(Index: Integer; Value: TDTDEnum);
102   public
103     { Public declarations }
104     function Add: TDTDEnum;
105     function Find(const Name: string): TDTDEnum;
106     property Items[Index: Integer]: TDTDEnum read GetItem write SetItem;
107     default;
108   end;
109 
110   { TDTDAttribute }
111 
112   TDTDAttribute = class(TDTDItem)
113   private
114     { Private declarations }
115     FTyp: TDTDAttributeTyp;
116     FStatus: TDTDAttributeStatus;
117     FDefault: string;
118     FEnums: TDTDEnums;
119     procedure SetEnums(Value: TDTDEnums);
120   public
121     { Public declarations }
122     constructor Create(Collection: TCollection); override;
123     destructor Destroy; override;
124     procedure Assign(Source: TPersistent); override;
125   published
126     { Published declarations }
127     property Typ: TDTDAttributeTyp read FTyp write FTyp;
128     property Status: TDTDAttributeStatus read FStatus write FStatus;
129     property default: string read FDefault write FDefault;
130     property Enums: TDTDEnums read FEnums write SetEnums;
131   end;
132 
133   { TDTDAttributes }
134 
135   TDTDAttributes = class(TDTDItems)
136   private
137     { Private declarations }
138     function GetItem(Index: Integer): TDTDAttribute;
139     procedure SetItem(Index: Integer; Value: TDTDAttribute);
140   public
141     { Public declarations }
142     function Add: TDTDAttribute;
143     function Find(const Name: string): TDTDAttribute;
144     property Items[Index: Integer]: TDTDAttribute read GetItem write
145     SetItem; default;
146   end;
147 
148   { TDTDProperty }
149 
150   TDTDProperty = class(TDTDItem)
151   private
152     { Private declarations }
153     FStatus: TDTDElementStatus;
154   public
155     { Public declarations }
156     procedure Assign(Source: TPersistent); override;
157   published
158     { Published declarations }
159     property Status: TDTDElementStatus read FStatus write FStatus;
160   end;
161 
162   { TDTDProperties}
163 
164   TDTDProperties = class(TDTDItems)
165   private
166     { Private declarations }
167     function GetItem(Index: Integer): TDTDProperty;
168     procedure SetItem(Index: Integer; Value: TDTDProperty);
169   public
170     { Public declarations }
171     function Add: TDTDProperty;
172     function Find(const Name: string): TDTDProperty;
173     property Items[Index: Integer]: TDTDProperty read GetItem write
174     SetItem; default;
175   end;
176 
177   { TDTDChild }
178 
179   TDTDChilds = class;
180 
181   TDTDChild = class(TDTDProperty)
182   private
183     { Private declarations }
184     FTyp: TDTDChildTyp;
185     FChilds: TDTDChilds;
186     procedure SetChilds(const Value: TDTDChilds);
187   public
188     { Public declarations }
189     constructor Create(Collection: TCollection); override;
190     destructor Destroy; override;
191     procedure Assign(Source: TPersistent); override;
192   published
193     { Published declarations }
194     property Typ: TDTDChildTyp read FTyp write FTyp;
195     property Childs: TDTDChilds read FChilds write SetChilds;
196   end;
197 
198   { TDTDChilds}
199 
200   TDTDChilds = class(TDTDProperties)
201   private
202     { Private declarations }
203     function GetItem(Index: Integer): TDTDChild;
204     procedure SetItem(Index: Integer; Value: TDTDChild);
205   public
206     { Public declarations }
207     function Add: TDTDChild;
208     function Find(const Name: string): TDTDChild;
209     property Items[Index: Integer]: TDTDChild read GetItem write SetItem;
210     default;
211   end;
212 
213   { TDTDElement }
214 
215   TDTDElement = class(TDTDProperty)
216   private
217     { Private declarations }
218     FTyp: TDTDElementTyp;
219     FAttributes: TDTDAttributes;
220     FChilds: TDTDChilds;
221     procedure SetAttributes(Value: TDTDAttributes);
222     procedure SetChilds(Value: TDTDChilds);
223   public
224     { Public declarations }
225     constructor Create(Collection: TCollection); override;
226     destructor Destroy; override;
227     procedure Assign(Source: TPersistent); override;
228   published
229     { Published declarations }
230     property Typ: TDTDElementTyp read FTyp write FTyp;
231     property Attributes: TDTDAttributes read FAttributes write
232       SetAttributes;
233     property Childs: TDTDChilds read FChilds write SetChilds;
234   end;
235 
236   { TDTDElements }
237 
238   TDTDElements = class(TDTDProperties)
239   private
240     { Private declarations }
241     function GetItem(Index: Integer): TDTDElement;
242     procedure SetItem(Index: Integer; Value: TDTDElement);
243   public
244     { Public declarations }
245     function Add: TDTDElement;
246     function Find(const Name: string): TDTDElement;
247     property Items[Index: Integer]: TDTDElement read GetItem write
248     SetItem; default;
249   end;
250 
251   { TDTDDocument }
252 
253   TDTDDocument = class(TPersistent)
254   private
255     { Private declarations }
256     FEntities: TDTDEntities;
257     FElements: TDTDElements;
258     procedure SetEntities(Value: TDTDEntities);
259     procedure SetElements(Value: TDTDElements);
260   public
261     { Public declarations }
262     constructor Create;
263     destructor Destroy; override;
264     procedure Assign(Source: TPersistent); override;
265   published
266     { Published declarations }
267     property Entities: TDTDEntities read FEntities write SetEntities;
268     property Elements: TDTDElements read FElements write SetElements;
269   end;


This model implements all needed objects to parse a dtd file. Notice, that not all 
dtd grammars are reflected in this model, it's up to you to improve my work - but 
it's enough to parse all standard dtd files. 

Next, we need to create our dtd parser, which will be inherited by 
TValidationParser as professed in Part I: 

270 type
271   { EDTDParser }
272 
273   EDTDParser = class(Exception);
274 
275   { TDTDParser }
276 
277   TDTDParser = class(TValidationParser)
278   private
279     { Private declarations }
280     procedure ParseElement(Parser: TStringParser; Document: TDTDDocument;
281       const Pass: Integer);
282     procedure ParseAttlist(Parser: TStringParser; Document: TDTDDocument);
283     procedure ParseFile(const FileName: string; Document: TDTDDocument;
284       const Pass: Integer = 0);
285   public
286     { Public declarations }
287     procedure Parse(const FileName: string; var Document: TDTDDocument);
288   end;


The new exception class EDTDParser will be raised, if the passed filename is 
physical not available. One of the weightily methods is Parse. The first parameter 
must be an existing filename of the dtd file to be parsed. The second parameter is 
the document which holds our object model and must be pre-initialized. The 
implementation of this  method is as followed: 
289 
290 procedure TDTDParser.Parse(const FileName: string; var Document: TDTDDocument);
291  var
292    TmpDocument: TDTDDocument;
293  begin
294    if not assigned(Document) then
295      raise EDTDParser.Create('Document not assigned!');
296    TmpDocument := TDTDDocument.Create;
297    try
298      ParseFile(FileName, TmpDocument);
299      if Errors.Count = 0 then
300        Document.Assign(TmpDocument);
301    finally
302      TmpDocument.Free;
303    end;
304  end;


In Line 5 we're looking if the passed document was successfully initialized; if 
not, an exception (EDTDParser) will be raised. After comparing that, we create a 
new temporary instance of a dtd document (Line 7) and parse the passed filename 
(Line 9). If no errors occured (Line 10) we make a copy of the filled dtd document 
by assigning it to the passed one (Line 11). 

Consecutively we take a look to the ParseFile procedure, which initializes the main 
parsing process and looks for the basic keywords: (Note: The italic lines are not 
part of the sourcecode - they are used to explain the unique sections) 
305 
306 procedure TDTDParser.ParseFile(const FileName: string;
307   Document: TDTDDocument; const Pass: Integer = 0);
308 var
309   Parser: TStringParser;
310 begin
311   {Create a new instance of the TStringParser.}
312   Parser := TStringParser.Create;
313   try
314     {Check, if the passed filename already exists.}
315     if not Parser.LoadFromFile(FileName) then
316     begin
317       AddErrorFmt('File "%s" not found', [FileName], Parser);
318       Exit;
319     end;
320     {Initialize an endless loop.}
321     while True do
322     begin
323       {Skip to the next valid Tag-Begin-Token "<" or EOF.}
324       while not (Parser.Token in [toEOF, '<']) do
325         Parser.SkipToken;
326       {Break look, if current Token is EOF - End of File.}
327       if Parser.Token = toEOF then
328         Break;
329       {Get the next Token - after Tag-Begin "<".}
330       Parser.SkipToken;
331       {Check for valid identification Tag "!" or "?".}
332       if Parser.Token <> '!' then
333       begin
334         {Only add an error if the current Pass is one "1".}
335         if not (Parser.Token in ['?']) and (Pass = 1) then
336           AddError('InvalidToken', Parser);
337         Continue;
338       end;
339       {Check for valid Symbol or Comment Line.}
340       if Parser.SkipToken <> toSymbol then
341       begin
342         if (Parser.Token <> '-') and (Pass = 1) then
343           AddError('InvalidToken', Parser);
344         Continue;
345       end;
346       {Check for "Entity" Tag.}
347       if UpperCase(Parser.TokenString) = 'ENTITY' then
348         Continue;
349       {Check for "Element" Tag.}
350       if UpperCase(Parser.TokenString) = 'ELEMENT' then
351         ParseElement(Parser, Document, Pass)
352       else
353         {Check for "Attribute" Tag.} if UpperCase(Parser.TokenString) = 'ATTLIST' 
354 then
355         begin
356           if Pass = 1 then
357             ParseAttlist(Parser, Document);
358         end
359           {Add an error on invalid Symbols.}
360         else if Pass = 1 then
361           AddErrorFmt('Invalid Symbol "%s"', [Parser.TokenString], Parser);
362     end;
363     {Initialize Pass 2 - if currently finished Pass 1.}
364     if Pass = 0 then
365       ParseFile(FileName, Document, 1);
366   finally
367     Parser.Free;
368   end;
369 end;


The ParseFile method simply starts parsing the main structure of a dtd file and 
tries to extract some basic keywords like Entity, Element or Attribute. If one of 
the last two keywords were found, a special (ParseElement or ParseAttlist) method 
is called to create the corresponding object and to extract additional 
informations. If the parser founds any syntax or grammar errors, respectively items 
are created. 

The method ParseElement includes the functionality to parse and extract further 
informations, like Type or Rule: 
(Note: The italic lines are not part of the sourcecode - they are used to explain 
the unique sections) 
370 
371 procedure TDTDParser.ParseElement(Parser: TStringParser;
372   Document: TDTDDocument; const Pass: Integer);
373 var
374   Element: TDTDElement;
375   Child: TDTDChild;
376   Rule: string;
377 begin
378   {Get the next Token.}
379   Parser.SkipToken;
380   {On first pass, create a new element.}
381   if Pass = 0 then
382     Element := Document.Elements.Add
383       {On second pass, find previous created element.}
384   else
385     Element := Document.Elements.Find(Parser.TokenString);
386   {Set the new element name.}
387   Element.Name := Parser.TokenString;
388   try
389     {Add an error if the current Token isn't a symbol.}
390     if Parser.Token <> toSymbol then
391       Abort;
392     {Check for element rule, like "any", "empty" or "sequence"...}
393     Rule := UpperCase(Parser.SkipTokenString);
394     {...Found Rule: "ANY".}
395     if (Rule = 'ANY') and (Parser.SkipToken = '>') then
396     begin
397       Element.Typ := etAny;
398       Exit;
399     end;
400     {...Found Rule: "EMPTY".}
401     if (Rule = 'EMPTY') and (Parser.SkipToken = '>') then
402     begin
403       Element.Typ := etEmpty;
404       Exit;
405     end;
406     if (Rule = '(') then
407     begin
408       {...Found Rule: "PCDATA".}
409       if Parser.SkipToken in [toEOF, '>'] then
410         Abort;
411       if Parser.Token = '#' then
412       begin
413         if UpperCase(Parser.SkipToToken('>')) = 'PCDATA)' then
414         begin
415           Element.Typ := etData;
416           Exit;
417         end;
418         Abort;
419       end;
420       {...Found Rule: "sequence/container".}
421       Element.Typ := etContainer;
422       repeat
423         {Create Child objects, if pass = 1.}
424         Child := nil;
425         if not (Parser.Token in ['|', ',', ')']) then
426         begin
427           if Pass = 0 then
428           begin
429             Child := Element.Childs.Add;
430             Child.Name := Parser.TokenString;
431             Child.Typ := ctElement;
432           end
433           else if Document.Elements.Find(Parser.TokenString) = nil then
434             AddErrorFmt('Invalid Element Target "%s"', [Parser.TokenString], 
435 Parser);
436         end;
437         Parser.SkipToken;
438         {Check Child Status (=sequence style).}
439         if Parser.Token in ['+', '?', '*'] then
440         begin
441           if Child <> nil then
442             case Parser.Token of
443               '+':
444                 Child.Status := esRequiredSeq;
445               '?':
446                 Child.Status := esOptional;
447               '*':
448                 Child.Status := esOptionalSeq;
449             end;
450           Parser.SkipToken;
451         end;
452       until Parser.SkipToken in [toEOF, '>'];
453       Exit;
454     end;
455     {Add an error only on pass 1.}
456     if Pass = 1 then
457       AddErrorFmt('Invalid Element Rule "%s"', [Rule], Parser);
458   except
459     {Add an error only on pass 1.}
460     if Pass = 1 then
461       AddError('InvalidElementFormat', Parser);
462   end;
463 end;


The method ParseAttlist includes the functionality to parse and extract further 
informations, like Type or Enumerations: (Note: The italic lines are not part of 
the sourcecode - they are used to explain the unique sections) 
464 
465 procedure TDTDParser.ParseAttlist(Parser: TStringParser; Document: TDTDDocument);
466 var
467   Attribute: TDTDAttribute;
468   Element: TDTDElement;
469   Target, Typ: string;
470 begin
471   {Get the next Token.}
472   Target := Parser.SkipTokenString;
473   try
474     {Add an error if the current Token isn't a symbol.}
475     if Parser.Token <> toSymbol then
476       Abort;
477     {Try to find the element target.}
478     Element := Document.Elements.Find(Target);
479     {Add an error if no element was found.}
480     if Element = nil then
481     begin
482       AddErrorFmt('Invalid Element Target "%s"', [Target], Parser);
483       Exit;
484     end;
485     {Get the next Token.}
486     Parser.SkipToken;
487     repeat
488       {Add an error if the current Token isn't a symbol.}
489       if Parser.Token <> toSymbol then
490         Abort;
491       {Create a new Attribute under the located element.}
492       Attribute := Element.Attributes.Add;
493       {Set the new name.}
494       Attribute.Name := Parser.TokenString;
495       {Check for Attribute Type...}
496       Typ := Parser.SkipTokenString;
497       {...Found Type "CDDATA".}
498       if UpperCase(Typ) = 'CDATA' then
499         Attribute.Typ := atData
500       else
501         {...Found Type "ID".} if UpperCase(Typ) = 'ID' then
502           Attribute.Typ := atID
503         else
504           {...Found Type "IDREF".} if UpperCase(Typ) = 'IDREF' then
505             Attribute.Typ := atIDRef
506           else
507             {...Found Type "enumeration".} if Typ = '(' then
508             begin
509               Attribute.Typ := atEnumeration;
510               {Seperate enumeration parts and attach them}
511               {to the parent attribute.}
512               repeat
513                 Parser.SkipToken;
514                 if not (Parser.Token in ['|', ')']) then
515                   Attribute.Enums.Add.Name := Parser.TokenString;
516               until Parser.Token in [toEOF, ')'];
517               {Add an error, if current token is "EOF".}
518               if Parser.Token = toEOF then
519               begin
520                 AddErrorFmt('Invalid Enumeration End in Attribute "%s"',
521                   [Attribute.Name], Parser);
522                 Exit;
523               end;
524             end
525             else
526             begin
527               AddErrorFmt('Invalid Attribute Typ "%s"', [Typ], Parser);
528               Exit;
529             end;
530       {Check for Restrictions...}
531       Parser.SkipToken;
532       if Parser.Token = '#' then
533       begin
534         {...Found Restriction "IMPLIED".}
535         Typ := UpperCase(Parser.SkipTokenString);
536         if Typ = 'IMPLIED' then
537         begin
538           Attribute.Status := asImplied;
539           Parser.SkipToken;
540         end;
541         {...Found Restriction "REQUIRED".}
542         if Typ = 'REQUIRED' then
543         begin
544           Attribute.Status := asRequired;
545           Parser.SkipToken;
546         end;
547         {...Found Restriction "FIXED".}
548         if Typ = 'FIXED' then
549         begin
550           Attribute.Status := asFixed;
551           Parser.SkipToken;
552         end;
553       end;
554       {Extract an optional default value.}
555       if Parser.Token = '"' then
556       begin
557         if Attribute.Status = asImplied then
558           Abort;
559         Attribute.default := Trim(Parser.SkipToToken('"'));
560         Parser.SkipToken;
561       end;
562     until Parser.Token = '>';
563   except
564     AddErrorFmt('Invalid Attribute Format "%s"', [Target], Parser);
565   end;
566 end;


Note: The above methods only detects simple dtd grammas. To parse all possible tags 
and additional grammars you had to include a more complex algorithm to do that - 
for our purposes (and this article) it's enough. If you are not familiar with the 
dtd syntax, check out the site W3Schoolshttp://www.w3schools.com/. 

Okay, at this point we have finished our object-model and parser implementation. 
All we need now is an example application which will take use of this units. Our 
demo application will parse a dtd file, detects the structure and creates a simple 
xml output with a given startup node. Take a look at the following dtd: 

 
 
 
 
 
 
 
 
 

Our demo application will create the following xml output: 

 
 

 
   
   
   
     
     
   
   
 

In this case, the startup node is BeratungsKontextResp which will be used as the 
root node for all other nodes. Our example is implemented as a console application 
as followed: 

567 program dtd2xml;
568 
569 {$APPTYPE CONSOLE}
570 
571 uses
572   SysUtils,
573   DTD_Parser in 'DTD_Parser.pas',
574   DTD_Document in 'DTD_Document.pas',
575   StringParser in 'StringParser.pas',
576   PrivateParser in 'PrivateParser.pas';
577 
578 var
579   FileName: string;
580   Switch_XMLRoot: string;
581   Switch_XMLData: Boolean;
582   Switch_RootLst: Boolean;
583   DTDDocument: TDTDDocument;
584   DTDParser: TDTDParser;
585   RootElement: TDTDElement;
586   i: Integer;
587 
588   {-----------------------------------------------------------------------------
589     Procedure: FindCmdSwitch
590     Author:    mh
591     Date:      23-Jan-2002
592     Arguments: const Switch: string; const Default: string = ''
593     Result:    string
594   -----------------------------------------------------------------------------}
595 
596 function FindCmdSwitch(const Switch: string; const default: string = ''): string;
597 var
598   i: Integer;
599 begin
600   Result := '';
601   for i := 1 to ParamCount do
602     if UpperCase(Copy(ParamStr(i), 1, Length(Switch))) = UpperCase(Switch) then
603     begin
604       Result := Copy(ParamStr(i), Length(Switch) + 1, MAXINT);
605       Exit;
606     end;
607   if Result = '' then
608     Result := default;
609 end;
610 
611 {-----------------------------------------------------------------------------
612   Procedure: WriteXML
613   Author:    mh
614   Date:      23-Jan-2002
615   Arguments: const AElement: TDTDElement; const AStatus: TDTDElementStatus; Indent: 
616 Integer = 0
617   Result:    None
618 -----------------------------------------------------------------------------}
619 
620 procedure WriteXML(const AElement: TDTDElement; const AStatus: TDTDElementStatus;
621   Indent: Integer = 0);
622 var
623   i: Integer;
624   Spacer, Def: string;
625 begin
626   for i := 1 to Indent * 2 do
627     Spacer := Spacer + #32;
628   write(Spacer + '<' + AElement.Name);
629   for i := 0 to AElement.Attributes.Count - 1 do
630     with AElement.Attributes[i] do
631     begin
632       Def := default;
633       if (Switch_XMLData) and (Def = '') then
634       begin
635         if Typ = atEnumeration then
636         begin
637           if Enums.Count > 0 then
638             Def := Enums[0].Name
639           else
640             Def := '???';
641         end
642         else
643           Def := Name;
644       end;
645       write(Format(' %s="%s"', [Name, Def]));
646     end;
647   if AElement.Typ <> etContainer then
648   begin
649     Def := '';
650     if (Switch_XMLData) and (AElement.Typ <> etEmpty) then
651       Def := AElement.Name;
652     WriteLn(Format('>%s', [Def, AElement.Name]));
653   end
654   else
655     WriteLn('>');
656   for i := 0 to AElement.Childs.Count - 1 do
657     WriteXML(DTDDocument.Elements.Find(AElement.Childs[i].Name),
658       AElement.Childs[i].Status, Indent + 1);
659   if AElement.Typ = etContainer then
660     WriteLn(Spacer + Format('', [AElement.Name]));
661 end;
662 
663 {-----------------------------------------------------------------------------
664   Procedure: main
665   Author:    mh
666   Date:      23-Jan-2002
667   Arguments: None
668   Result:    None
669 -----------------------------------------------------------------------------}
670 begin
671   // display usage.
672   if (ParamCount = 0) or (FindCmdSwitch('-?', '?') <> '?') then
673   begin
674     WriteLn('');
675     WriteLn('dtd2xml (parser framework example) version 1.0');
676     WriteLn('(w)ritten 2002 by Marc Hoffmann. GNU License');
677     WriteLn('');
678     WriteLn('Usage: dtd2xml [options] [-?]');
679     WriteLn('');
680     WriteLn('Options:');
681     WriteLn('-xmlroot=           XML root element (? = possible elements)');
682     WriteLn('-xmldata=yes|no           Include XML Example data (default = yes)');
683     WriteLn('');
684     Exit;
685   end;
686 
687   // exract filename.
688   FileName := ParamStr(1);
689 
690   // append default extenstion,
691   if ExtractFileExt(FileName) = '' then
692     FileName := ChangeFileExt(FileName, '.dtd');
693 
694   // file exists?
695   if not FileExists(FileName) then
696   begin
697     WriteLn(Format('Fatal: File not found ''%s''.', [FileName]));
698     Exit;
699   end;
700 
701   // extract command-line switches.
702   Switch_RootLst := FindCmdSwitch('-xmlroot=') = '?';
703   Switch_XMLRoot := FindCmdSwitch('-xmlroot=');
704   Switch_XMLData := UpperCase(FindCmdSwitch('-xmldata=')) <> 'NO';
705 
706   // create new dtd-document.
707   DTDDocument := TDTDDocument.Create;
708   try
709     // create new dtd-parser.
710     DTDParser := TDTDParser.Create;
711     try
712       // parse file.
713       DTDParser.Parse(FileName, DTDDocument);
714 
715       // display possible errors.
716       if DTDParser.Errors.Count > 0 then
717       begin
718         for i := 0 to DTDParser.Errors.Count - 1 do
719           with DTDParser.Errors[i] do
720             WriteLn(Format('Error in Line %d, Pos %d: %s...', [Line, Position,
721               message]));
722         Exit;
723       end;
724 
725       // search rootelement.
726       RootElement := DTDDocument.Elements.Find(Switch_XMLRoot);
727 
728       // display rootelements & assign possible object.
729       for i := 0 to DTDDocument.Elements.Count - 1 do
730         if DTDDocument.Elements[i].Typ = etContainer then
731         begin
732           if Switch_RootLst then
733             WriteLn(DTDDocument.Elements[i].Name)
734           else if (Switch_XMLRoot = '') and ((RootElement = nil) or ((RootElement <>
735             nil)
736             and (RootElement.Childs.Count < DTDDocument.Elements[i].Childs.Count)))
737               then
738             RootElement := DTDDocument.Elements[i];
739         end;
740 
741       // exit app if rootlist-switch was set.
742       if Switch_RootLst then
743         Exit;
744 
745       // exit app if rootelement is NIL.
746       if RootElement = nil then
747       begin
748         WriteLn(Format('Fatal: Root Element ''%s'' not found.', [Switch_XMLRoot]));
749         Exit;
750       end;
751 
752       // exit app if rootelement is invalid.
753       if RootElement.Typ <> etContainer then
754       begin
755         WriteLn(Format('Fatal: ''%s'' is not a valid Root Element.',
756           [Switch_XMLRoot]));
757         Exit;
758       end;
759 
760       // write xml output.
761       WriteLn(Format('' + #13 + '', [RootElement.Name, ExtractFileName(FileName)]));
762       WriteLn('');
763       WriteXML(RootElement, RootElement.Status);
764 
765       // free dtd-parser.
766     finally
767       DTDParser.Free;
768     end;
769 
770     // free dtd-document.
771   finally
772     DTDDocument.Free;
773   end;
774 end.



			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC