Download as
Browse Code »

Commit b7e26a8d5c3b3c6ed511a2b9bcee519690f1d840

Authored by anderson.peterle@previdencia.gov.br
1 parent 7684306d
Exists in master

Exclusão para posterior reposição com versão 2.6-Beta-2 

git-svn-id: http://svn.softwarepublico.gov.br/svn/cacic/cacic/trunk/agente-windows@968 fecfc0c7-e812-0410-ae72-849f08638ee7
Showing 11 changed files with 0 additions and 3812 deletions   Show diff stats
testacrypt/LEIAME
View file @7684306
... ... @@ -1,2 +0,0 @@
1   -
2   -Esse utilitário foi construído para teste do processo de criptografia entre o Gerente de Coletas e o Gerente WEB.
testacrypt/LibXmlParser.pas
View file @7684306
... ... @@ -1,2728 +0,0 @@
1   -(**
2   -===============================================================================================
3   -Name : LibXmlParser
4   -===============================================================================================
5   -Project : All Projects
6   -===============================================================================================
7   -Subject : Progressive XML Parser for all types of XML Files
8   -===============================================================================================
9   -Author : Stefan Heymann
10   - Eschenweg 3
11   - 72076 Tübingen
12   - GERMANY
13   -
14   -E-Mail: stefan@destructor.de
15   -URL: www.destructor.de
16   -===============================================================================================
17   -Source, Legals ("Licence")
18   ---------------------------
19   -The official site to get this parser is http://www.destructor.de/
20   -
21   -Usage and Distribution of this Source Code is ruled by the
22   -"Destructor.de Source code Licence" (DSL) which comes with this file or
23   -can be downloaded at http://www.destructor.de/
24   -
25   -IN SHORT: Usage and distribution of this source code is free.
26   - You use it completely on your own risk.
27   -
28   -Postcardware
29   -------------
30   -If you like this code, please send a postcard of your city to my above address.
31   -===============================================================================================
32   -!!! All parts of this code which are not finished or not conforming exactly to
33   - the XmlSpec are marked with three exclamation marks
34   -
35   --!- Parts where the parser may be able to detect errors in the document's syntax are
36   - marked with the dash-exlamation mark-dash sequence.
37   -===============================================================================================
38   -Terminology:
39   -------------
40   -- Start: Start of a buffer part
41   -- Final: End (last character) of a buffer part
42   -- DTD: Document Type Definition
43   -- DTDc: Document Type Declaration
44   -- XMLSpec: The current W3C XML Recommendation (version 1.0 as of 1998-02-10), Chapter No.
45   -- Cur*: Fields concerning the "Current" part passed back by the "Scan" method
46   -===============================================================================================
47   -Scanning the XML document
48   --------------------------
49   -- Create TXmlParser Instance MyXml := TXmlParser.Create;
50   -- Load XML Document MyXml.LoadFromFile (Filename);
51   -- Start Scanning MyXml.StartScan;
52   -- Scan Loop WHILE MyXml.Scan DO
53   -- Test for Part Type CASE MyXml.CurPartType OF
54   -- Handle Parts ... : ;;;
55   -- Handle Parts ... : ;;;
56   -- Handle Parts ... : ;;;
57   - END;
58   -- Destroy MyXml.Free;
59   -===============================================================================================
60   -Loading the XML document
61   -------------------------
62   -You can load the XML document from a file with the "LoadFromFile" method.
63   -It is beyond the scope of this parser to perform HTTP or FTP accesses. If you want your
64   -application to handle such requests (URLs), you can load the XML via HTTP or FTP or whatever
65   -protocol and hand over the data buffer using the "LoadFromBuffer" or "SetBuffer" method.
66   -"LoadFromBuffer" loads the internal buffer of TXmlParser with the given null-terminated
67   -string, thereby creating a copy of that buffer.
68   -"SetBuffer" just takes the pointer to another buffer, which means that the given
69   -buffer pointer must be valid while the document is accessed via TXmlParser.
70   -===============================================================================================
71   -Encodings:
72   -----------
73   -This XML parser kind of "understands" the following encodings:
74   -- UTF-8
75   -- ISO-8859-1
76   -- Windows-1252
77   -
78   -Any flavor of multi-byte characters (and this includes UTF-16) is not supported. Sorry.
79   -
80   -Every string which has to be passed to the application passes the virtual method
81   -"TranslateEncoding" which translates the string from the current encoding (stored in
82   -"CurEncoding") into the encoding the application wishes to receive.
83   -The "TranslateEncoding" method that is built into TXmlParser assumes that the application
84   -wants to receive Windows ANSI (Windows-1252, about the same as ISO-8859-1) and is able
85   -to convert UTF-8 and ISO-8859-1 encodings.
86   -For other source and target encodings, you will have to override "TranslateEncoding".
87   -===============================================================================================
88   -Buffer Handling
89   ----------------
90   -- The document must be loaded completely into a piece of RAM
91   -- All character positions are referenced by PChar pointers
92   -- The TXmlParser instance can either "own" the buffer itself (then, FBufferSize is > 0)
93   - or reference the buffer of another instance or object (then, FBuffersize is 0 and
94   - FBuffer is not NIL)
95   -- The Property DocBuffer passes back a pointer to the first byte of the document. If there
96   - is no document stored (FBuffer is NIL), the DocBuffer returns a pointer to a NULL character.
97   -===============================================================================================
98   -Whitespace Handling
99   --------------------
100   -The TXmlParser property "PackSpaces" determines how Whitespace is returned in Text Content:
101   -While PackSpaces is true, all leading and trailing whitespace characters are trimmed of, all
102   -Whitespace is converted to Space #x20 characters and contiguous Whitespace characters are
103   -compressed to one.
104   -If the "Scan" method reports a ptContent part, the application can get the original text
105   -with all whitespace characters by extracting the characters from "CurStart" to "CurFinal".
106   -If the application detects an xml:space attribute, it can set "PackSpaces" accordingly or
107   -use CurStart/CurFinal.
108   -Please note that TXmlParser does _not_ normalize Line Breaks to single LineFeed characters
109   -as the XmlSpec requires (XmlSpec 2.11).
110   -The xml:space attribute is not handled by TXmlParser. This is on behalf of the application.
111   -===============================================================================================
112   -Non-XML-Conforming
113   -------------------
114   -TXmlParser does not conform 100 % exactly to the XmlSpec:
115   -- UTF-16 is not supported (XmlSpec 2.2)
116   - (Workaround: Convert UTF-16 to UTF-8 and hand the buffer over to TXmlParser)
117   -- As the parser only works with single byte strings, all Unicode characters > 255
118   - can currently not be handled correctly.
119   -- Line breaks are not normalized to single Linefeed #x0A characters (XmlSpec 2.11)
120   - (Workaround: The Application can access the text contents on its own [CurStart, CurFinal],
121   - thereby applying every normalization it wishes to)
122   -- The attribute value normalization does not work exactly as defined in the
123   - Second Edition of the XML 1.0 specification.
124   -- See also the code parts marked with three consecutive exclamation marks. These are
125   - parts which are not finished in the current code release.
126   -
127   -This list may be incomplete, so it may grow if I get to know any other points.
128   -As work on the parser proceeds, this list may also shrink.
129   -===============================================================================================
130   -Things Todo
131   ------------
132   -- Introduce a new event/callback which is called when there is an unresolvable
133   - entity or character reference
134   -- Support Unicode
135   -- Use Streams instead of reading the whole XML into memory
136   -===============================================================================================
137   -Change History, Version numbers
138   --------------------------------
139   -The Date is given in ISO Year-Month-Day (YYYY-MM-DD) order.
140   -Versions are counted from 1.0.0 beginning with the version from 2000-03-16.
141   -Unreleased versions don't get a version number.
142   -
143   -Date Author Version Changes
144   ------------------------------------------------------------------------------------------------
145   -2000-03-16 HeySt 1.0.0 Start
146   -2000-03-28 HeySt 1.0.1 Initial Publishing of TXmlParser on the destructor.de Web Site
147   -2000-03-30 HeySt 1.0.2 TXmlParser.AnalyzeCData: Call "TranslateEncoding" for CurContent
148   -2000-03-31 HeySt 1.0.3 Deleted the StrPosE function (was not needed anyway)
149   -2000-04-04 HeySt 1.0.4 TDtdElementRec modified: Start/Final for all Elements;
150   - Should be backwards compatible.
151   - AnalyzeDtdc: Set CurPartType to ptDtdc
152   -2000-04-23 HeySt 1.0.5 New class TObjectList. Eliminated reference to the Delphi 5
153   - "Contnrs" unit so LibXmlParser is Delphi 4 compatible.
154   -2000-07-03 HeySt 1.0.6 TNvpNode: Added Constructor
155   -2000-07-11 HeySt 1.0.7 Removed "Windows" from USES clause
156   - Added three-exclamation-mark comments for Utf8ToAnsi/AnsiToUtf8
157   - Added three-exclamation-mark comments for CHR function calls
158   -2000-07-23 HeySt 1.0.8 TXmlParser.Clear: CurAttr.Clear; EntityStack.Clear;
159   - (This was not a bug; just defensive programming)
160   -2000-07-29 HeySt 1.0.9 TNvpList: Added methods: Node(Index), Value(Index), Name(Index);
161   -2000-10-07 HeySt Introduced Conditional Defines
162   - Uses Contnrs unit and its TObjectList class again for
163   - Delphi 5 and newer versions
164   -2001-01-30 HeySt Introduced Version Numbering
165   - Made LoadFromFile and LoadFromBuffer BOOLEAN functions
166   - Introduced FileMode parameter for LoadFromFile
167   - BugFix: TAttrList.Analyze: Must add CWhitespace to ExtractName call
168   - Comments worked over
169   -2001-02-28 HeySt 1.0.10 Completely worked over and tested the UTF-8 functions
170   - Fixed a bug in TXmlParser.Scan which caused it to start over when it
171   - was called after the end of scanning, resulting in an endless loop
172   - TEntityStack is now a TObjectList instead of TList
173   -2001-07-03 HeySt 1.0.11 Updated Compiler Version IFDEFs for Kylix
174   -2001-07-11 HeySt 1.0.12 New TCustomXmlScanner component (taken over from LibXmlComps.pas)
175   -2001-07-14 HeySt 1.0.13 Bugfix TCustomXmlScanner.FOnTranslateEncoding
176   -2001-10-22 HeySt Don't clear CurName anymore when the parser finds a CDATA section.
177   -2001-12-03 HeySt 1.0.14 TObjectList.Clear: Make call to INHERITED method (fixes a memory leak)
178   -2001-12-05 HeySt 1.0.15 TObjectList.Clear: removed call to INHERITED method
179   - TObjectList.Destroy: Inserted SetCapacity call.
180   - Reduces need for frequent re-allocation of pointer buffer
181   - Dedicated to my father, Theodor Heymann
182   -2002-06-26 HeySt 1.0.16 TXmlParser.Scan: Fixed a bug with PIs whose name is beginning
183   - with 'xml'. Thanks to Uwe Kamm for submitting this bug.
184   - The CurEncoding property is now always in uppercase letters (the XML
185   - spec wants it to be treated case independently so when it's uppercase
186   - comparisons are faster)
187   -2002-03-04 HeySt 1.0.17 Included an IFDEF for Delphi 7 (VER150) and Kylix
188   - There is a new symbol HAS_CONTNRS_UNIT which is used now to
189   - distinguish between IDEs which come with the Contnrs unit and
190   - those that don't.
191   -*)
192   -
193   -
194   -// --- Delphi/Kylix Version Numbers
195   -// As this is no code, this does not blow up your object or executable code at all
196   - (*$IFDEF LINUX *)
197   - (*$DEFINE K1_OR_NEWER *)
198   - (*$ENDIF *)
199   -
200   - (*$IFDEF MSWINDOWS *)
201   - (*$DEFINE D1_OR_NEWER *)
202   - (*$IFNDEF VER80 *)
203   - (*$DEFINE D2_OR_NEWER *)
204   - (*$IFNDEF VER90 *)
205   - (*$DEFINE D3_OR_NEWER *)
206   - (*$IFNDEF VER100 *)
207   - (*$DEFINE D4_OR_NEWER *)
208   - (*$IFNDEF VER120 *)
209   - (*$DEFINE D5_OR_NEWER *)
210   - (*$IFNDEF VER130 *)
211   - (*$IFNDEF VER140 *)
212   - (*$IFNDEF VER150 *)
213   - If the compiler gets stuck here,
214   - you are using a compiler version unknown to this code.
215   - You will probably have to change this code accordingly.
216   - At first, try to comment out these lines and see what will happen.
217   - (*$ENDIF *)
218   - (*$ENDIF *)
219   - (*$ENDIF *)
220   - (*$ENDIF *)
221   - (*$ENDIF *)
222   - (*$ENDIF *)
223   - (*$ENDIF *)
224   - (*$ENDIF *)
225   -
226   - (*$IFDEF D5_OR_NEWER *)
227   - (*$DEFINE HAS_CONTNRS_UNIT *)
228   - (*$ENDIF *)
229   -
230   - (*$IFDEF K1_OR_NEWER *)
231   - (*$DEFINE HAS_CONTNRS_UNIT *)
232   - (*$ENDIF *)
233   -
234   -
235   -UNIT LibXmlParser;
236   -
237   -INTERFACE
238   -
239   -USES
240   - SysUtils, Classes,
241   - (*$IFDEF HAS_CONTNRS_UNIT *) // The Contnrs Unit was introduced in Delphi 5
242   - Contnrs,
243   - (*$ENDIF*)
244   - Math;
245   -
246   -CONST
247   - CVersion = '1.0.17'; // This variable will be updated for every release
248   - // (I hope, I won't forget to do it everytime ...)
249   -
250   -TYPE
251   - TPartType = // --- Document Part Types
252   - (ptNone, // Nothing
253   - ptXmlProlog, // XML Prolog XmlSpec 2.8 / 4.3.1
254   - ptComment, // Comment XmlSpec 2.5
255   - ptPI, // Processing Instruction XmlSpec 2.6
256   - ptDtdc, // Document Type Declaration XmlSpec 2.8
257   - ptStartTag, // Start Tag XmlSpec 3.1
258   - ptEmptyTag, // Empty-Element Tag XmlSpec 3.1
259   - ptEndTag, // End Tag XmlSpec 3.1
260   - ptContent, // Text Content between Tags
261   - ptCData); // CDATA Section XmlSpec 2.7
262   -
263   - TDtdElemType = // --- DTD Elements
264   - (deElement, // !ELEMENT declaration
265   - deAttList, // !ATTLIST declaration
266   - deEntity, // !ENTITY declaration
267   - deNotation, // !NOTATION declaration
268   - dePI, // PI in DTD
269   - deComment, // Comment in DTD
270   - deError); // Error found in the DTD
271   -
272   -TYPE
273   - TAttrList = CLASS;
274   - TEntityStack = CLASS;
275   - TNvpList = CLASS;
276   - TElemDef = CLASS;
277   - TElemList = CLASS;
278   - TEntityDef = CLASS;
279   - TNotationDef = CLASS;
280   -
281   - TDtdElementRec = RECORD // --- This Record is returned by the DTD parser callback function
282   - Start, Final : PChar; // Start/End of the Element's Declaration
283   - CASE ElementType : TDtdElemType OF // Type of the Element
284   - deElement, // <!ELEMENT>
285   - deAttList : (ElemDef : TElemDef); // <!ATTLIST>
286   - deEntity : (EntityDef : TEntityDef); // <!ENTITY>
287   - deNotation : (NotationDef : TNotationDef); // <!NOTATION>
288   - dePI : (Target : PChar; // <?PI ?>
289   - Content : PChar;
290   - AttrList : TAttrList);
291   - deError : (Pos : PChar); // Error
292   - // deComment : ((No additional fields here)); // <!-- Comment -->
293   - END;
294   -
295   - TXmlParser = CLASS // --- Internal Properties and Methods
296   - PROTECTED
297   - FBuffer : PChar; // NIL if there is no buffer available
298   - FBufferSize : INTEGER; // 0 if the buffer is not owned by the Document instance
299   - FSource : STRING; // Name of Source of document. Filename for Documents loaded with LoadFromFile
300   -
301   - FXmlVersion : STRING; // XML version from Document header. Default is '1.0'
302   - FEncoding : STRING; // Encoding from Document header. Default is 'UTF-8'
303   - FStandalone : BOOLEAN; // Standalone declaration from Document header. Default is 'yes'
304   - FRootName : STRING; // Name of the Root Element (= DTD name)
305   - FDtdcFinal : PChar; // Pointer to the '>' character terminating the DTD declaration
306   -
307   - FNormalize : BOOLEAN; // If true: Pack Whitespace and don't return empty contents
308   - EntityStack : TEntityStack; // Entity Stack for Parameter and General Entities
309   - FCurEncoding : STRING; // Current Encoding during parsing (always uppercase)
310   -
311   - PROCEDURE AnalyzeProlog; // Analyze XML Prolog or Text Declaration
312   - PROCEDURE AnalyzeComment (Start : PChar; VAR Final : PChar); // Analyze Comments
313   - PROCEDURE AnalyzePI (Start : PChar; VAR Final : PChar); // Analyze Processing Instructions (PI)
314   - PROCEDURE AnalyzeDtdc; // Analyze Document Type Declaration
315   - PROCEDURE AnalyzeDtdElements (Start : PChar; VAR Final : PChar); // Analyze DTD declarations
316   - PROCEDURE AnalyzeTag; // Analyze Start/End/Empty-Element Tags
317   - PROCEDURE AnalyzeCData; // Analyze CDATA Sections
318   - PROCEDURE AnalyzeText (VAR IsDone : BOOLEAN); // Analyze Text Content between Tags
319   - PROCEDURE AnalyzeElementDecl (Start : PChar; VAR Final : PChar);
320   - PROCEDURE AnalyzeAttListDecl (Start : PChar; VAR Final : PChar);
321   - PROCEDURE AnalyzeEntityDecl (Start : PChar; VAR Final : PChar);
322   - PROCEDURE AnalyzeNotationDecl (Start : PChar; VAR Final : PChar);
323   -
324   - PROCEDURE PushPE (VAR Start : PChar);
325   - PROCEDURE ReplaceCharacterEntities (VAR Str : STRING);
326   - PROCEDURE ReplaceParameterEntities (VAR Str : STRING);
327   - PROCEDURE ReplaceGeneralEntities (VAR Str : STRING);
328   -
329   - FUNCTION GetDocBuffer : PChar; // Returns FBuffer or a pointer to a NUL char if Buffer is empty
330   -
331   - PUBLIC // --- Document Properties
332   - PROPERTY XmlVersion : STRING READ FXmlVersion; // XML version from the Document Prolog
333   - PROPERTY Encoding : STRING READ FEncoding; // Document Encoding from Prolog
334   - PROPERTY Standalone : BOOLEAN READ FStandalone; // Standalone Declaration from Prolog
335   - PROPERTY RootName : STRING READ FRootName; // Name of the Root Element
336   - PROPERTY Normalize : BOOLEAN READ FNormalize WRITE FNormalize; // True if Content is to be normalized
337   - PROPERTY Source : STRING READ FSource; // Name of Document Source (Filename)
338   - PROPERTY DocBuffer : PChar READ GetDocBuffer; // Returns document buffer
339   - PUBLIC // --- DTD Objects
340   - Elements : TElemList; // Elements: List of TElemDef (contains Attribute Definitions)
341   - Entities : TNvpList; // General Entities: List of TEntityDef
342   - ParEntities : TNvpList; // Parameter Entities: List of TEntityDef
343   - Notations : TNvpList; // Notations: List of TNotationDef
344   - PUBLIC
345   - CONSTRUCTOR Create;
346   - DESTRUCTOR Destroy; OVERRIDE;
347   -
348   - // --- Document Handling
349   - FUNCTION LoadFromFile (Filename : STRING;
350   - FileMode : INTEGER = fmOpenRead OR fmShareDenyNone) : BOOLEAN;
351   - // Loads Document from given file
352   - FUNCTION LoadFromBuffer (Buffer : PChar) : BOOLEAN; // Loads Document from another buffer
353   - PROCEDURE SetBuffer (Buffer : PChar); // References another buffer
354   - PROCEDURE Clear; // Clear Document
355   -
356   - PUBLIC
357   - // --- Scanning through the document
358   - CurPartType : TPartType; // Current Type
359   - CurName : STRING; // Current Name
360   - CurContent : STRING; // Current Normalized Content
361   - CurStart : PChar; // Current First character
362   - CurFinal : PChar; // Current Last character
363   - CurAttr : TAttrList; // Current Attribute List
364   - PROPERTY CurEncoding : STRING READ FCurEncoding; // Current Encoding
365   - PROCEDURE StartScan;
366   - FUNCTION Scan : BOOLEAN;
367   -
368   - // --- Events / Callbacks
369   - FUNCTION LoadExternalEntity (SystemId, PublicId,
370   - Notation : STRING) : TXmlParser; VIRTUAL;
371   - FUNCTION TranslateEncoding (CONST Source : STRING) : STRING; VIRTUAL;
372   - PROCEDURE DtdElementFound (DtdElementRec : TDtdElementRec); VIRTUAL;
373   - END;
374   -
375   - TValueType = // --- Attribute Value Type
376   - (vtNormal, // Normal specified Attribute
377   - vtImplied, // #IMPLIED attribute value
378   - vtFixed, // #FIXED attribute value
379   - vtDefault); // Attribute value from default value in !ATTLIST declaration
380   -
381   - TAttrDefault = // --- Attribute Default Type
382   - (adDefault, // Normal default value
383   - adRequired, // #REQUIRED attribute
384   - adImplied, // #IMPLIED attribute
385   - adFixed); // #FIXED attribute
386   -
387   - TAttrType = // --- Type of attribute
388   - (atUnknown, // Unknown type
389   - atCData, // Character data only
390   - atID, // ID
391   - atIdRef, // ID Reference
392   - atIdRefs, // Several ID References, separated by Whitespace
393   - atEntity, // Name of an unparsed Entity
394   - atEntities, // Several unparsed Entity names, separated by Whitespace
395   - atNmToken, // Name Token
396   - atNmTokens, // Several Name Tokens, separated by Whitespace
397   - atNotation, // A selection of Notation names (Unparsed Entity)
398   - atEnumeration); // Enumeration
399   -
400   - TElemType = // --- Element content type
401   - (etEmpty, // Element is always empty
402   - etAny, // Element can have any mixture of PCDATA and any elements
403   - etChildren, // Element must contain only elements
404   - etMixed); // Mixed PCDATA and elements
405   -
406   - (*$IFDEF HAS_CONTNRS_UNIT *)
407   - TObjectList = Contnrs.TObjectList; // Re-Export this identifier
408   - (*$ELSE *)
409   - TObjectList = CLASS (TList)
410   - DESTRUCTOR Destroy; OVERRIDE;
411   - PROCEDURE Delete (Index : INTEGER);
412   - PROCEDURE Clear; OVERRIDE;
413   - END;
414   - (*$ENDIF *)
415   -
416   - TNvpNode = CLASS // Name-Value Pair Node
417   - Name : STRING;
418   - Value : STRING;
419   - CONSTRUCTOR Create (TheName : STRING = ''; TheValue : STRING = '');
420   - END;
421   -
422   - TNvpList = CLASS (TObjectList) // Name-Value Pair List
423   - PROCEDURE Add (Node : TNvpNode);
424   - FUNCTION Node (Name : STRING) : TNvpNode; OVERLOAD;
425   - FUNCTION Node (Index : INTEGER) : TNvpNode; OVERLOAD;
426   - FUNCTION Value (Name : STRING) : STRING; OVERLOAD;
427   - FUNCTION Value (Index : INTEGER) : STRING; OVERLOAD;
428   - FUNCTION Name (Index : INTEGER) : STRING;
429   - END;
430   -
431   - TAttr = CLASS (TNvpNode) // Attribute of a Start-Tag or Empty-Element-Tag
432   - ValueType : TValueType;
433   - AttrType : TAttrType;
434   - END;
435   -
436   - TAttrList = CLASS (TNvpList) // List of Attributes
437   - PROCEDURE Analyze (Start : PChar; VAR Final : PChar);
438   - END;
439   -
440   - TEntityStack = CLASS (TObjectList) // Stack where current position is stored before parsing entities
441   - PROTECTED
442   - Owner : TXmlParser;
443   - PUBLIC
444   - CONSTRUCTOR Create (TheOwner : TXmlParser);
445   - PROCEDURE Push (LastPos : PChar); OVERLOAD;
446   - PROCEDURE Push (Instance : TObject; LastPos : PChar); OVERLOAD;
447   - FUNCTION Pop : PChar; // Returns next char or NIL if EOF is reached. Frees Instance.
448   - END;
449   -
450   - TAttrDef = CLASS (TNvpNode) // Represents a <!ATTLIST Definition. "Value" is the default value
451   - TypeDef : STRING; // Type definition from the DTD
452   - Notations : STRING; // Notation List, separated by pipe symbols '|'
453   - AttrType : TAttrType; // Attribute Type
454   - DefaultType : TAttrDefault; // Default Type
455   - END;
456   -
457   - TElemDef = CLASS (TNvpList) // Represents a <!ELEMENT Definition. Is a list of TAttrDef-Nodes
458   - Name : STRING; // Element name
459   - ElemType : TElemType; // Element type
460   - Definition : STRING; // Element definition from DTD
461   - END;
462   -
463   - TElemList = CLASS (TObjectList) // List of TElemDef nodes
464   - FUNCTION Node (Name : STRING) : TElemDef;
465   - PROCEDURE Add (Node : TElemDef);
466   - END;
467   -
468   - TEntityDef = CLASS (TNvpNode) // Represents a <!ENTITY Definition.
469   - SystemId : STRING;
470   - PublicId : STRING;
471   - NotationName : STRING;
472   - END;
473   -
474   - TNotationDef = CLASS (TNvpNode) // Represents a <!NOTATION Definition. Value is the System ID
475   - PublicId : STRING;
476   - END;
477   -
478   - TCharset = SET OF CHAR;
479   -
480   -
481   -CONST
482   - CWhitespace = [#32, #9, #13, #10]; // Whitespace characters (XmlSpec 2.3)
483   - CLetter = [#$41..#$5A, #$61..#$7A, #$C0..#$D6, #$D8..#$F6, #$F8..#$FF];
484   - CDigit = [#$30..#$39];
485   - CNameChar = CLetter + CDigit + ['.', '-', '_', ':', #$B7];
486   - CNameStart = CLetter + ['_', ':'];
487   - CQuoteChar = ['"', ''''];
488   - CPubidChar = [#32, ^M, ^J, #9, 'a'..'z', 'A'..'Z', '0'..'9',
489   - '-', '''', '(', ')', '+', ',', '.', '/', ':',
490   - '=', '?', ';', '!', '*', '#', '@', '$', '_', '%'];
491   -
492   - CDStart = '<![CDATA[';
493   - CDEnd = ']]>';
494   -
495   - // --- Name Constants for the above enumeration types
496   - CPartType_Name : ARRAY [TPartType] OF STRING =
497   - ('', 'XML Prolog', 'Comment', 'PI',
498   - 'DTD Declaration', 'Start Tag', 'Empty Tag', 'End Tag',
499   - 'Text', 'CDATA');
500   - CValueType_Name : ARRAY [TValueType] OF STRING = ('Normal', 'Implied', 'Fixed', 'Default');
501   - CAttrDefault_Name : ARRAY [TAttrDefault] OF STRING = ('Default', 'Required', 'Implied', 'Fixed');
502   - CElemType_Name : ARRAY [TElemType] OF STRING = ('Empty', 'Any', 'Childs only', 'Mixed');
503   - CAttrType_Name : ARRAY [TAttrType] OF STRING = ('Unknown', 'CDATA',
504   - 'ID', 'IDREF', 'IDREFS',
505   - 'ENTITY', 'ENTITIES',
506   - 'NMTOKEN', 'NMTOKENS',
507   - 'Notation', 'Enumeration');
508   -
509   -FUNCTION ConvertWs (Source: STRING; PackWs: BOOLEAN) : STRING; // Convert WS to spaces #x20
510   -PROCEDURE SetStringSF (VAR S : STRING; BufferStart, BufferFinal : PChar); // SetString by Start/Final of buffer
511   -FUNCTION StrSFPas (Start, Finish : PChar) : STRING; // Convert buffer part to Pascal string
512   -FUNCTION TrimWs (Source : STRING) : STRING; // Trim Whitespace
513   -
514   -FUNCTION AnsiToUtf8 (Source : ANSISTRING) : STRING; // Convert Win-1252 to UTF-8
515   -FUNCTION Utf8ToAnsi (Source : STRING; UnknownChar : CHAR = '¿') : ANSISTRING; // Convert UTF-8 to Win-1252
516   -
517   -
518   -(*
519   -===============================================================================================
520   -TCustomXmlScanner event based component wrapper for TXmlParser
521   -===============================================================================================
522   -*)
523   -
524   -TYPE
525   - TCustomXmlScanner = CLASS;
526   - TXmlPrologEvent = PROCEDURE (Sender : TObject; XmlVersion, Encoding: STRING; Standalone : BOOLEAN) OF OBJECT;
527   - TCommentEvent = PROCEDURE (Sender : TObject; Comment : STRING) OF OBJECT;
528   - TPIEvent = PROCEDURE (Sender : TObject; Target, Content: STRING; Attributes : TAttrList) OF OBJECT;
529   - TDtdEvent = PROCEDURE (Sender : TObject; RootElementName : STRING) OF OBJECT;
530   - TStartTagEvent = PROCEDURE (Sender : TObject; TagName : STRING; Attributes : TAttrList) OF OBJECT;
531   - TEndTagEvent = PROCEDURE (Sender : TObject; TagName : STRING) OF OBJECT;
532   - TContentEvent = PROCEDURE (Sender : TObject; Content : STRING) OF OBJECT;
533   - TElementEvent = PROCEDURE (Sender : TObject; ElemDef : TElemDef) OF OBJECT;
534   - TEntityEvent = PROCEDURE (Sender : TObject; EntityDef : TEntityDef) OF OBJECT;
535   - TNotationEvent = PROCEDURE (Sender : TObject; NotationDef : TNotationDef) OF OBJECT;
536   - TErrorEvent = PROCEDURE (Sender : TObject; ErrorPos : PChar) OF OBJECT;
537   - TExternalEvent = PROCEDURE (Sender : TObject; SystemId, PublicId, NotationId : STRING;
538   - VAR Result : TXmlParser) OF OBJECT;
539   - TEncodingEvent = FUNCTION (Sender : TObject; CurrentEncoding, Source : STRING) : STRING OF OBJECT;
540   -
541   -
542   - TCustomXmlScanner = CLASS (TComponent)
543   - PROTECTED
544   - FXmlParser : TXmlParser;
545   - FOnXmlProlog : TXmlPrologEvent;
546   - FOnComment : TCommentEvent;
547   - FOnPI : TPIEvent;
548   - FOnDtdRead : TDtdEvent;
549   - FOnStartTag : TStartTagEvent;
550   - FOnEmptyTag : TStartTagEvent;
551   - FOnEndTag : TEndTagEvent;
552   - FOnContent : TContentEvent;
553   - FOnCData : TContentEvent;
554   - FOnElement : TElementEvent;
555   - FOnAttList : TElementEvent;
556   - FOnEntity : TEntityEvent;
557   - FOnNotation : TNotationEvent;
558   - FOnDtdError : TErrorEvent;
559   - FOnLoadExternal : TExternalEvent;
560   - FOnTranslateEncoding : TEncodingEvent;
561   - FStopParser : BOOLEAN;
562   - FUNCTION GetNormalize : BOOLEAN;
563   - PROCEDURE SetNormalize (Value : BOOLEAN);
564   -
565   - PROCEDURE WhenXmlProlog(XmlVersion, Encoding: STRING; Standalone : BOOLEAN); VIRTUAL;
566   - PROCEDURE WhenComment (Comment : STRING); VIRTUAL;
567   - PROCEDURE WhenPI (Target, Content: STRING; Attributes : TAttrList); VIRTUAL;
568   - PROCEDURE WhenDtdRead (RootElementName : STRING); VIRTUAL;
569   - PROCEDURE WhenStartTag (TagName : STRING; Attributes : TAttrList); VIRTUAL;
570   - PROCEDURE WhenEmptyTag (TagName : STRING; Attributes : TAttrList); VIRTUAL;
571   - PROCEDURE WhenEndTag (TagName : STRING); VIRTUAL;
572   - PROCEDURE WhenContent (Content : STRING); VIRTUAL;
573   - PROCEDURE WhenCData (Content : STRING); VIRTUAL;
574   - PROCEDURE WhenElement (ElemDef : TElemDef); VIRTUAL;
575   - PROCEDURE WhenAttList (ElemDef : TElemDef); VIRTUAL;
576   - PROCEDURE WhenEntity (EntityDef : TEntityDef); VIRTUAL;
577   - PROCEDURE WhenNotation (NotationDef : TNotationDef); VIRTUAL;
578   - PROCEDURE WhenDtdError (ErrorPos : PChar); VIRTUAL;
579   -
580   - PUBLIC
581   - CONSTRUCTOR Create (AOwner: TComponent); OVERRIDE;
582   - DESTRUCTOR Destroy; OVERRIDE;
583   -
584   - PROCEDURE LoadFromFile (Filename : TFilename); // Load XML Document from file
585   - PROCEDURE LoadFromBuffer (Buffer : PChar); // Load XML Document from buffer
586   - PROCEDURE SetBuffer (Buffer : PChar); // Refer to Buffer
587   - FUNCTION GetFilename : TFilename;
588   -
589   - PROCEDURE Execute; // Perform scanning
590   -
591   - PROTECTED
592   - PROPERTY XmlParser : TXmlParser READ FXmlParser;
593   - PROPERTY StopParser : BOOLEAN READ FStopParser WRITE FStopParser;
594   - PROPERTY Filename : TFilename READ GetFilename WRITE LoadFromFile;
595   - PROPERTY Normalize : BOOLEAN READ GetNormalize WRITE SetNormalize;
596   - PROPERTY OnXmlProlog : TXmlPrologEvent READ FOnXmlProlog WRITE FOnXmlProlog;
597   - PROPERTY OnComment : TCommentEvent READ FOnComment WRITE FOnComment;
598   - PROPERTY OnPI : TPIEvent READ FOnPI WRITE FOnPI;
599   - PROPERTY OnDtdRead : TDtdEvent READ FOnDtdRead WRITE FOnDtdRead;
600   - PROPERTY OnStartTag : TStartTagEvent READ FOnStartTag WRITE FOnStartTag;
601   - PROPERTY OnEmptyTag : TStartTagEvent READ FOnEmptyTag WRITE FOnEmptyTag;
602   - PROPERTY OnEndTag : TEndTagEvent READ FOnEndTag WRITE FOnEndTag;
603   - PROPERTY OnContent : TContentEvent READ FOnContent WRITE FOnContent;
604   - PROPERTY OnCData : TContentEvent READ FOnCData WRITE FOnCData;
605   - PROPERTY OnElement : TElementEvent READ FOnElement WRITE FOnElement;
606   - PROPERTY OnAttList : TElementEvent READ FOnAttList WRITE FOnAttList;
607   - PROPERTY OnEntity : TEntityEvent READ FOnEntity WRITE FOnEntity;
608   - PROPERTY OnNotation : TNotationEvent READ FOnNotation WRITE FOnNotation;
609   - PROPERTY OnDtdError : TErrorEvent READ FOnDtdError WRITE FOnDtdError;
610   - PROPERTY OnLoadExternal : TExternalEvent READ FOnLoadExternal WRITE FOnLoadExternal;
611   - PROPERTY OnTranslateEncoding : TEncodingEvent READ FOnTranslateEncoding WRITE FOnTranslateEncoding;
612   - END;
613   -
614   -(*
615   -===============================================================================================
616   -IMPLEMENTATION
617   -===============================================================================================
618   -*)
619   -
620   -IMPLEMENTATION
621   -
622   -
623   -(*
624   -===============================================================================================
625   -Unicode and UTF-8 stuff
626   -===============================================================================================
627   -*)
628   -
629   -CONST
630   - // --- Character Translation Table for Unicode <-> Win-1252
631   - WIN1252_UNICODE : ARRAY [$00..$FF] OF WORD = (
632   - $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009,
633   - $000A, $000B, $000C, $000D, $000E, $000F, $0010, $0011, $0012, $0013,
634   - $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D,
635   - $001E, $001F, $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027,
636   - $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F, $0030, $0031,
637   - $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B,
638   - $003C, $003D, $003E, $003F, $0040, $0041, $0042, $0043, $0044, $0045,
639   - $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
640   - $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059,
641   - $005A, $005B, $005C, $005D, $005E, $005F, $0060, $0061, $0062, $0063,
642   - $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D,
643   - $006E, $006F, $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077,
644   - $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
645   -
646   - $20AC, $0081, $201A, $0192, $201E, $2026, $2020, $2021, $02C6, $2030,
647   - $0160, $2039, $0152, $008D, $017D, $008F, $0090, $2018, $2019, $201C,
648   - $201D, $2022, $2013, $2014, $02DC, $2122, $0161, $203A, $0153, $009D,
649   - $017E, $0178, $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7,
650   - $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF, $00B0, $00B1,
651   - $00B2, $00B3, $00B4, $00B5, $00B6, $00B7, $00B8, $00B9, $00BA, $00BB,
652   - $00BC, $00BD, $00BE, $00BF, $00C0, $00C1, $00C2, $00C3, $00C4, $00C5,
653   - $00C6, $00C7, $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
654   - $00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7, $00D8, $00D9,
655   - $00DA, $00DB, $00DC, $00DD, $00DE, $00DF, $00E0, $00E1, $00E2, $00E3,
656   - $00E4, $00E5, $00E6, $00E7, $00E8, $00E9, $00EA, $00EB, $00EC, $00ED,
657   - $00EE, $00EF, $00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7,
658   - $00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF);
659   -
660   -(* UTF-8 (somewhat simplified)
661   - -----
662   - Character Range Byte sequence
663   - --------------- -------------------------- (x=Bits from original character)
664   - $0000..$007F 0xxxxxxx
665   - $0080..$07FF 110xxxxx 10xxxxxx
666   - $8000..$FFFF 1110xxxx 10xxxxxx 10xxxxxx
667   -
668   - Example
669   - --------
670   - Transforming the Unicode character U+00E4 LATIN SMALL LETTER A WITH DIAERESIS ("ä"):
671   -
672   - ISO-8859-1, Decimal 228
673   - Win1252, Hex $E4
674   - ANSI Bin 1110 0100
675   - abcd efgh
676   -
677   - UTF-8 Binary 1100xxab 10cdefgh
678   - Binary 11000011 10100100
679   - Hex $C3 $A4
680   - Decimal 195 164
681   - ANSI Ã ¤ *)
682   -
683   -
684   -FUNCTION AnsiToUtf8 (Source : ANSISTRING) : STRING;
685   - (* Converts the given Windows ANSI (Win1252) String to UTF-8. *)
686   -VAR
687   - I : INTEGER; // Loop counter
688   - U : WORD; // Current Unicode value
689   - Len : INTEGER; // Current real length of "Result" string
690   -BEGIN
691   - SetLength (Result, Length (Source) * 3); // Worst case
692   - Len := 0;
693   - FOR I := 1 TO Length (Source) DO BEGIN
694   - U := WIN1252_UNICODE [ORD (Source [I])];
695   - CASE U OF
696   - $0000..$007F : BEGIN
697   - INC (Len);
698   - Result [Len] := CHR (U);
699   - END;
700   - $0080..$07FF : BEGIN
701   - INC (Len);
702   - Result [Len] := CHR ($C0 OR (U SHR 6));
703   - INC (Len);
704   - Result [Len] := CHR ($80 OR (U AND $3F));
705   - END;
706   - $0800..$FFFF : BEGIN
707   - INC (Len);
708   - Result [Len] := CHR ($E0 OR (U SHR 12));
709   - INC (Len);
710   - Result [Len] := CHR ($80 OR ((U SHR 6) AND $3F));
711   - INC (Len);
712   - Result [Len] := CHR ($80 OR (U AND $3F));
713   - END;
714   - END;
715   - END;
716   - SetLength (Result, Len);
717   -END;
718   -
719   -
720   -FUNCTION Utf8ToAnsi (Source : STRING; UnknownChar : CHAR = '¿') : ANSISTRING;
721   - (* Converts the given UTF-8 String to Windows ANSI (Win-1252).
722   - If a character can not be converted, the "UnknownChar" is inserted. *)
723   -VAR
724   - SourceLen : INTEGER; // Length of Source string
725   - I, K : INTEGER;
726   - A : BYTE; // Current ANSI character value
727   - U : WORD;
728   - Ch : CHAR; // Dest char
729   - Len : INTEGER; // Current real length of "Result" string
730   -BEGIN
731   - SourceLen := Length (Source);
732   - SetLength (Result, SourceLen); // Enough room to live
733   - Len := 0;
734   - I := 1;
735   - WHILE I <= SourceLen DO BEGIN
736   - A := ORD (Source [I]);
737   - IF A < $80 THEN BEGIN // Range $0000..$007F
738   - INC (Len);
739   - Result [Len] := Source [I];
740   - INC (I);
741   - END
742   - ELSE BEGIN // Determine U, Inc I
743   - IF (A AND $E0 = $C0) AND (I < SourceLen) THEN BEGIN // Range $0080..$07FF
744   - U := (WORD (A AND $1F) SHL 6) OR (ORD (Source [I+1]) AND $3F);
745   - INC (I, 2);
746   - END
747   - ELSE IF (A AND $F0 = $E0) AND (I < SourceLen-1) THEN BEGIN // Range $0800..$FFFF
748   - U := (WORD (A AND $0F) SHL 12) OR
749   - (WORD (ORD (Source [I+1]) AND $3F) SHL 6) OR
750   - ( ORD (Source [I+2]) AND $3F);
751   - INC (I, 3);
752   - END
753   - ELSE BEGIN // Unknown/unsupported
754   - INC (I);
755   - FOR K := 7 DOWNTO 0 DO
756   - IF A AND (1 SHL K) = 0 THEN BEGIN
757   - INC (I, (A SHR (K+1))-1);
758   - BREAK;
759   - END;
760   - U := WIN1252_UNICODE [ORD (UnknownChar)];
761   - END;
762   - Ch := UnknownChar; // Retrieve ANSI char
763   - FOR A := $00 TO $FF DO
764   - IF WIN1252_UNICODE [A] = U THEN BEGIN
765   - Ch := CHR (A);
766   - BREAK;
767   - END;
768   - INC (Len);
769   - Result [Len] := Ch;
770   - END;
771   - END;
772   - SetLength (Result, Len);
773   -END;
774   -
775   -
776   -(*
777   -===============================================================================================
778   -"Special" Helper Functions
779   -
780   -Don't ask me why. But including these functions makes the parser *DRAMATICALLY* faster
781   -on my K6-233 machine. You can test it yourself just by commenting them out.
782   -They do exactly the same as the Assembler routines defined in SysUtils.
783   -(This is where you can see how great the Delphi compiler really is. The compiled code is
784   -faster than hand-coded assembler!)
785   -===============================================================================================
786   ---> Just move this line below the StrScan function --> *)
787   -
788   -
789   -FUNCTION StrPos (CONST Str, SearchStr : PChar) : PChar;
790   - // Same functionality as SysUtils.StrPos
791   -VAR
792   - First : CHAR;
793   - Len : INTEGER;
794   -BEGIN
795   - First := SearchStr^;
796   - Len := StrLen (SearchStr);
797   - Result := Str;
798   - REPEAT
799   - IF Result^ = First THEN
800   - IF StrLComp (Result, SearchStr, Len) = 0 THEN BREAK;
801   - IF Result^ = #0 THEN BEGIN
802   - Result := NIL;
803   - BREAK;
804   - END;
805   - INC (Result);
806   - UNTIL FALSE;
807   -END;
808   -
809   -
810   -FUNCTION StrScan (CONST Start : PChar; CONST Ch : CHAR) : PChar;
811   - // Same functionality as SysUtils.StrScan
812   -BEGIN
813   - Result := Start;
814   - WHILE Result^ <> Ch DO BEGIN
815   - IF Result^ = #0 THEN BEGIN
816   - Result := NIL;
817   - EXIT;
818   - END;
819   - INC (Result);
820   - END;
821   -END;
822   -
823   -
824   -(*
825   -===============================================================================================
826   -Helper Functions
827   -===============================================================================================
828   -*)
829   -
830   -FUNCTION DelChars (Source : STRING; CharsToDelete : TCharset) : STRING;
831   - // Delete all "CharsToDelete" from the string
832   -VAR
833   - I : INTEGER;
834   -BEGIN
835   - Result := Source;
836   - FOR I := Length (Result) DOWNTO 1 DO
837   - IF Result [I] IN CharsToDelete THEN
838   - Delete (Result, I, 1);
839   -END;
840   -
841   -
842   -FUNCTION TrimWs (Source : STRING) : STRING;
843   - // Trimms off Whitespace characters from both ends of the string
844   -VAR
845   - I : INTEGER;
846   -BEGIN
847   - // --- Trim Left
848   - I := 1;
849   - WHILE (I <= Length (Source)) AND (Source [I] IN CWhitespace) DO
850   - INC (I);
851   - Result := Copy (Source, I, MaxInt);
852   -
853   - // --- Trim Right
854   - I := Length (Result);
855   - WHILE (I > 1) AND (Result [I] IN CWhitespace) DO
856   - DEC (I);
857   - Delete (Result, I+1, Length (Result)-I);
858   -END;
859   -
860   -
861   -FUNCTION ConvertWs (Source: STRING; PackWs: BOOLEAN) : STRING;
862   - // Converts all Whitespace characters to the Space #x20 character
863   - // If "PackWs" is true, contiguous Whitespace characters are packed to one
864   -VAR
865   - I : INTEGER;
866   -BEGIN
867   - Result := Source;
868   - FOR I := Length (Result) DOWNTO 1 DO
869   - IF (Result [I] IN CWhitespace) THEN
870   - IF PackWs AND (I > 1) AND (Result [I-1] IN CWhitespace)
871   - THEN Delete (Result, I, 1)
872   - ELSE Result [I] := #32;
873   -END;
874   -
875   -
876   -PROCEDURE SetStringSF (VAR S : STRING; BufferStart, BufferFinal : PChar);
877   -BEGIN
878   - SetString (S, BufferStart, BufferFinal-BufferStart+1);
879   -END;
880   -
881   -
882   -FUNCTION StrLPas (Start : PChar; Len : INTEGER) : STRING;
883   -BEGIN
884   - SetString (Result, Start, Len);
885   -END;
886   -
887   -
888   -FUNCTION StrSFPas (Start, Finish : PChar) : STRING;
889   -BEGIN
890   - SetString (Result, Start, Finish-Start+1);
891   -END;
892   -
893   -
894   -FUNCTION StrScanE (CONST Source : PChar; CONST CharToScanFor : CHAR) : PChar;
895   - // If "CharToScanFor" is not found, StrScanE returns the last char of the
896   - // buffer instead of NIL
897   -BEGIN
898   - Result := StrScan (Source, CharToScanFor);
899   - IF Result = NIL THEN
900   - Result := StrEnd (Source)-1;
901   -END;
902   -
903   -
904   -PROCEDURE ExtractName (Start : PChar; Terminators : TCharset; VAR Final : PChar);
905   - (* Extracts the complete Name beginning at "Start".
906   - It is assumed that the name is contained in Markup, so the '>' character is
907   - always a Termination.
908   - Start: IN Pointer to first char of name. Is always considered to be valid
909   - Terminators: IN Characters which terminate the name
910   - Final: OUT Pointer to last char of name *)
911   -BEGIN
912   - Final := Start+1;
913   - Include (Terminators, #0);
914   - Include (Terminators, '>');
915   - WHILE NOT (Final^ IN Terminators) DO
916   - INC (Final);
917   - DEC (Final);
918   -END;
919   -
920   -
921   -PROCEDURE ExtractQuote (Start : PChar; VAR Content : STRING; VAR Final : PChar);
922   - (* Extract a string which is contained in single or double Quotes.
923   - Start: IN Pointer to opening quote
924   - Content: OUT The quoted string
925   - Final: OUT Pointer to closing quote *)
926   -BEGIN
927   - Final := StrScan (Start+1, Start^);
928   - IF Final = NIL THEN BEGIN
929   - Final := StrEnd (Start+1)-1;
930   - SetString (Content, Start+1, Final-Start);
931   - END
932   - ELSE
933   - SetString (Content, Start+1, Final-1-Start);
934   -END;
935   -
936   -
937   -(*
938   -===============================================================================================
939   -TEntityStackNode
940   -This Node is pushed to the "Entity Stack" whenever the parser parses entity replacement text.
941   -The "Instance" field holds the Instance pointer of an External Entity buffer. When it is
942   -popped, the Instance is freed.
943   -The "Encoding" field holds the name of the Encoding. External Parsed Entities may have
944   -another encoding as the document entity (XmlSpec 4.3.3). So when there is an "<?xml" PI
945   -found in the stream (= Text Declaration at the beginning of external parsed entities), the
946   -Encoding found there is used for the External Entity (is assigned to TXmlParser.CurEncoding)
947   -Default Encoding is for the Document Entity is UTF-8. It is assumed that External Entities
948   -have the same Encoding as the Document Entity, unless they carry a Text Declaration.
949   -===============================================================================================
950   -*)
951   -
952   -TYPE
953   - TEntityStackNode = CLASS
954   - Instance : TObject;
955   - Encoding : STRING;
956   - LastPos : PChar;
957   - END;
958   -
959   -(*
960   -===============================================================================================
961   -TEntityStack
962   -For nesting of Entities.
963   -When there is an entity reference found in the data stream, the corresponding entity
964   -definition is searched and the current position is pushed to this stack.
965   -From then on, the program scans the entitiy replacement text as if it were normal content.
966   -When the parser reaches the end of an entity, the current position is popped off the
967   -stack again.
968   -===============================================================================================
969   -*)
970   -
971   -CONSTRUCTOR TEntityStack.Create (TheOwner : TXmlParser);
972   -BEGIN
973   - INHERITED Create;
974   - Owner := TheOwner;
975   -END;
976   -
977   -
978   -PROCEDURE TEntityStack.Push (LastPos : PChar);
979   -BEGIN
980   - Push (NIL, LastPos);
981   -END;
982   -
983   -
984   -PROCEDURE TEntityStack.Push (Instance : TObject; LastPos : PChar);
985   -VAR
986   - ESN : TEntityStackNode;
987   -BEGIN
988   - ESN := TEntityStackNode.Create;
989   - ESN.Instance := Instance;
990   - ESN.Encoding := Owner.FCurEncoding; // Save current Encoding
991   - ESN.LastPos := LastPos;
992   - Add (ESN);
993   -END;
994   -
995   -
996   -FUNCTION TEntityStack.Pop : PChar;
997   -VAR
998   - ESN : TEntityStackNode;
999   -BEGIN
1000   - IF Count > 0 THEN BEGIN
1001   - ESN := TEntityStackNode (Items [Count-1]);
1002   - Result := ESN.LastPos;
1003   - IF ESN.Instance <> NIL THEN
1004   - ESN.Instance.Free;
1005   - IF ESN.Encoding <> '' THEN
1006   - Owner.FCurEncoding := ESN.Encoding; // Restore current Encoding
1007   - Delete (Count-1);
1008   - END
1009   - ELSE
1010   - Result := NIL;
1011   -END;
1012   -
1013   -
1014   -(*
1015   -===============================================================================================
1016   -TExternalID
1017   ------------
1018   -XmlSpec 4.2.2: ExternalID ::= 'SYSTEM' S SystemLiteral |
1019   - 'PUBLIC' S PubidLiteral S SystemLiteral
1020   -XmlSpec 4.7: PublicID ::= 'PUBLIC' S PubidLiteral
1021   -SystemLiteral and PubidLiteral are quoted
1022   -===============================================================================================
1023   -*)
1024   -
1025   -TYPE
1026   - TExternalID = CLASS
1027   - PublicId : STRING;
1028   - SystemId : STRING;
1029   - Final : PChar;
1030   - CONSTRUCTOR Create (Start : PChar);
1031   - END;
1032   -
1033   -CONSTRUCTOR TExternalID.Create (Start : PChar);
1034   -BEGIN
1035   - INHERITED Create;
1036   - Final := Start;
1037   - IF StrLComp (Start, 'SYSTEM', 6) = 0 THEN BEGIN
1038   - WHILE NOT (Final^ IN (CQuoteChar + [#0, '>', '['])) DO INC (Final);
1039   - IF NOT (Final^ IN CQuoteChar) THEN EXIT;
1040   - ExtractQuote (Final, SystemID, Final);
1041   - END
1042   - ELSE IF StrLComp (Start, 'PUBLIC', 6) = 0 THEN BEGIN
1043   - WHILE NOT (Final^ IN (CQuoteChar + [#0, '>', '['])) DO INC (Final);
1044   - IF NOT (Final^ IN CQuoteChar) THEN EXIT;
1045   - ExtractQuote (Final, PublicID, Final);
1046   - INC (Final);
1047   - WHILE NOT (Final^ IN (CQuoteChar + [#0, '>', '['])) DO INC (Final);
1048   - IF NOT (Final^ IN CQuoteChar) THEN EXIT;
1049   - ExtractQuote (Final, SystemID, Final);
1050   - END;
1051   -END;
1052   -
1053   -
1054   -(*
1055   -===============================================================================================
1056   -TXmlParser
1057   -===============================================================================================
1058   -*)
1059   -
1060   -CONSTRUCTOR TXmlParser.Create;
1061   -BEGIN
1062   - INHERITED Create;
1063   - FBuffer := NIL;
1064   - FBufferSize := 0;
1065   - Elements := TElemList.Create;
1066   - Entities := TNvpList.Create;
1067   - ParEntities := TNvpList.Create;
1068   - Notations := TNvpList.Create;
1069   - CurAttr := TAttrList.Create;
1070   - EntityStack := TEntityStack.Create (Self);
1071   - Clear;
1072   -END;
1073   -
1074   -
1075   -DESTRUCTOR TXmlParser.Destroy;
1076   -BEGIN
1077   - Clear;
1078   - Elements.Free;
1079   - Entities.Free;
1080   - ParEntities.Free;
1081   - Notations.Free;
1082   - CurAttr.Free;
1083   - EntityStack.Free;
1084   - INHERITED Destroy;
1085   -END;
1086   -
1087   -
1088   -PROCEDURE TXmlParser.Clear;
1089   - // Free Buffer and clear all object attributes
1090   -BEGIN
1091   - IF (FBufferSize > 0) AND (FBuffer <> NIL) THEN
1092   - FreeMem (FBuffer);
1093   - FBuffer := NIL;
1094   - FBufferSize := 0;
1095   - FSource := '';
1096   - FXmlVersion := '';
1097   - FEncoding := '';
1098   - FStandalone := FALSE;
1099   - FRootName := '';
1100   - FDtdcFinal := NIL;
1101   - FNormalize := TRUE;
1102   - Elements.Clear;
1103   - Entities.Clear;
1104   - ParEntities.Clear;
1105   - Notations.Clear;
1106   - CurAttr.Clear;
1107   - EntityStack.Clear;
1108   -END;
1109   -
1110   -
1111   -FUNCTION TXmlParser.LoadFromFile (Filename : STRING; FileMode : INTEGER = fmOpenRead OR fmShareDenyNone) : BOOLEAN;
1112   - // Loads Document from given file
1113   - // Returns TRUE if successful
1114   -VAR
1115   - f : FILE;
1116   - ReadIn : INTEGER;
1117   - OldFileMode : INTEGER;
1118   -BEGIN
1119   - Result := FALSE;
1120   - Clear;
1121   -
1122   - // --- Open File
1123   - OldFileMode := SYSTEM.FileMode;
1124   - TRY
1125   - SYSTEM.FileMode := FileMode;
1126   - TRY
1127   - AssignFile (f, Filename);
1128   - Reset (f, 1);
1129   - EXCEPT
1130   - EXIT;
1131   - END;
1132   -
1133   - TRY
1134   - // --- Allocate Memory
1135   - TRY
1136   - FBufferSize := Filesize (f) + 1;
1137   - GetMem (FBuffer, FBufferSize);
1138   - EXCEPT
1139   - Clear;
1140   - EXIT;
1141   - END;
1142   -
1143   - // --- Read File
1144   - TRY
1145   - BlockRead (f, FBuffer^, FBufferSize, ReadIn);
1146   - (FBuffer+ReadIn)^ := #0; // NULL termination
1147   - EXCEPT
1148   - Clear;
1149   - EXIT;
1150   - END;
1151   - FINALLY
1152   - CloseFile (f);
1153   - END;
1154   -
1155   - FSource := Filename;
1156   - Result := TRUE;
1157   -
1158   - FINALLY
1159   - SYSTEM.FileMode := OldFileMode;
1160   - END;
1161   -END;
1162   -
1163   -
1164   -FUNCTION TXmlParser.LoadFromBuffer (Buffer : PChar) : BOOLEAN;
1165   - // Loads Document from another buffer
1166   - // Returns TRUE if successful
1167   - // The "Source" property becomes '<MEM>' if successful
1168   -BEGIN
1169   - Result := FALSE;
1170   - Clear;
1171   - FBufferSize := StrLen (Buffer) + 1;
1172   - TRY
1173   - GetMem (FBuffer, FBufferSize);
1174   - EXCEPT
1175   - Clear;
1176   - EXIT;
1177   - END;
1178   - StrCopy (FBuffer, Buffer);
1179   - FSource := '<MEM>';
1180   - Result := TRUE;
1181   -END;
1182   -
1183   -
1184   -PROCEDURE TXmlParser.SetBuffer (Buffer : PChar); // References another buffer
1185   -BEGIN
1186   - Clear;
1187   - FBuffer := Buffer;
1188   - FBufferSize := 0;
1189   - FSource := '<REFERENCE>';
1190   -END;
1191   -
1192   -
1193   -//-----------------------------------------------------------------------------------------------
1194   -// Scanning through the document
1195   -//-----------------------------------------------------------------------------------------------
1196   -
1197   -PROCEDURE TXmlParser.StartScan;
1198   -BEGIN
1199   - CurPartType := ptNone;
1200   - CurName := '';
1201   - CurContent := '';
1202   - CurStart := NIL;
1203   - CurFinal := NIL;
1204   - CurAttr.Clear;
1205   - EntityStack.Clear;
1206   -END;
1207   -
1208   -
1209   -FUNCTION TXmlParser.Scan : BOOLEAN;
1210   - // Scans the next Part
1211   - // Returns TRUE if a part could be found, FALSE if there is no part any more
1212   - //
1213   - // "IsDone" can be set to FALSE by AnalyzeText in order to go to the next part
1214   - // if there is no Content due to normalization
1215   -VAR
1216   - IsDone : BOOLEAN;
1217   -BEGIN
1218   - REPEAT
1219   - IsDone := TRUE;
1220   -
1221   - // --- Start of next Part
1222   - IF CurStart = NIL
1223   - THEN CurStart := DocBuffer
1224   - ELSE CurStart := CurFinal+1;
1225   - CurFinal := CurStart;
1226   -
1227   - // --- End of Document of Pop off a new part from the Entity stack?
1228   - IF CurStart^ = #0 THEN
1229   - CurStart := EntityStack.Pop;
1230   -
1231   - // --- No Document or End Of Document: Terminate Scan
1232   - IF (CurStart = NIL) OR (CurStart^ = #0) THEN BEGIN
1233   - CurStart := StrEnd (DocBuffer);
1234   - CurFinal := CurStart-1;
1235   - EntityStack.Clear;
1236   - Result := FALSE;
1237   - EXIT;
1238   - END;
1239   -
1240   - IF (StrLComp (CurStart, '<?xml', 5) = 0) AND
1241   - ((CurStart+5)^ IN CWhitespace) THEN AnalyzeProlog // XML Declaration, Text Declaration
1242   - ELSE IF StrLComp (CurStart, '<?', 2) = 0 THEN AnalyzePI (CurStart, CurFinal) // PI
1243   - ELSE IF StrLComp (CurStart, '<!--', 4) = 0 THEN AnalyzeComment (CurStart, CurFinal) // Comment
1244   - ELSE IF StrLComp (CurStart, '<!DOCTYPE', 9) = 0 THEN AnalyzeDtdc // DTDc
1245   - ELSE IF StrLComp (CurStart, CDStart, Length (CDStart)) = 0 THEN AnalyzeCdata // CDATA Section
1246   - ELSE IF StrLComp (CurStart, '<', 1) = 0 THEN AnalyzeTag // Start-Tag, End-Tag, Empty-Element-Tag
1247   - ELSE AnalyzeText (IsDone); // Text Content
1248   - UNTIL IsDone;
1249   - Result := TRUE;
1250   -END;
1251   -
1252   -
1253   -PROCEDURE TXmlParser.AnalyzeProlog;
1254   - // Analyze XML Prolog or Text Declaration
1255   -VAR
1256   - F : PChar;
1257   -BEGIN
1258   - CurAttr.Analyze (CurStart+5, F);
1259   - IF EntityStack.Count = 0 THEN BEGIN
1260   - FXmlVersion := CurAttr.Value ('version');
1261   - FEncoding := CurAttr.Value ('encoding');
1262   - FStandalone := CurAttr.Value ('standalone') = 'yes';
1263   - END;
1264   - CurFinal := StrPos (F, '?>');
1265   - IF CurFinal <> NIL
1266   - THEN INC (CurFinal)
1267   - ELSE CurFinal := StrEnd (CurStart)-1;
1268   - FCurEncoding := AnsiUpperCase (CurAttr.Value ('encoding'));
1269   - IF FCurEncoding = '' THEN
1270   - FCurEncoding := 'UTF-8'; // Default XML Encoding is UTF-8
1271   - CurPartType := ptXmlProlog;
1272   - CurName := '';
1273   - CurContent := '';
1274   -END;
1275   -
1276   -
1277   -PROCEDURE TXmlParser.AnalyzeComment (Start : PChar; VAR Final : PChar);
1278   - // Analyze Comments
1279   -BEGIN
1280   - Final := StrPos (Start+4, '-->');
1281   - IF Final = NIL
1282   - THEN Final := StrEnd (Start)-1
1283   - ELSE INC (Final, 2);
1284   - CurPartType := ptComment;
1285   -END;
1286   -
1287   -
1288   -PROCEDURE TXmlParser.AnalyzePI (Start : PChar; VAR Final : PChar);
1289   - // Analyze Processing Instructions (PI)
1290   - // This is also called for Character
1291   -VAR
1292   - F : PChar;
1293   -BEGIN
1294   - CurPartType := ptPI;
1295   - Final := StrPos (Start+2, '?>');
1296   - IF Final = NIL
1297   - THEN Final := StrEnd (Start)-1
1298   - ELSE INC (Final);
1299   - ExtractName (Start+2, CWhitespace + ['?', '>'], F);
1300   - SetStringSF (CurName, Start+2, F);
1301   - SetStringSF (CurContent, F+1, Final-2);
1302   - CurAttr.Analyze (F+1, F);
1303   -END;
1304   -
1305   -
1306   -PROCEDURE TXmlParser.AnalyzeDtdc;
1307   - (* Analyze Document Type Declaration
1308   - doctypedecl ::= '<!DOCTYPE' S Name (S ExternalID)? S? ('[' (markupdecl | PEReference | S)* ']' S?)? '>'
1309   - markupdecl ::= elementdecl | AttlistDecl | EntityDecl | NotationDecl | PI | Comment
1310   - PEReference ::= '%' Name ';'
1311   -
1312   - elementdecl ::= '<!ELEMENT' S Name S contentspec S? '>'
1313   - AttlistDecl ::= '<!ATTLIST' S Name AttDef* S? '>'
1314   - EntityDecl ::= '<!ENTITY' S Name S EntityDef S? '>' |
1315   - '<!ENTITY' S '%' S Name S PEDef S? '>'
1316   - NotationDecl ::= '<!NOTATION' S Name S (ExternalID | PublicID) S? '>'
1317   - PI ::= '<?' PITarget (S (Char* - (Char* '?>' Char* )))? '?>'
1318   - Comment ::= '<!--' ((Char - '-') | ('-' (Char - '-')))* '-->' *)
1319   -TYPE
1320   - TPhase = (phName, phDtd, phInternal, phFinishing);
1321   -VAR
1322   - Phase : TPhase;
1323   - F : PChar;
1324   - ExternalID : TExternalID;
1325   - ExternalDTD : TXmlParser;
1326   - DER : TDtdElementRec;
1327   -BEGIN
1328   - DER.Start := CurStart;
1329   - EntityStack.Clear; // Clear stack for Parameter Entities
1330   - CurPartType := ptDtdc;
1331   -
1332   - // --- Don't read DTDc twice
1333   - IF FDtdcFinal <> NIL THEN BEGIN
1334   - CurFinal := FDtdcFinal;
1335   - EXIT;
1336   - END;
1337   -
1338   - // --- Scan DTDc
1339   - CurFinal := CurStart + 9; // First char after '<!DOCTYPE'
1340   - Phase := phName;
1341   - REPEAT
1342   - CASE CurFinal^ OF
1343   - '%' : BEGIN
1344   - PushPE (CurFinal);
1345   - CONTINUE;
1346   - END;
1347   - #0 : IF EntityStack.Count = 0 THEN
1348   - BREAK
1349   - ELSE BEGIN
1350   - CurFinal := EntityStack.Pop;
1351   - CONTINUE;
1352   - END;
1353   - '[' : BEGIN
1354   - Phase := phInternal;
1355   - AnalyzeDtdElements (CurFinal+1, CurFinal);
1356   - CONTINUE;
1357   - END;
1358   - ']' : Phase := phFinishing;
1359   - '>' : BREAK;
1360   - ELSE IF NOT (CurFinal^ IN CWhitespace) THEN BEGIN
1361   - CASE Phase OF
1362   - phName : IF (CurFinal^ IN CNameStart) THEN BEGIN
1363   - ExtractName (CurFinal, CWhitespace + ['[', '>'], F);
1364   - SetStringSF (FRootName, CurFinal, F);
1365   - CurFinal := F;
1366   - Phase := phDtd;
1367   - END;
1368   - phDtd : IF (StrLComp (CurFinal, 'SYSTEM', 6) = 0) OR
1369   - (StrLComp (CurFinal, 'PUBLIC', 6) = 0) THEN BEGIN
1370   - ExternalID := TExternalID.Create (CurFinal);
1371   - ExternalDTD := LoadExternalEntity (ExternalId.SystemId, ExternalID.PublicId, '');
1372   - F := StrPos (ExternalDtd.DocBuffer, '<!');
1373   - IF F <> NIL THEN
1374   - AnalyzeDtdElements (F, F);
1375   - ExternalDTD.Free;
1376   - CurFinal := ExternalID.Final;
1377   - ExternalID.Free;
1378   - END;
1379   - ELSE BEGIN
1380   - DER.ElementType := deError;
1381   - DER.Pos := CurFinal;
1382   - DER.Final := CurFinal;
1383   - DtdElementFound (DER);
1384   - END;
1385   - END;
1386   -
1387   - END;
1388   - END;
1389   - INC (CurFinal);
1390   - UNTIL FALSE;
1391   -
1392   - CurPartType := ptDtdc;
1393   - CurName := '';
1394   - CurContent := '';
1395   -
1396   - // It is an error in the document if "EntityStack" is not empty now
1397   - IF EntityStack.Count > 0 THEN BEGIN
1398   - DER.ElementType := deError;
1399   - DER.Final := CurFinal;
1400   - DER.Pos := CurFinal;
1401   - DtdElementFound (DER);
1402   - END;
1403   -
1404   - EntityStack.Clear; // Clear stack for General Entities
1405   - FDtdcFinal := CurFinal;
1406   -END;
1407   -
1408   -
1409   -PROCEDURE TXmlParser.AnalyzeDtdElements (Start : PChar; VAR Final : PChar);
1410   - // Analyze the "Elements" of a DTD contained in the external or
1411   - // internal DTD subset.
1412   -VAR
1413   - DER : TDtdElementRec;
1414   -BEGIN
1415   - Final := Start;
1416   - REPEAT
1417   - CASE Final^ OF
1418   - '%' : BEGIN
1419   - PushPE (Final);
1420   - CONTINUE;
1421   - END;
1422   - #0 : IF EntityStack.Count = 0 THEN
1423   - BREAK
1424   - ELSE BEGIN
1425   - CurFinal := EntityStack.Pop;
1426   - CONTINUE;
1427   - END;
1428   - ']',
1429   - '>' : BREAK;
1430   - '<' : IF StrLComp (Final, '<!ELEMENT', 9) = 0 THEN AnalyzeElementDecl (Final, Final)
1431   - ELSE IF StrLComp (Final, '<!ATTLIST', 9) = 0 THEN AnalyzeAttListDecl (Final, Final)
1432   - ELSE IF StrLComp (Final, '<!ENTITY', 8) = 0 THEN AnalyzeEntityDecl (Final, Final)
1433   - ELSE IF StrLComp (Final, '<!NOTATION', 10) = 0 THEN AnalyzeNotationDecl (Final, Final)
1434   - ELSE IF StrLComp (Final, '<?', 2) = 0 THEN BEGIN // PI in DTD
1435   - DER.ElementType := dePI;
1436   - DER.Start := Final;
1437   - AnalyzePI (Final, Final);
1438   - DER.Target := PChar (CurName);
1439   - DER.Content := PChar (CurContent);
1440   - DER.AttrList := CurAttr;
1441   - DER.Final := Final;
1442   - DtdElementFound (DER);
1443   - END
1444   - ELSE IF StrLComp (Final, '<!--', 4) = 0 THEN BEGIN // Comment in DTD
1445   - DER.ElementType := deComment;
1446   - DER.Start := Final;
1447   - AnalyzeComment (Final, Final);
1448   - DER.Final := Final;
1449   - DtdElementFound (DER);
1450   - END
1451   - ELSE BEGIN
1452   - DER.ElementType := deError;
1453   - DER.Start := Final;
1454   - DER.Pos := Final;
1455   - DER.Final := Final;
1456   - DtdElementFound (DER);
1457   - END;
1458   -
1459   - END;
1460   - INC (Final);
1461   - UNTIL FALSE;
1462   -END;
1463   -
1464   -
1465   -PROCEDURE TXmlParser.AnalyzeTag;
1466   - // Analyze Tags
1467   -VAR
1468   - S, F : PChar;
1469   - Attr : TAttr;
1470   - ElemDef : TElemDef;
1471   - AttrDef : TAttrDef;
1472   - I : INTEGER;
1473   -BEGIN
1474   - CurPartType := ptStartTag;
1475   - S := CurStart+1;
1476   - IF S^ = '/' THEN BEGIN
1477   - CurPartType := ptEndTag;
1478   - INC (S);
1479   - END;
1480   - ExtractName (S, CWhitespace + ['/'], F);
1481   - SetStringSF (CurName, S, F);
1482   - CurAttr.Analyze (F+1, CurFinal);
1483   - IF CurFinal^ = '/' THEN BEGIN
1484   - CurPartType := ptEmptyTag;
1485   - END;
1486   - CurFinal := StrScanE (CurFinal, '>');
1487   -
1488   - // --- Set Default Attribute values for nonexistent attributes
1489   - IF (CurPartType = ptStartTag) OR (CurPartType = ptEmptyTag) THEN BEGIN
1490   - ElemDef := Elements.Node (CurName);
1491   - IF ElemDef <> NIL THEN BEGIN
1492   - FOR I := 0 TO ElemDef.Count-1 DO BEGIN
1493   - AttrDef := TAttrDef (ElemDef [I]);
1494   - Attr := TAttr (CurAttr.Node (AttrDef.Name));
1495   - IF (Attr = NIL) AND (AttrDef.Value <> '') THEN BEGIN
1496   - Attr := TAttr.Create (AttrDef.Name, AttrDef.Value);
1497   - Attr.ValueType := vtDefault;
1498   - CurAttr.Add (Attr);
1499   - END;
1500   - IF Attr <> NIL THEN BEGIN
1501   - CASE AttrDef.DefaultType OF
1502   - adDefault : ;
1503   - adRequired : ; // -!- It is an error in the document if "Attr.Value" is an empty string
1504   - adImplied : Attr.ValueType := vtImplied;
1505   - adFixed : BEGIN
1506   - Attr.ValueType := vtFixed;
1507   - Attr.Value := AttrDef.Value;
1508   - END;
1509   - END;
1510   - Attr.AttrType := AttrDef.AttrType;
1511   - END;
1512   - END;
1513   - END;
1514   -
1515   - // --- Normalize Attribute Values. XmlSpec:
1516   - // - a character reference is processed by appending the referenced character to the attribute value
1517   - // - an entity reference is processed by recursively processing the replacement text of the entity
1518   - // - a whitespace character (#x20, #xD, #xA, #x9) is processed by appending #x20 to the normalized value,
1519   - // except that only a single #x20 is appended for a "#xD#xA" sequence that is part of an external
1520   - // parsed entity or the literal entity value of an internal parsed entity
1521   - // - other characters are processed by appending them to the normalized value
1522   - // If the declared value is not CDATA, then the XML processor must further process the
1523   - // normalized attribute value by discarding any leading and trailing space (#x20) characters,
1524   - // and by replacing sequences of space (#x20) characters by a single space (#x20) character.
1525   - // All attributes for which no declaration has been read should be treated by a
1526   - // non-validating parser as if declared CDATA.
1527   - // !!! The XML 1.0 SE specification is somewhat different here
1528   - // This code does not conform exactly to this specification
1529   - FOR I := 0 TO CurAttr.Count-1 DO
1530   - WITH TAttr (CurAttr [I]) DO BEGIN
1531   - ReplaceGeneralEntities (Value);
1532   - ReplaceCharacterEntities (Value);
1533   - IF (AttrType <> atCData) AND (AttrType <> atUnknown)
1534   - THEN Value := TranslateEncoding (TrimWs (ConvertWs (Value, TRUE)))
1535   - ELSE Value := TranslateEncoding (ConvertWs (Value, FALSE));
1536   - END;
1537   - END;
1538   -END;
1539   -
1540   -
1541   -PROCEDURE TXmlParser.AnalyzeCData;
1542   - // Analyze CDATA Sections
1543   -BEGIN
1544   - CurPartType := ptCData;
1545   - CurFinal := StrPos (CurStart, CDEnd);
1546   - IF CurFinal = NIL THEN BEGIN
1547   - CurFinal := StrEnd (CurStart)-1;
1548   - CurContent := TranslateEncoding (StrPas (CurStart+Length (CDStart)));
1549   - END
1550   - ELSE BEGIN
1551   - SetStringSF (CurContent, CurStart+Length (CDStart), CurFinal-1);
1552   - INC (CurFinal, Length (CDEnd)-1);
1553   - CurContent := TranslateEncoding (CurContent);
1554   - END;
1555   -END;
1556   -
1557   -
1558   -PROCEDURE TXmlParser.AnalyzeText (VAR IsDone : BOOLEAN);
1559   - (* Analyzes Text Content between Tags. CurFinal will point to the last content character.
1560   - Content ends at a '<' character or at the end of the document.
1561   - Entity References and Character Entity references are resolved.
1562   - If PackSpaces is TRUE, contiguous Whitespace Characters will be compressed to
1563   - one Space #x20 character, Whitespace at the beginning and end of content will
1564   - be trimmed off and content which is or becomes empty is not returned to
1565   - the application (in this case, "IsDone" is set to FALSE which causes the
1566   - Scan method to proceed directly to the next part. *)
1567   -
1568   - PROCEDURE ProcessEntity;
1569   - (* Is called if there is an ampsersand '&' character found in the document.
1570   - IN "CurFinal" points to the ampersand
1571   - OUT "CurFinal" points to the first character after the semi-colon ';' *)
1572   - VAR
1573   - P : PChar;
1574   - Name : STRING;
1575   - EntityDef : TEntityDef;
1576   - ExternalEntity : TXmlParser;
1577   - BEGIN
1578   - P := StrScan (CurFinal , ';');
1579   - IF P <> NIL THEN BEGIN
1580   - SetStringSF (Name, CurFinal+1, P-1);
1581   -
1582   - // Is it a Character Entity?
1583   - IF (CurFinal+1)^ = '#' THEN BEGIN
1584   - IF UpCase ((CurFinal+2)^) = 'X' // !!! Can't use "CHR" for Unicode characters > 255:
1585   - THEN CurContent := CurContent + CHR (StrToIntDef ('$'+Copy (Name, 3, MaxInt), 32))
1586   - ELSE CurContent := CurContent + CHR (StrToIntDef (Copy (Name, 2, MaxInt), 32));
1587   - CurFinal := P+1;
1588   - EXIT;
1589   - END
1590   -
1591   - // Is it a Predefined Entity?
1592   - ELSE IF Name = 'lt' THEN BEGIN CurContent := CurContent + '<'; CurFinal := P+1; EXIT; END
1593   - ELSE IF Name = 'gt' THEN BEGIN CurContent := CurContent + '>'; CurFinal := P+1; EXIT; END
1594   - ELSE IF Name = 'amp' THEN BEGIN CurContent := CurContent + '&'; CurFinal := P+1; EXIT; END
1595   - ELSE IF Name = 'apos' THEN BEGIN CurContent := CurContent + ''''; CurFinal := P+1; EXIT; END
1596   - ELSE IF Name = 'quot' THEN BEGIN CurContent := CurContent + '"'; CurFinal := P+1; EXIT; END;
1597   -
1598   - // Replace with Entity from DTD
1599   - EntityDef := TEntityDef (Entities.Node (Name));
1600   - IF EntityDef <> NIL THEN BEGIN
1601   - IF EntityDef.Value <> '' THEN BEGIN
1602   - EntityStack.Push (P+1);
1603   - CurFinal := PChar (EntityDef.Value);
1604   - END
1605   - ELSE BEGIN
1606   - ExternalEntity := LoadExternalEntity (EntityDef.SystemId, EntityDef.PublicId, EntityDef.NotationName);
1607   - EntityStack.Push (ExternalEntity, P+1);
1608   - CurFinal := ExternalEntity.DocBuffer;
1609   - END;
1610   - END
1611   - ELSE BEGIN
1612   - CurContent := CurContent + Name;
1613   - CurFinal := P+1;
1614   - END;
1615   - END
1616   - ELSE BEGIN
1617   - INC (CurFinal);
1618   - END;
1619   - END;
1620   -
1621   -VAR
1622   - C : INTEGER;
1623   -BEGIN
1624   - CurFinal := CurStart;
1625   - CurPartType := ptContent;
1626   - CurContent := '';
1627   - C := 0;
1628   - REPEAT
1629   - CASE CurFinal^ OF
1630   - '&' : BEGIN
1631   - CurContent := CurContent + TranslateEncoding (StrLPas (CurFinal-C, C));
1632   - C := 0;
1633   - ProcessEntity;
1634   - CONTINUE;
1635   - END;
1636   - #0 : BEGIN
1637   - IF EntityStack.Count = 0 THEN
1638   - BREAK
1639   - ELSE BEGIN
1640   - CurContent := CurContent + TranslateEncoding (StrLPas (CurFinal-C, C));
1641   - C := 0;
1642   - CurFinal := EntityStack.Pop;
1643   - CONTINUE;
1644   - END;
1645   - END;
1646   - '<' : BREAK;
1647   - ELSE INC (C);
1648   - END;
1649   - INC (CurFinal);
1650   - UNTIL FALSE;
1651   - CurContent := CurContent + TranslateEncoding (StrLPas (CurFinal-C, C));
1652   - DEC (CurFinal);
1653   -
1654   - IF FNormalize THEN BEGIN
1655   - CurContent := ConvertWs (TrimWs (CurContent), TRUE);
1656   - IsDone := CurContent <> ''; // IsDone will only get FALSE if PackSpaces is TRUE
1657   - END;
1658   -END;
1659   -
1660   -
1661   -PROCEDURE TXmlParser.AnalyzeElementDecl (Start : PChar; VAR Final : PChar);
1662   - (* Parse <!ELEMENT declaration starting at "Start"
1663   - Final must point to the terminating '>' character
1664   - XmlSpec 3.2:
1665   - elementdecl ::= '<!ELEMENT' S Name S contentspec S? '>'
1666   - contentspec ::= 'EMPTY' | 'ANY' | Mixed | children
1667   - Mixed ::= '(' S? '#PCDATA' (S? '|' S? Name)* S? ')*' |
1668   - '(' S? '#PCDATA' S? ')'
1669   - children ::= (choice | seq) ('?' | '*' | '+')?
1670   - choice ::= '(' S? cp ( S? '|' S? cp )* S? ')'
1671   - cp ::= (Name | choice | seq) ('?' | '*' | '+')?
1672   - seq ::= '(' S? cp ( S? ',' S? cp )* S? ')'
1673   -
1674   - More simply:
1675   - contentspec ::= EMPTY
1676   - ANY
1677   - '(#PCDATA)'
1678   - '(#PCDATA | A | B)*'
1679   - '(A, B, C)'
1680   - '(A | B | C)'
1681   - '(A?, B*, C+),
1682   - '(A, (B | C | D)* )' *)
1683   -VAR
1684   - Element : TElemDef;
1685   - Elem2 : TElemDef;
1686   - F : PChar;
1687   - DER : TDtdElementRec;
1688   -BEGIN
1689   - Element := TElemDef.Create;
1690   - Final := Start + 9;
1691   - DER.Start := Start;
1692   - REPEAT
1693   - IF Final^ = '>' THEN BREAK;
1694   - IF (Final^ IN CNameStart) AND (Element.Name = '') THEN BEGIN
1695   - ExtractName (Final, CWhitespace, F);
1696   - SetStringSF (Element.Name, Final, F);
1697   - Final := F;
1698   - F := StrScan (Final+1, '>');
1699   - IF F = NIL THEN BEGIN
1700   - Element.Definition := STRING (Final);
1701   - Final := StrEnd (Final);
1702   - BREAK;
1703   - END
1704   - ELSE BEGIN
1705   - SetStringSF (Element.Definition, Final+1, F-1);
1706   - Final := F;
1707   - BREAK;
1708   - END;
1709   - END;
1710   - INC (Final);
1711   - UNTIL FALSE;
1712   - Element.Definition := DelChars (Element.Definition, CWhitespace);
1713   - ReplaceParameterEntities (Element.Definition);
1714   - IF Element.Definition = 'EMPTY' THEN Element.ElemType := etEmpty
1715   - ELSE IF Element.Definition = 'ANY' THEN Element.ElemType := etAny
1716   - ELSE IF Copy (Element.Definition, 1, 8) = '(#PCDATA' THEN Element.ElemType := etMixed
1717   - ELSE IF Copy (Element.Definition, 1, 1) = '(' THEN Element.ElemType := etChildren
1718   - ELSE Element.ElemType := etAny;
1719   -
1720   - Elem2 := Elements.Node (Element.Name);
1721   - IF Elem2 <> NIL THEN
1722   - Elements.Delete (Elements.IndexOf (Elem2));
1723   - Elements.Add (Element);
1724   - Final := StrScanE (Final, '>');
1725   - DER.ElementType := deElement;
1726   - DER.ElemDef := Element;
1727   - DER.Final := Final;
1728   - DtdElementFound (DER);
1729   -END;
1730   -
1731   -
1732   -PROCEDURE TXmlParser.AnalyzeAttListDecl (Start : PChar; VAR Final : PChar);
1733   - (* Parse <!ATTLIST declaration starting at "Start"
1734   - Final must point to the terminating '>' character
1735   - XmlSpec 3.3:
1736   - AttlistDecl ::= '<!ATTLIST' S Name AttDef* S? '>'
1737   - AttDef ::= S Name S AttType S DefaultDecl
1738   - AttType ::= StringType | TokenizedType | EnumeratedType
1739   - StringType ::= 'CDATA'
1740   - TokenizedType ::= 'ID' | 'IDREF' | 'IDREFS' | 'ENTITY' | 'ENTITIES' | 'NMTOKEN' | 'NMTOKENS'
1741   - EnumeratedType ::= NotationType | Enumeration
1742   - NotationType ::= 'NOTATION' S '(' S? Name (S? '|' S? Name)* S? ')'
1743   - Enumeration ::= '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')'
1744   - DefaultDecl ::= '#REQUIRED' | '#IMPLIED' | (('#FIXED' S)? AttValue)
1745   - AttValue ::= '"' ([^<&"] | Reference)* '"' | "'" ([^<&'] | Reference)* "'"
1746   - Examples:
1747   - <!ATTLIST address
1748   - A1 CDATA "Default"
1749   - A2 ID #REQUIRED
1750   - A3 IDREF #IMPLIED
1751   - A4 IDREFS #IMPLIED
1752   - A5 ENTITY #FIXED "&at;&#252;"
1753   - A6 ENTITIES #REQUIRED
1754   - A7 NOTATION (WMF | DXF) "WMF"
1755   - A8 (A | B | C) #REQUIRED> *)
1756   -TYPE
1757   - TPhase = (phElementName, phName, phType, phNotationContent, phDefault);
1758   -VAR
1759   - Phase : TPhase;
1760   - F : PChar;
1761   - ElementName : STRING;
1762   - ElemDef : TElemDef;
1763   - AttrDef : TAttrDef;
1764   - AttrDef2 : TAttrDef;
1765   - Strg : STRING;
1766   - DER : TDtdElementRec;
1767   -BEGIN
1768   - Final := Start + 9; // The character after <!ATTLIST
1769   - Phase := phElementName;
1770   - DER.Start := Start;
1771   - AttrDef := NIL;
1772   - ElemDef := NIL;
1773   - REPEAT
1774   - IF NOT (Final^ IN CWhitespace) THEN
1775   - CASE Final^ OF
1776   - '%' : BEGIN
1777   - PushPE (Final);
1778   - CONTINUE;
1779   - END;
1780   - #0 : IF EntityStack.Count = 0 THEN
1781   - BREAK
1782   - ELSE BEGIN
1783   - Final := EntityStack.Pop;
1784   - CONTINUE;
1785   - END;
1786   - '>' : BREAK;
1787   - ELSE CASE Phase OF
1788   - phElementName : BEGIN
1789   - ExtractName (Final, CWhitespace + CQuoteChar + ['#'], F);
1790   - SetStringSF (ElementName, Final, F);
1791   - Final := F;
1792   - ElemDef := Elements.Node (ElementName);
1793   - IF ElemDef = NIL THEN BEGIN
1794   - ElemDef := TElemDef.Create;
1795   - ElemDef.Name := ElementName;
1796   - ElemDef.Definition := 'ANY';
1797   - ElemDef.ElemType := etAny;
1798   - Elements.Add (ElemDef);
1799   - END;
1800   - Phase := phName;
1801   - END;
1802   - phName : BEGIN
1803   - AttrDef := TAttrDef.Create;
1804   - ExtractName (Final, CWhitespace + CQuoteChar + ['#'], F);
1805   - SetStringSF (AttrDef.Name, Final, F);
1806   - Final := F;
1807   - AttrDef2 := TAttrDef (ElemDef.Node (AttrDef.Name));
1808   - IF AttrDef2 <> NIL THEN
1809   - ElemDef.Delete (ElemDef.IndexOf (AttrDef2));
1810   - ElemDef.Add (AttrDef);
1811   - Phase := phType;
1812   - END;
1813   - phType : BEGIN
1814   - IF Final^ = '(' THEN BEGIN
1815   - F := StrScan (Final+1, ')');
1816   - IF F <> NIL
1817   - THEN SetStringSF (AttrDef.TypeDef, Final+1, F-1)
1818   - ELSE AttrDef.TypeDef := STRING (Final+1);
1819   - AttrDef.TypeDef := DelChars (AttrDef.TypeDef, CWhitespace);
1820   - AttrDef.AttrType := atEnumeration;
1821   - ReplaceParameterEntities (AttrDef.TypeDef);
1822   - ReplaceCharacterEntities (AttrDef.TypeDef);
1823   - Phase := phDefault;
1824   - END
1825   - ELSE IF StrLComp (Final, 'NOTATION', 8) = 0 THEN BEGIN
1826   - INC (Final, 8);
1827   - AttrDef.AttrType := atNotation;
1828   - Phase := phNotationContent;
1829   - END
1830   - ELSE BEGIN
1831   - ExtractName (Final, CWhitespace+CQuoteChar+['#'], F);
1832   - SetStringSF (AttrDef.TypeDef, Final, F);
1833   - IF AttrDef.TypeDef = 'CDATA' THEN AttrDef.AttrType := atCData
1834   - ELSE IF AttrDef.TypeDef = 'ID' THEN AttrDef.AttrType := atId
1835   - ELSE IF AttrDef.TypeDef = 'IDREF' THEN AttrDef.AttrType := atIdRef
1836   - ELSE IF AttrDef.TypeDef = 'IDREFS' THEN AttrDef.AttrType := atIdRefs
1837   - ELSE IF AttrDef.TypeDef = 'ENTITY' THEN AttrDef.AttrType := atEntity
1838   - ELSE IF AttrDef.TypeDef = 'ENTITIES' THEN AttrDef.AttrType := atEntities
1839   - ELSE IF AttrDef.TypeDef = 'NMTOKEN' THEN AttrDef.AttrType := atNmToken
1840   - ELSE IF AttrDef.TypeDef = 'NMTOKENS' THEN AttrDef.AttrType := atNmTokens;
1841   - Phase := phDefault;
1842   - END
1843   - END;
1844   - phNotationContent : BEGIN
1845   - F := StrScan (Final, ')');
1846   - IF F <> NIL THEN
1847   - SetStringSF (AttrDef.Notations, Final+1, F-1)
1848   - ELSE BEGIN
1849   - AttrDef.Notations := STRING (Final+1);
1850   - Final := StrEnd (Final);
1851   - END;
1852   - ReplaceParameterEntities (AttrDef.Notations);
1853   - AttrDef.Notations := DelChars (AttrDef.Notations, CWhitespace);
1854   - Phase := phDefault;
1855   - END;
1856   - phDefault : BEGIN
1857   - IF Final^ = '#' THEN BEGIN
1858   - ExtractName (Final, CWhiteSpace + CQuoteChar, F);
1859   - SetStringSF (Strg, Final, F);
1860   - Final := F;
1861   - ReplaceParameterEntities (Strg);
1862   - IF Strg = '#REQUIRED' THEN BEGIN AttrDef.DefaultType := adRequired; Phase := phName; END
1863   - ELSE IF Strg = '#IMPLIED' THEN BEGIN AttrDef.DefaultType := adImplied; Phase := phName; END
1864   - ELSE IF Strg = '#FIXED' THEN AttrDef.DefaultType := adFixed;
1865   - END
1866   - ELSE IF (Final^ IN CQuoteChar) THEN BEGIN
1867   - ExtractQuote (Final, AttrDef.Value, Final);
1868   - ReplaceParameterEntities (AttrDef.Value);
1869   - ReplaceCharacterEntities (AttrDef.Value);
1870   - Phase := phName;
1871   - END;
1872   - IF Phase = phName THEN BEGIN
1873   - AttrDef := NIL;
1874   - END;
1875   - END;
1876   -
1877   - END;
1878   - END;
1879   - INC (Final);
1880   - UNTIL FALSE;
1881   -
1882   - Final := StrScan (Final, '>');
1883   -
1884   - DER.ElementType := deAttList;
1885   - DER.ElemDef := ElemDef;
1886   - DER.Final := Final;
1887   - DtdElementFound (DER);
1888   -END;
1889   -
1890   -
1891   -PROCEDURE TXmlParser.AnalyzeEntityDecl (Start : PChar; VAR Final : PChar);
1892   - (* Parse <!ENTITY declaration starting at "Start"
1893   - Final must point to the terminating '>' character
1894   - XmlSpec 4.2:
1895   - EntityDecl ::= '<!ENTITY' S Name S EntityDef S? '>' |
1896   - '<!ENTITY' S '%' S Name S PEDef S? '>'
1897   - EntityDef ::= EntityValue | (ExternalID NDataDecl?)
1898   - PEDef ::= EntityValue | ExternalID
1899   - NDataDecl ::= S 'NDATA' S Name
1900   - EntityValue ::= '"' ([^%&"] | PEReference | EntityRef | CharRef)* '"' |
1901   - "'" ([^%&'] | PEReference | EntityRef | CharRef)* "'"
1902   - PEReference ::= '%' Name ';'
1903   -
1904   - Examples
1905   - <!ENTITY test1 "Stefan Heymann"> <!-- Internal, general, parsed -->
1906   - <!ENTITY test2 SYSTEM "ent2.xml"> <!-- External, general, parsed -->
1907   - <!ENTITY test2 SYSTEM "ent3.gif" NDATA gif> <!-- External, general, unparsed -->
1908   - <!ENTITY % test3 "<!ELEMENT q ANY>"> <!-- Internal, parameter -->
1909   - <!ENTITY % test6 SYSTEM "ent6.xml"> <!-- External, parameter -->
1910   - <!ENTITY test4 "&test1; ist lieb"> <!-- IGP, Replacement text <> literal value -->
1911   - <!ENTITY test5 "<p>Dies ist ein Test-Absatz</p>"> <!-- IGP, See XmlSpec 2.4 -->
1912   - *)
1913   -TYPE
1914   - TPhase = (phName, phContent, phNData, phNotationName, phFinalGT);
1915   -VAR
1916   - Phase : TPhase;
1917   - IsParamEntity : BOOLEAN;
1918   - F : PChar;
1919   - ExternalID : TExternalID;
1920   - EntityDef : TEntityDef;
1921   - EntityDef2 : TEntityDef;
1922   - DER : TDtdElementRec;
1923   -BEGIN
1924   - Final := Start + 8; // First char after <!ENTITY
1925   - DER.Start := Start;
1926   - Phase := phName;
1927   - IsParamEntity := FALSE;
1928   - EntityDef := TEntityDef.Create;
1929   - REPEAT
1930   - IF NOT (Final^ IN CWhitespace) THEN
1931   - CASE Final^ OF
1932   - '%' : IsParamEntity := TRUE;
1933   - '>' : BREAK;
1934   - ELSE CASE Phase OF
1935   - phName : IF Final^ IN CNameStart THEN BEGIN
1936   - ExtractName (Final, CWhitespace + CQuoteChar, F);
1937   - SetStringSF (EntityDef.Name, Final, F);
1938   - Final := F;
1939   - Phase := phContent;
1940   - END;
1941   - phContent : IF Final^ IN CQuoteChar THEN BEGIN
1942   - ExtractQuote (Final, EntityDef.Value, Final);
1943   - Phase := phFinalGT;
1944   - END
1945   - ELSE IF (StrLComp (Final, 'SYSTEM', 6) = 0) OR
1946   - (StrLComp (Final, 'PUBLIC', 6) = 0) THEN BEGIN
1947   - ExternalID := TExternalID.Create (Final);
1948   - EntityDef.SystemId := ExternalID.SystemId;
1949   - EntityDef.PublicId := ExternalID.PublicId;
1950   - Final := ExternalID.Final;
1951   - Phase := phNData;
1952   - ExternalID.Free;
1953   - END;
1954   - phNData : IF StrLComp (Final, 'NDATA', 5) = 0 THEN BEGIN
1955   - INC (Final, 4);
1956   - Phase := phNotationName;
1957   - END;
1958   - phNotationName : IF Final^ IN CNameStart THEN BEGIN
1959   - ExtractName (Final, CWhitespace + ['>'], F);
1960   - SetStringSF (EntityDef.NotationName, Final, F);
1961   - Final := F;
1962   - Phase := phFinalGT;
1963   - END;
1964   - phFinalGT : ; // -!- There is an error in the document if this branch is called
1965   - END;
1966   - END;
1967   - INC (Final);
1968   - UNTIL FALSE;
1969   - IF IsParamEntity THEN BEGIN
1970   - EntityDef2 := TEntityDef (ParEntities.Node (EntityDef.Name));
1971   - IF EntityDef2 <> NIL THEN
1972   - ParEntities.Delete (ParEntities.IndexOf (EntityDef2));
1973   - ParEntities.Add (EntityDef);
1974   - ReplaceCharacterEntities (EntityDef.Value);
1975   - END
1976   - ELSE BEGIN
1977   - EntityDef2 := TEntityDef (Entities.Node (EntityDef.Name));
1978   - IF EntityDef2 <> NIL THEN
1979   - Entities.Delete (Entities.IndexOf (EntityDef2));
1980   - Entities.Add (EntityDef);
1981   - ReplaceParameterEntities (EntityDef.Value); // Create replacement texts (see XmlSpec 4.5)
1982   - ReplaceCharacterEntities (EntityDef.Value);
1983   - END;
1984   - Final := StrScanE (Final, '>');
1985   -
1986   - DER.ElementType := deEntity;
1987   - DER.EntityDef := EntityDef;
1988   - DER.Final := Final;
1989   - DtdElementFound (DER);
1990   -END;
1991   -
1992   -
1993   -PROCEDURE TXmlParser.AnalyzeNotationDecl (Start : PChar; VAR Final : PChar);
1994   - // Parse <!NOTATION declaration starting at "Start"
1995   - // Final must point to the terminating '>' character
1996   - // XmlSpec 4.7: NotationDecl ::= '<!NOTATION' S Name S (ExternalID | PublicID) S? '>'
1997   -TYPE
1998   - TPhase = (phName, phExtId, phEnd);
1999   -VAR
2000   - ExternalID : TExternalID;
2001   - Phase : TPhase;
2002   - F : PChar;
2003   - NotationDef : TNotationDef;
2004   - DER : TDtdElementRec;
2005   -BEGIN
2006   - Final := Start + 10; // Character after <!NOTATION
2007   - DER.Start := Start;
2008   - Phase := phName;
2009   - NotationDef := TNotationDef.Create;
2010   - REPEAT
2011   - IF NOT (Final^ IN CWhitespace) THEN
2012   - CASE Final^ OF
2013   - '>',
2014   - #0 : BREAK;
2015   - ELSE CASE Phase OF
2016   - phName : BEGIN
2017   - ExtractName (Final, CWhitespace + ['>'], F);
2018   - SetStringSF (NotationDef.Name, Final, F);
2019   - Final := F;
2020   - Phase := phExtId;
2021   - END;
2022   - phExtId : BEGIN
2023   - ExternalID := TExternalID.Create (Final);
2024   - NotationDef.Value := ExternalID.SystemId;
2025   - NotationDef.PublicId := ExternalID.PublicId;
2026   - Final := ExternalId.Final;
2027   - ExternalId.Free;
2028   - Phase := phEnd;
2029   - END;
2030   - phEnd : ; // -!- There is an error in the document if this branch is called
2031   - END;
2032   - END;
2033   - INC (Final);
2034   - UNTIL FALSE;
2035   - Notations.Add (NotationDef);
2036   - Final := StrScanE (Final, '>');
2037   -
2038   - DER.ElementType := deNotation;
2039   - DER.NotationDef := NotationDef;
2040   - DER.Final := Final;
2041   - DtdElementFound (DER);
2042   -END;
2043   -
2044   -
2045   -PROCEDURE TXmlParser.PushPE (VAR Start : PChar);
2046   - (* If there is a parameter entity reference found in the data stream,
2047   - the current position will be pushed to the entity stack.
2048   - Start: IN Pointer to the '%' character starting the PE reference
2049   - OUT Pointer to first character of PE replacement text *)
2050   -VAR
2051   - P : PChar;
2052   - EntityDef : TEntityDef;
2053   -BEGIN
2054   - P := StrScan (Start, ';');
2055   - IF P <> NIL THEN BEGIN
2056   - EntityDef := TEntityDef (ParEntities.Node (StrSFPas (Start+1, P-1)));
2057   - IF EntityDef <> NIL THEN BEGIN
2058   - EntityStack.Push (P+1);
2059   - Start := PChar (EntityDef.Value);
2060   - END
2061   - ELSE
2062   - Start := P+1;
2063   - END;
2064   -END;
2065   -
2066   -
2067   -PROCEDURE TXmlParser.ReplaceCharacterEntities (VAR Str : STRING);
2068   - // Replaces all Character Entity References in the String
2069   -VAR
2070   - Start : INTEGER;
2071   - PAmp : PChar;
2072   - PSemi : PChar;
2073   - PosAmp : INTEGER;
2074   - Len : INTEGER; // Length of Entity Reference
2075   -BEGIN
2076   - IF Str = '' THEN EXIT;
2077   - Start := 1;
2078   - REPEAT
2079   - PAmp := StrPos (PChar (Str) + Start-1, '&#');
2080   - IF PAmp = NIL THEN BREAK;
2081   - PSemi := StrScan (PAmp+2, ';');
2082   - IF PSemi = NIL THEN BREAK;
2083   - PosAmp := PAmp - PChar (Str) + 1;
2084   - Len := PSemi-PAmp+1;
2085   - IF CompareText (Str [PosAmp+2], 'x') = 0 // !!! Can't use "CHR" for Unicode characters > 255
2086   - THEN Str [PosAmp] := CHR (StrToIntDef ('$'+Copy (Str, PosAmp+3, Len-4), 0))
2087   - ELSE Str [PosAmp] := CHR (StrToIntDef (Copy (Str, PosAmp+2, Len-3), 32));
2088   - Delete (Str, PosAmp+1, Len-1);
2089   - Start := PosAmp + 1;
2090   - UNTIL FALSE;
2091   -END;
2092   -
2093   -
2094   -PROCEDURE TXmlParser.ReplaceParameterEntities (VAR Str : STRING);
2095   - // Recursively replaces all Parameter Entity References in the String
2096   - PROCEDURE ReplaceEntities (VAR Str : STRING);
2097   - VAR
2098   - Start : INTEGER;
2099   - PAmp : PChar;
2100   - PSemi : PChar;
2101   - PosAmp : INTEGER;
2102   - Len : INTEGER;
2103   - Entity : TEntityDef;
2104   - Repl : STRING; // Replacement
2105   - BEGIN
2106   - IF Str = '' THEN EXIT;
2107   - Start := 1;
2108   - REPEAT
2109   - PAmp := StrPos (PChar (Str)+Start-1, '%');
2110   - IF PAmp = NIL THEN BREAK;
2111   - PSemi := StrScan (PAmp+2, ';');
2112   - IF PSemi = NIL THEN BREAK;
2113   - PosAmp := PAmp - PChar (Str) + 1;
2114   - Len := PSemi-PAmp+1;
2115   - Entity := TEntityDef (ParEntities.Node (Copy (Str, PosAmp+1, Len-2)));
2116   - IF Entity <> NIL THEN BEGIN
2117   - Repl := Entity.Value;
2118   - ReplaceEntities (Repl); // Recursion
2119   - END
2120   - ELSE
2121   - Repl := Copy (Str, PosAmp, Len);
2122   - Delete (Str, PosAmp, Len);
2123   - Insert (Repl, Str, PosAmp);
2124   - Start := PosAmp + Length (Repl);
2125   - UNTIL FALSE;
2126   - END;
2127   -BEGIN
2128   - ReplaceEntities (Str);
2129   -END;
2130   -
2131   -
2132   -PROCEDURE TXmlParser.ReplaceGeneralEntities (VAR Str : STRING);
2133   - // Recursively replaces General Entity References in the String
2134   - PROCEDURE ReplaceEntities (VAR Str : STRING);
2135   - VAR
2136   - Start : INTEGER;
2137   - PAmp : PChar;
2138   - PSemi : PChar;
2139   - PosAmp : INTEGER;
2140   - Len : INTEGER;
2141   - EntityDef : TEntityDef;
2142   - EntName : STRING;
2143   - Repl : STRING; // Replacement
2144   - ExternalEntity : TXmlParser;
2145   - BEGIN
2146   - IF Str = '' THEN EXIT;
2147   - Start := 1;
2148   - REPEAT
2149   - PAmp := StrPos (PChar (Str)+Start-1, '&');
2150   - IF PAmp = NIL THEN BREAK;
2151   - PSemi := StrScan (PAmp+2, ';');
2152   - IF PSemi = NIL THEN BREAK;
2153   - PosAmp := PAmp - PChar (Str) + 1;
2154   - Len := PSemi-PAmp+1;
2155   - EntName := Copy (Str, PosAmp+1, Len-2);
2156   - IF EntName = 'lt' THEN Repl := '<'
2157   - ELSE IF EntName = 'gt' THEN Repl := '>'
2158   - ELSE IF EntName = 'amp' THEN Repl := '&'
2159   - ELSE IF EntName = 'apos' THEN Repl := ''''
2160   - ELSE IF EntName = 'quot' THEN Repl := '"'
2161   - ELSE BEGIN
2162   - EntityDef := TEntityDef (Entities.Node (EntName));
2163   - IF EntityDef <> NIL THEN BEGIN
2164   - IF EntityDef.Value <> '' THEN // Internal Entity
2165   - Repl := EntityDef.Value
2166   - ELSE BEGIN // External Entity
2167   - ExternalEntity := LoadExternalEntity (EntityDef.SystemId, EntityDef.PublicId, EntityDef.NotationName);
2168   - Repl := StrPas (ExternalEntity.DocBuffer); // !!! What if it contains a Text Declaration?
2169   - ExternalEntity.Free;
2170   - END;
2171   - ReplaceEntities (Repl); // Recursion
2172   - END
2173   - ELSE
2174   - Repl := Copy (Str, PosAmp, Len);
2175   - END;
2176   - Delete (Str, PosAmp, Len);
2177   - Insert (Repl, Str, PosAmp);
2178   - Start := PosAmp + Length (Repl);
2179   - UNTIL FALSE;
2180   - END;
2181   -BEGIN
2182   - ReplaceEntities (Str);
2183   -END;
2184   -
2185   -
2186   -FUNCTION TXmlParser.LoadExternalEntity (SystemId, PublicId, Notation : STRING) : TXmlParser;
2187   - // This will be called whenever there is a Parsed External Entity or
2188   - // the DTD External Subset to be parsed.
2189   - // It has to create a TXmlParser instance and load the desired Entity.
2190   - // This instance of LoadExternalEntity assumes that "SystemId" is a valid
2191   - // file name (relative to the Document source) and loads this file using
2192   - // the LoadFromFile method.
2193   -VAR
2194   - Filename : STRING;
2195   -BEGIN
2196   - // --- Convert System ID to complete filename
2197   - Filename := StringReplace (SystemId, '/', '\', [rfReplaceAll]);
2198   - IF Copy (FSource, 1, 1) <> '<' THEN
2199   - IF (Copy (Filename, 1, 2) = '\\') OR (Copy (Filename, 2, 1) = ':') THEN
2200   - // Already has an absolute Path
2201   - ELSE BEGIN
2202   - Filename := ExtractFilePath (FSource) + Filename;
2203   - END;
2204   -
2205   - // --- Load the File
2206   - Result := TXmlParser.Create;
2207   - Result.LoadFromFile (Filename);
2208   -END;
2209   -
2210   -
2211   -FUNCTION TXmlParser.TranslateEncoding (CONST Source : STRING) : STRING;
2212   - // The member variable "CurEncoding" always holds the name of the current
2213   - // encoding, e.g. 'UTF-8' or 'ISO-8859-1'.
2214   - // This virtual method "TranslateEncoding" is responsible for translating
2215   - // the content passed in the "Source" parameter to the Encoding which
2216   - // is expected by the application.
2217   - // This instance of "TranlateEncoding" assumes that the Application expects
2218   - // Windows ANSI (Win1252) strings. It is able to transform UTF-8 or ISO-8859-1
2219   - // encodings.
2220   - // If you want your application to understand or create other encodings, you
2221   - // override this function.
2222   -BEGIN
2223   - IF CurEncoding = 'UTF-8'
2224   - THEN Result := Utf8ToAnsi (Source)
2225   - ELSE Result := Source;
2226   -END;
2227   -
2228   -
2229   -PROCEDURE TXmlParser.DtdElementFound (DtdElementRec : TDtdElementRec);
2230   - // This method is called for every element which is found in the DTD
2231   - // declaration. The variant record TDtdElementRec is passed which
2232   - // holds informations about the element.
2233   - // You can override this function to handle DTD declarations.
2234   - // Note that when you parse the same Document instance a second time,
2235   - // the DTD will not get parsed again.
2236   -BEGIN
2237   -END;
2238   -
2239   -
2240   -FUNCTION TXmlParser.GetDocBuffer: PChar;
2241   - // Returns FBuffer or a pointer to a NUL char if Buffer is empty
2242   -BEGIN
2243   - IF FBuffer = NIL
2244   - THEN Result := #0
2245   - ELSE Result := FBuffer;
2246   -END;
2247   -
2248   -
2249   -(*$IFNDEF HAS_CONTNRS_UNIT
2250   -===============================================================================================
2251   -TObjectList
2252   -===============================================================================================
2253   -*)
2254   -
2255   -DESTRUCTOR TObjectList.Destroy;
2256   -BEGIN
2257   - Clear;
2258   - SetCapacity(0);
2259   - INHERITED Destroy;
2260   -END;
2261   -
2262   -
2263   -PROCEDURE TObjectList.Delete (Index : INTEGER);
2264   -BEGIN
2265   - IF (Index < 0) OR (Index >= Count) THEN EXIT;
2266   - TObject (Items [Index]).Free;
2267   - INHERITED Delete (Index);
2268   -END;
2269   -
2270   -
2271   -PROCEDURE TObjectList.Clear;
2272   -BEGIN
2273   - WHILE Count > 0 DO
2274   - Delete (Count-1);
2275   -END;
2276   -
2277   -(*$ENDIF *)
2278   -
2279   -(*
2280   -===============================================================================================
2281   -TNvpNode
2282   ---------
2283   -Node base class for the TNvpList
2284   -===============================================================================================
2285   -*)
2286   -
2287   -CONSTRUCTOR TNvpNode.Create (TheName, TheValue : STRING);
2288   -BEGIN
2289   - INHERITED Create;
2290   - Name := TheName;
2291   - Value := TheValue;
2292   -END;
2293   -
2294   -
2295   -(*
2296   -===============================================================================================
2297   -TNvpList
2298   ---------
2299   -A generic List of Name-Value Pairs, based on the TObjectList introduced in Delphi 5
2300   -===============================================================================================
2301   -*)
2302   -
2303   -PROCEDURE TNvpList.Add (Node : TNvpNode);
2304   -VAR
2305   - I : INTEGER;
2306   -BEGIN
2307   - FOR I := Count-1 DOWNTO 0 DO
2308   - IF Node.Name > TNvpNode (Items [I]).Name THEN BEGIN
2309   - Insert (I+1, Node);
2310   - EXIT;
2311   - END;
2312   - Insert (0, Node);
2313   -END;
2314   -
2315   -
2316   -
2317   -FUNCTION TNvpList.Node (Name : STRING) : TNvpNode;
2318   - // Binary search for Node
2319   -VAR
2320   - L, H : INTEGER; // Low, High Limit
2321   - T, C : INTEGER; // Test Index, Comparison result
2322   - Last : INTEGER; // Last Test Index
2323   -BEGIN
2324   - IF Count=0 THEN BEGIN
2325   - Result := NIL;
2326   - EXIT;
2327   - END;
2328   -
2329   - L := 0;
2330   - H := Count;
2331   - Last := -1;
2332   - REPEAT
2333   - T := (L+H) DIV 2;
2334   - IF T=Last THEN BREAK;
2335   - Result := TNvpNode (Items [T]);
2336   - C := CompareStr (Result.Name, Name);
2337   - IF C = 0 THEN EXIT
2338   - ELSE IF C < 0 THEN L := T
2339   - ELSE H := T;
2340   - Last := T;
2341   - UNTIL FALSE;
2342   - Result := NIL;
2343   -END;
2344   -
2345   -
2346   -FUNCTION TNvpList.Node (Index : INTEGER) : TNvpNode;
2347   -BEGIN
2348   - IF (Index < 0) OR (Index >= Count)
2349   - THEN Result := NIL
2350   - ELSE Result := TNvpNode (Items [Index]);
2351   -END;
2352   -
2353   -
2354   -FUNCTION TNvpList.Value (Name : STRING) : STRING;
2355   -VAR
2356   - Nvp : TNvpNode;
2357   -BEGIN
2358   - Nvp := TNvpNode (Node (Name));
2359   - IF Nvp <> NIL
2360   - THEN Result := Nvp.Value
2361   - ELSE Result := '';
2362   -END;
2363   -
2364   -
2365   -FUNCTION TNvpList.Value (Index : INTEGER) : STRING;
2366   -BEGIN
2367   - IF (Index < 0) OR (Index >= Count)
2368   - THEN Result := ''
2369   - ELSE Result := TNvpNode (Items [Index]).Value;
2370   -END;
2371   -
2372   -
2373   -FUNCTION TNvpList.Name (Index : INTEGER) : STRING;
2374   -BEGIN
2375   - IF (Index < 0) OR (Index >= Count)
2376   - THEN Result := ''
2377   - ELSE Result := TNvpNode (Items [Index]).Name;
2378   -END;
2379   -
2380   -
2381   -(*
2382   -===============================================================================================
2383   -TAttrList
2384   -List of Attributes. The "Analyze" method extracts the Attributes from the given Buffer.
2385   -Is used for extraction of Attributes in Start-Tags, Empty-Element Tags and the "pseudo"
2386   -attributes in XML Prologs, Text Declarations and PIs.
2387   -===============================================================================================
2388   -*)
2389   -
2390   -PROCEDURE TAttrList.Analyze (Start : PChar; VAR Final : PChar);
2391   - // Analyze the Buffer for Attribute=Name pairs.
2392   - // Terminates when there is a character which is not IN CNameStart
2393   - // (e.g. '?>' or '>' or '/>')
2394   -TYPE
2395   - TPhase = (phName, phEq, phValue);
2396   -VAR
2397   - Phase : TPhase;
2398   - F : PChar;
2399   - Name : STRING;
2400   - Value : STRING;
2401   - Attr : TAttr;
2402   -BEGIN
2403   - Clear;
2404   - Phase := phName;
2405   - Final := Start;
2406   - REPEAT
2407   - IF (Final^ = #0) OR (Final^ = '>') THEN BREAK;
2408   - IF NOT (Final^ IN CWhitespace) THEN
2409   - CASE Phase OF
2410   - phName : BEGIN
2411   - IF NOT (Final^ IN CNameStart) THEN EXIT;
2412   - ExtractName (Final, CWhitespace + ['=', '/'], F);
2413   - SetStringSF (Name, Final, F);
2414   - Final := F;
2415   - Phase := phEq;
2416   - END;
2417   - phEq : BEGIN
2418   - IF Final^ = '=' THEN
2419   - Phase := phValue
2420   - END;
2421   - phValue : BEGIN
2422   - IF Final^ IN CQuoteChar THEN BEGIN
2423   - ExtractQuote (Final, Value, F);
2424   - Attr := TAttr.Create;
2425   - Attr.Name := Name;
2426   - Attr.Value := Value;
2427   - Attr.ValueType := vtNormal;
2428   - Add (Attr);
2429   - Final := F;
2430   - Phase := phName;
2431   - END;
2432   - END;
2433   - END;
2434   - INC (Final);
2435   - UNTIL FALSE;
2436   -END;
2437   -
2438   -
2439   -(*
2440   -===============================================================================================
2441   -TElemList
2442   -List of TElemDef nodes.
2443   -===============================================================================================
2444   -*)
2445   -
2446   -FUNCTION TElemList.Node (Name : STRING) : TElemDef;
2447   - // Binary search for the Node with the given Name
2448   -VAR
2449   - L, H : INTEGER; // Low, High Limit
2450   - T, C : INTEGER; // Test Index, Comparison result
2451   - Last : INTEGER; // Last Test Index
2452   -BEGIN
2453   - IF Count=0 THEN BEGIN
2454   - Result := NIL;
2455   - EXIT;
2456   - END;
2457   -
2458   - L := 0;
2459   - H := Count;
2460   - Last := -1;
2461   - REPEAT
2462   - T := (L+H) DIV 2;
2463   - IF T=Last THEN BREAK;
2464   - Result := TElemDef (Items [T]);
2465   - C := CompareStr (Result.Name, Name);
2466   - IF C = 0 THEN EXIT
2467   - ELSE IF C < 0 THEN L := T
2468   - ELSE H := T;
2469   - Last := T;
2470   - UNTIL FALSE;
2471   - Result := NIL;
2472   -END;
2473   -
2474   -
2475   -PROCEDURE TElemList.Add (Node : TElemDef);
2476   -VAR
2477   - I : INTEGER;
2478   -BEGIN
2479   - FOR I := Count-1 DOWNTO 0 DO
2480   - IF Node.Name > TElemDef (Items [I]).Name THEN BEGIN
2481   - Insert (I+1, Node);
2482   - EXIT;
2483   - END;
2484   - Insert (0, Node);
2485   -END;
2486   -
2487   -
2488   -(*
2489   -===============================================================================================
2490   -TScannerXmlParser
2491   -A TXmlParser descendant for the TCustomXmlScanner component
2492   -===============================================================================================
2493   -*)
2494   -
2495   -TYPE
2496   - TScannerXmlParser = CLASS (TXmlParser)
2497   - Scanner : TCustomXmlScanner;
2498   - CONSTRUCTOR Create (TheScanner : TCustomXmlScanner);
2499   - FUNCTION LoadExternalEntity (SystemId, PublicId,
2500   - Notation : STRING) : TXmlParser; OVERRIDE;
2501   - FUNCTION TranslateEncoding (CONST Source : STRING) : STRING; OVERRIDE;
2502   - PROCEDURE DtdElementFound (DtdElementRec : TDtdElementRec); OVERRIDE;
2503   - END;
2504   -
2505   -CONSTRUCTOR TScannerXmlParser.Create (TheScanner : TCustomXmlScanner);
2506   -BEGIN
2507   - INHERITED Create;
2508   - Scanner := TheScanner;
2509   -END;
2510   -
2511   -
2512   -FUNCTION TScannerXmlParser.LoadExternalEntity (SystemId, PublicId, Notation : STRING) : TXmlParser;
2513   -BEGIN
2514   - IF Assigned (Scanner.FOnLoadExternal)
2515   - THEN Scanner.FOnLoadExternal (Scanner, SystemId, PublicId, Notation, Result)
2516   - ELSE Result := INHERITED LoadExternalEntity (SystemId, PublicId, Notation);
2517   -END;
2518   -
2519   -
2520   -FUNCTION TScannerXmlParser.TranslateEncoding (CONST Source : STRING) : STRING;
2521   -BEGIN
2522   - IF Assigned (Scanner.FOnTranslateEncoding)
2523   - THEN Result := Scanner.FOnTranslateEncoding (Scanner, CurEncoding, Source)
2524   - ELSE Result := INHERITED TranslateEncoding (Source);
2525   -END;
2526   -
2527   -
2528   -PROCEDURE TScannerXmlParser.DtdElementFound (DtdElementRec : TDtdElementRec);
2529   -BEGIN
2530   - WITH DtdElementRec DO
2531   - CASE ElementType OF
2532   - deElement : Scanner.WhenElement (ElemDef);
2533   - deAttList : Scanner.WhenAttList (ElemDef);
2534   - deEntity : Scanner.WhenEntity (EntityDef);
2535   - deNotation : Scanner.WhenNotation (NotationDef);
2536   - dePI : Scanner.WhenPI (STRING (Target), STRING (Content), AttrList);
2537   - deComment : Scanner.WhenComment (StrSFPas (Start, Final));
2538   - deError : Scanner.WhenDtdError (Pos);
2539   - END;
2540   -END;
2541   -
2542   -
2543   -(*
2544   -===============================================================================================
2545   -TCustomXmlScanner
2546   -===============================================================================================
2547   -*)
2548   -
2549   -CONSTRUCTOR TCustomXmlScanner.Create (AOwner: TComponent);
2550   -BEGIN
2551   - INHERITED;
2552   - FXmlParser := TScannerXmlParser.Create (Self);
2553   -END;
2554   -
2555   -
2556   -DESTRUCTOR TCustomXmlScanner.Destroy;
2557   -BEGIN
2558   - FXmlParser.Free;
2559   - INHERITED;
2560   -END;
2561   -
2562   -
2563   -PROCEDURE TCustomXmlScanner.LoadFromFile (Filename : TFilename);
2564   - // Load XML Document from file
2565   -BEGIN
2566   - FXmlParser.LoadFromFile (Filename);
2567   -END;
2568   -
2569   -
2570   -PROCEDURE TCustomXmlScanner.LoadFromBuffer (Buffer : PChar);
2571   - // Load XML Document from buffer
2572   -BEGIN
2573   - FXmlParser.LoadFromBuffer (Buffer);
2574   -END;
2575   -
2576   -
2577   -PROCEDURE TCustomXmlScanner.SetBuffer (Buffer : PChar);
2578   - // Refer to Buffer
2579   -BEGIN
2580   - FXmlParser.SetBuffer (Buffer);
2581   -END;
2582   -
2583   -
2584   -FUNCTION TCustomXmlScanner.GetFilename : TFilename;
2585   -BEGIN
2586   - Result := FXmlParser.Source;
2587   -END;
2588   -
2589   -
2590   -FUNCTION TCustomXmlScanner.GetNormalize : BOOLEAN;
2591   -BEGIN
2592   - Result := FXmlParser.Normalize;
2593   -END;
2594   -
2595   -
2596   -PROCEDURE TCustomXmlScanner.SetNormalize (Value : BOOLEAN);
2597   -BEGIN
2598   - FXmlParser.Normalize := Value;
2599   -END;
2600   -
2601   -
2602   -PROCEDURE TCustomXmlScanner.WhenXmlProlog(XmlVersion, Encoding: STRING; Standalone : BOOLEAN);
2603   - // Is called when the parser has parsed the <? xml ?> declaration of the prolog
2604   -BEGIN
2605   - IF Assigned (FOnXmlProlog) THEN FOnXmlProlog (Self, XmlVersion, Encoding, Standalone);
2606   -END;
2607   -
2608   -
2609   -PROCEDURE TCustomXmlScanner.WhenComment (Comment : STRING);
2610   - // Is called when the parser has parsed a <!-- comment -->
2611   -BEGIN
2612   - IF Assigned (FOnComment) THEN FOnComment (Self, Comment);
2613   -END;
2614   -
2615   -
2616   -PROCEDURE TCustomXmlScanner.WhenPI (Target, Content: STRING; Attributes : TAttrList);
2617   - // Is called when the parser has parsed a <?processing instruction ?>
2618   -BEGIN
2619   - IF Assigned (FOnPI) THEN FOnPI (Self, Target, Content, Attributes);
2620   -END;
2621   -
2622   -
2623   -PROCEDURE TCustomXmlScanner.WhenDtdRead (RootElementName : STRING);
2624   - // Is called when the parser has completely parsed the DTD
2625   -BEGIN
2626   - IF Assigned (FOnDtdRead) THEN FOnDtdRead (Self, RootElementName);
2627   -END;
2628   -
2629   -
2630   -PROCEDURE TCustomXmlScanner.WhenStartTag (TagName : STRING; Attributes : TAttrList);
2631   - // Is called when the parser has parsed a start tag like <p>
2632   -BEGIN
2633   - IF Assigned (FOnStartTag) THEN FOnStartTag (Self, TagName, Attributes);
2634   -END;
2635   -
2636   -
2637   -PROCEDURE TCustomXmlScanner.WhenEmptyTag (TagName : STRING; Attributes : TAttrList);
2638   - // Is called when the parser has parsed an Empty Element Tag like <br/>
2639   -BEGIN
2640   - IF Assigned (FOnEmptyTag) THEN FOnEmptyTag (Self, TagName, Attributes);
2641   -END;
2642   -
2643   -
2644   -PROCEDURE TCustomXmlScanner.WhenEndTag (TagName : STRING);
2645   - // Is called when the parser has parsed an End Tag like </p>
2646   -BEGIN
2647   - IF Assigned (FOnEndTag) THEN FOnEndTag (Self, TagName);
2648   -END;
2649   -
2650   -
2651   -PROCEDURE TCustomXmlScanner.WhenContent (Content : STRING);
2652   - // Is called when the parser has parsed an element's text content
2653   -BEGIN
2654   - IF Assigned (FOnContent) THEN FOnContent (Self, Content);
2655   -END;
2656   -
2657   -
2658   -PROCEDURE TCustomXmlScanner.WhenCData (Content : STRING);
2659   - // Is called when the parser has parsed a CDATA section
2660   -BEGIN
2661   - IF Assigned (FOnCData) THEN FOnCData (Self, Content);
2662   -END;
2663   -
2664   -
2665   -PROCEDURE TCustomXmlScanner.WhenElement (ElemDef : TElemDef);
2666   - // Is called when the parser has parsed an <!ELEMENT> definition
2667   - // inside the DTD
2668   -BEGIN
2669   - IF Assigned (FOnElement) THEN FOnElement (Self, ElemDef);
2670   -END;
2671   -
2672   -
2673   -PROCEDURE TCustomXmlScanner.WhenAttList (ElemDef : TElemDef);
2674   - // Is called when the parser has parsed an <!ATTLIST> definition
2675   - // inside the DTD
2676   -BEGIN
2677   - IF Assigned (FOnAttList) THEN FOnAttList (Self, ElemDef);
2678   -END;
2679   -
2680   -
2681   -PROCEDURE TCustomXmlScanner.WhenEntity (EntityDef : TEntityDef);
2682   - // Is called when the parser has parsed an <!ENTITY> definition
2683   - // inside the DTD
2684   -BEGIN
2685   - IF Assigned (FOnEntity) THEN FOnEntity (Self, EntityDef);
2686   -END;
2687   -
2688   -
2689   -PROCEDURE TCustomXmlScanner.WhenNotation (NotationDef : TNotationDef);
2690   - // Is called when the parser has parsed a <!NOTATION> definition
2691   - // inside the DTD
2692   -BEGIN
2693   - IF Assigned (FOnNotation) THEN FOnNotation (Self, NotationDef);
2694   -END;
2695   -
2696   -
2697   -PROCEDURE TCustomXmlScanner.WhenDtdError (ErrorPos : PChar);
2698   - // Is called when the parser has found an Error in the DTD
2699   -BEGIN
2700   - IF Assigned (FOnDtdError) THEN FOnDtdError (Self, ErrorPos);
2701   -END;
2702   -
2703   -
2704   -PROCEDURE TCustomXmlScanner.Execute;
2705   - // Perform scanning
2706   - // Scanning is done synchronously, i.e. you can expect events to be triggered
2707   - // in the order of the XML data stream. Execute will finish when the whole XML
2708   - // document has been scanned or when the StopParser property has been set to TRUE.
2709   -BEGIN
2710   - FStopParser := FALSE;
2711   - FXmlParser.StartScan;
2712   - WHILE FXmlParser.Scan AND (NOT FStopParser) DO
2713   - CASE FXmlParser.CurPartType OF
2714   - ptNone : ;
2715   - ptXmlProlog : WhenXmlProlog (FXmlParser.XmlVersion, FXmlParser.Encoding, FXmlParser.Standalone);
2716   - ptComment : WhenComment (StrSFPas (FXmlParser.CurStart, FXmlParser.CurFinal));
2717   - ptPI : WhenPI (FXmlParser.CurName, FXmlParser.CurContent, FXmlParser.CurAttr);
2718   - ptDtdc : WhenDtdRead (FXmlParser.RootName);
2719   - ptStartTag : WhenStartTag (FXmlParser.CurName, FXmlParser.CurAttr);
2720   - ptEmptyTag : WhenEmptyTag (FXmlParser.CurName, FXmlParser.CurAttr);
2721   - ptEndTag : WhenEndTag (FXmlParser.CurName);
2722   - ptContent : WhenContent (FXmlParser.CurContent);
2723   - ptCData : WhenCData (FXmlParser.CurContent);
2724   - END;
2725   -END;
2726   -
2727   -
2728   -END.
testacrypt/cacic.ico
View file @7684306
No preview for this file type
testacrypt/main_testacrypt.ddp
View file @7684306
No preview for this file type
testacrypt/main_testacrypt.dfm
View file @7684306
... ... @@ -1,425 +0,0 @@
1   -object Form1: TForm1
2   - Left = 420
3   - Top = 109
4   - ActiveControl = Edit_FraseOriginal
5   - BorderStyle = bsToolWindow
6   - Caption = 'TestaCrypt - Teste de Criptografia do Sistema CACIC'
7   - ClientHeight = 526
8   - ClientWidth = 530
9   - Color = clBtnFace
10   - Font.Charset = DEFAULT_CHARSET
11   - Font.Color = clWindowText
12   - Font.Height = -11
13   - Font.Name = 'MS Sans Serif'
14   - Font.Style = []
15   - OldCreateOrder = False
16   - Position = poDesktopCenter
17   - OnActivate = FormActivate
18   - OnCreate = FormCreate
19   - PixelsPerInch = 96
20   - TextHeight = 13
21   - object GroupBox_Conexao: TGroupBox
22   - Left = 5
23   - Top = 2
24   - Width = 520
25   - Height = 60
26   - Caption = 'Conex'#227'o'
27   - Font.Charset = DEFAULT_CHARSET
28   - Font.Color = clNavy
29   - Font.Height = -8
30   - Font.Name = 'MS Sans Serif'
31   - Font.Style = [fsBold]
32   - ParentFont = False
33   - TabOrder = 0
34   - object Label_CaminhoScript: TLabel
35   - Left = 8
36   - Top = 17
37   - Width = 179
38   - Height = 13
39   - Caption = 'Script para Teste (caminho completo):'
40   - Font.Charset = DEFAULT_CHARSET
41   - Font.Color = clWindowText
42   - Font.Height = -8
43   - Font.Name = 'MS Sans Serif'
44   - Font.Style = []
45   - ParentFont = False
46   - end
47   - object Edit_ScriptPath: TEdit
48   - Left = 7
49   - Top = 33
50   - Width = 508
51   - Height = 21
52   - Font.Charset = DEFAULT_CHARSET
53   - Font.Color = clBlack
54   - Font.Height = -11
55   - Font.Name = 'MS Sans Serif'
56   - Font.Style = [fsBold]
57   - MaxLength = 100
58   - ParentFont = False
59   - TabOrder = 0
60   - Text = 'http://255.255.255.255/cacic2/ws/testacrypt.php'
61   - OnChange = Edit_ScriptPathChange
62   - end
63   - end
64   - object GroupBox_TestesCliente: TGroupBox
65   - Left = 5
66   - Top = 69
67   - Width = 520
68   - Height = 153
69   - Caption = 'Lado Cliente'
70   - Font.Charset = DEFAULT_CHARSET
71   - Font.Color = clNavy
72   - Font.Height = -11
73   - Font.Name = 'MS Sans Serif'
74   - Font.Style = [fsBold]
75   - ParentFont = False
76   - TabOrder = 1
77   - object Label_FraseOriginal: TLabel
78   - Left = 8
79   - Top = 64
80   - Width = 67
81   - Height = 13
82   - Caption = 'Frase Original:'
83   - Font.Charset = DEFAULT_CHARSET
84   - Font.Color = clWindowText
85   - Font.Height = -11
86   - Font.Name = 'MS Sans Serif'
87   - Font.Style = []
88   - ParentFont = False
89   - end
90   - object Label_FraseCriptografadaEnviadaEstacao: TLabel
91   - Left = 8
92   - Top = 110
93   - Width = 337
94   - Height = 13
95   - Caption =
96   - 'Frase Criptografada (para envio ao servidor ou testes de decript' +
97   - 'ografia):'
98   - Font.Charset = DEFAULT_CHARSET
99   - Font.Color = clWindowText
100   - Font.Height = -11
101   - Font.Name = 'MS Sans Serif'
102   - Font.Style = []
103   - ParentFont = False
104   - end
105   - object Label_IVStation: TLabel
106   - Left = 8
107   - Top = 20
108   - Width = 123
109   - Height = 13
110   - Caption = 'IV (Vetor de Inicializa'#231#227'o):'
111   - Font.Charset = DEFAULT_CHARSET
112   - Font.Color = clWindowText
113   - Font.Height = -11
114   - Font.Name = 'MS Sans Serif'
115   - Font.Style = []
116   - ParentFont = False
117   - end
118   - object Label_CipherKeyStation: TLabel
119   - Left = 264
120   - Top = 20
121   - Width = 51
122   - Height = 13
123   - Caption = 'CipherKey:'
124   - Font.Charset = DEFAULT_CHARSET
125   - Font.Color = clWindowText
126   - Font.Height = -11
127   - Font.Name = 'MS Sans Serif'
128   - Font.Style = []
129   - ParentFont = False
130   - end
131   - object Edit_FraseOriginal: TEdit
132   - Left = 8
133   - Top = 80
134   - Width = 506
135   - Height = 21
136   - Font.Charset = DEFAULT_CHARSET
137   - Font.Color = clBlack
138   - Font.Height = -11
139   - Font.Name = 'MS Sans Serif'
140   - Font.Style = []
141   - MaxLength = 100
142   - ParentFont = False
143   - TabOrder = 3
144   - OnEnter = Edit_FraseOriginalEnter
145   - OnExit = Edit_FraseOriginalExit
146   - OnKeyUp = Edit_FraseOriginalKeyUp
147   - end
148   - object Edit_FraseCriptografadaEnviadaEstacao: TEdit
149   - Left = 8
150   - Top = 125
151   - Width = 506
152   - Height = 21
153   - TabStop = False
154   - Font.Charset = DEFAULT_CHARSET
155   - Font.Color = clBlack
156   - Font.Height = -11
157   - Font.Name = 'MS Sans Serif'
158   - Font.Style = []
159   - MaxLength = 100
160   - ParentFont = False
161   - TabOrder = 2
162   - OnChange = Edit_FraseCriptografadaEnviadaEstacaoChange
163   - OnExit = Edit_FraseCriptografadaEnviadaEstacaoExit
164   - end
165   - object Edit_IVStation: TEdit
166   - Left = 8
167   - Top = 35
168   - Width = 250
169   - Height = 21
170   - Font.Charset = DEFAULT_CHARSET
171   - Font.Color = clBlack
172   - Font.Height = -11
173   - Font.Name = 'MS Sans Serif'
174   - Font.Style = []
175   - MaxLength = 100
176   - ParentFont = False
177   - TabOrder = 0
178   - OnChange = Edit_IVStationChange
179   - OnExit = Edit_IVStationExit
180   - end
181   - object Edit_CipherKeyStation: TEdit
182   - Left = 264
183   - Top = 35
184   - Width = 250
185   - Height = 21
186   - Font.Charset = DEFAULT_CHARSET
187   - Font.Color = clBlack
188   - Font.Height = -11
189   - Font.Name = 'MS Sans Serif'
190   - Font.Style = []
191   - MaxLength = 100
192   - ParentFont = False
193   - TabOrder = 1
194   - OnChange = Edit_CipherKeyStationChange
195   - OnExit = Edit_CipherKeyStationExit
196   - end
197   - end
198   - object Button_EfetuaTeste: TButton
199   - Left = 87
200   - Top = 461
201   - Width = 150
202   - Height = 30
203   - Caption = 'Efetua Teste'
204   - Enabled = False
205   - Font.Charset = DEFAULT_CHARSET
206   - Font.Color = clWindowText
207   - Font.Height = -16
208   - Font.Name = 'MS Sans Serif'
209   - Font.Style = []
210   - ParentFont = False
211   - TabOrder = 3
212   - OnClick = Button_EfetuaTesteClick
213   - end
214   - object Button_Finaliza: TButton
215   - Left = 289
216   - Top = 461
217   - Width = 150
218   - Height = 30
219   - Caption = 'Finaliza'
220   - Font.Charset = DEFAULT_CHARSET
221   - Font.Color = clWindowText
222   - Font.Height = -16
223   - Font.Name = 'MS Sans Serif'
224   - Font.Style = []
225   - ParentFont = False
226   - TabOrder = 5
227   - OnClick = Button_FinalizaClick
228   - end
229   - object GroupBox_TesteServidor: TGroupBox
230   - Left = 5
231   - Top = 225
232   - Width = 520
233   - Height = 109
234   - Caption = 'Lado Servidor'
235   - Font.Charset = DEFAULT_CHARSET
236   - Font.Color = clNavy
237   - Font.Height = -11
238   - Font.Name = 'MS Sans Serif'
239   - Font.Style = [fsBold]
240   - ParentFont = False
241   - TabOrder = 2
242   - Visible = False
243   - object Label_IVServer: TLabel
244   - Left = 8
245   - Top = 20
246   - Width = 123
247   - Height = 13
248   - Caption = 'IV (Vetor de Inicializa'#231#227'o):'
249   - Font.Charset = DEFAULT_CHARSET
250   - Font.Color = clWindowText
251   - Font.Height = -11
252   - Font.Name = 'MS Sans Serif'
253   - Font.Style = []
254   - ParentFont = False
255   - end
256   - object Label_CipherKeyServer: TLabel
257   - Left = 264
258   - Top = 20
259   - Width = 51
260   - Height = 13
261   - Caption = 'CipherKey:'
262   - Font.Charset = DEFAULT_CHARSET
263   - Font.Color = clWindowText
264   - Font.Height = -11
265   - Font.Name = 'MS Sans Serif'
266   - Font.Style = []
267   - ParentFont = False
268   - end
269   - object Label_FraseCriptografadaRecebidaServidor: TLabel
270   - Left = 8
271   - Top = 66
272   - Width = 207
273   - Height = 13
274   - Caption = 'Frase Criptografada (Recebida no Servidor):'
275   - Font.Charset = DEFAULT_CHARSET
276   - Font.Color = clWindowText
277   - Font.Height = -11
278   - Font.Name = 'MS Sans Serif'
279   - Font.Style = []
280   - ParentFont = False
281   - end
282   - object Edit_IVServer: TEdit
283   - Left = 8
284   - Top = 35
285   - Width = 250
286   - Height = 21
287   - TabStop = False
288   - Font.Charset = DEFAULT_CHARSET
289   - Font.Color = clBlack
290   - Font.Height = -11
291   - Font.Name = 'MS Sans Serif'
292   - Font.Style = []
293   - MaxLength = 100
294   - ParentFont = False
295   - ReadOnly = True
296   - TabOrder = 0
297   - OnChange = Edit_IVServerChange
298   - end
299   - object Edit_CipherKeyServer: TEdit
300   - Left = 264
301   - Top = 35
302   - Width = 250
303   - Height = 21
304   - TabStop = False
305   - Font.Charset = DEFAULT_CHARSET
306   - Font.Color = clBlack
307   - Font.Height = -11
308   - Font.Name = 'MS Sans Serif'
309   - Font.Style = []
310   - MaxLength = 100
311   - ParentFont = False
312   - ReadOnly = True
313   - TabOrder = 1
314   - end
315   - object Edit_FraseCriptografadaRecebidaServidor: TEdit
316   - Left = 8
317   - Top = 81
318   - Width = 506
319   - Height = 21
320   - TabStop = False
321   - Font.Charset = DEFAULT_CHARSET
322   - Font.Color = clBlack
323   - Font.Height = -11
324   - Font.Name = 'MS Sans Serif'
325   - Font.Style = []
326   - MaxLength = 100
327   - ParentFont = False
328   - ReadOnly = True
329   - TabOrder = 2
330   - end
331   - end
332   - object GroupBox_Resultado: TGroupBox
333   - Left = 5
334   - Top = 337
335   - Width = 520
336   - Height = 107
337   - Caption = 'Resultado'
338   - Font.Charset = DEFAULT_CHARSET
339   - Font.Color = clNavy
340   - Font.Height = -11
341   - Font.Name = 'MS Sans Serif'
342   - Font.Style = [fsBold]
343   - ParentFont = False
344   - TabOrder = 4
345   - Visible = False
346   - object Label_FraseDecriptografadaDevolvidaServidor: TLabel
347   - Left = 8
348   - Top = 64
349   - Width = 231
350   - Height = 13
351   - Caption = 'Frase DeCriptografada (Devolvida pelo Servidor):'
352   - Font.Charset = DEFAULT_CHARSET
353   - Font.Color = clWindowText
354   - Font.Height = -11
355   - Font.Name = 'MS Sans Serif'
356   - Font.Style = []
357   - ParentFont = False
358   - end
359   - object Label_OperacaoRecebidaServidor: TLabel
360   - Left = 8
361   - Top = 18
362   - Width = 156
363   - Height = 13
364   - Caption = 'Opera'#231#227'o Solicitada ao Servidor:'
365   - Font.Charset = DEFAULT_CHARSET
366   - Font.Color = clWindowText
367   - Font.Height = -11
368   - Font.Name = 'MS Sans Serif'
369   - Font.Style = []
370   - ParentFont = False
371   - end
372   - object Edit_FraseDecriptografadaDevolvidaServidor: TEdit
373   - Left = 8
374   - Top = 79
375   - Width = 506
376   - Height = 21
377   - TabStop = False
378   - Font.Charset = DEFAULT_CHARSET
379   - Font.Color = clBlack
380   - Font.Height = -11
381   - Font.Name = 'MS Sans Serif'
382   - Font.Style = []
383   - MaxLength = 100
384   - ParentFont = False
385   - ReadOnly = True
386   - TabOrder = 0
387   - end
388   - object Edit_OperacaoRecebidaServidor: TEdit
389   - Left = 6
390   - Top = 33
391   - Width = 506
392   - Height = 21
393   - TabStop = False
394   - Font.Charset = DEFAULT_CHARSET
395   - Font.Color = clBlack
396   - Font.Height = -11
397   - Font.Name = 'MS Sans Serif'
398   - Font.Style = []
399   - MaxLength = 100
400   - ParentFont = False
401   - ReadOnly = True
402   - TabOrder = 1
403   - OnChange = Edit_OperacaoRecebidaServidorChange
404   - end
405   - end
406   - object StatusBar_Mensagens: TJvStatusBar
407   - Left = 0
408   - Top = 507
409   - Width = 530
410   - Height = 19
411   - Panels = <
412   - item
413   - Alignment = taCenter
414   - Width = 450
415   - end
416   - item
417   - Alignment = taCenter
418   - Width = 50
419   - end>
420   - end
421   - object PJVersionInfo1: TPJVersionInfo
422   - Left = 464
423   - Top = 456
424   - end
425   -end
testacrypt/main_testacrypt.pas
View file @7684306
... ... @@ -1,414 +0,0 @@
1   -unit main_testacrypt;
2   -
3   -interface
4   -
5   -uses
6   - Windows,
7   - Messages,
8   - SysUtils,
9   - Variants,
10   - Classes,
11   - Graphics,
12   - Controls,
13   - Forms,
14   - XML,
15   - LibXmlParser,
16   - IdHTTP,
17   - IdBaseComponent,
18   - IdComponent,
19   - IdTCPConnection,
20   - IdTCPClient,
21   - StdCtrls,
22   - WinSock,
23   - NB30,
24   - ComCtrls,
25   - PJVersionInfo,
26   - JvExComCtrls,
27   - JvStatusBar,
28   - CACIC_Library;
29   -
30   -type
31   - TForm1 = class(TForm)
32   - GroupBox_Conexao: TGroupBox;
33   - Label_CaminhoScript: TLabel;
34   - Edit_ScriptPath: TEdit;
35   - GroupBox_TestesCliente: TGroupBox;
36   - Label_FraseOriginal: TLabel;
37   - Label_FraseCriptografadaEnviadaEstacao: TLabel;
38   - Edit_FraseOriginal: TEdit;
39   - Edit_FraseCriptografadaEnviadaEstacao: TEdit;
40   - Button_EfetuaTeste: TButton;
41   - Button_Finaliza: TButton;
42   - Label_IVStation: TLabel;
43   - Edit_IVStation: TEdit;
44   - GroupBox_TesteServidor: TGroupBox;
45   - Label_CipherKeyStation: TLabel;
46   - Edit_CipherKeyStation: TEdit;
47   - Label_IVServer: TLabel;
48   - Label_CipherKeyServer: TLabel;
49   - Edit_IVServer: TEdit;
50   - Edit_CipherKeyServer: TEdit;
51   - Label_FraseCriptografadaRecebidaServidor: TLabel;
52   - Edit_FraseCriptografadaRecebidaServidor: TEdit;
53   - GroupBox_Resultado: TGroupBox;
54   - Label_FraseDecriptografadaDevolvidaServidor: TLabel;
55   - Edit_FraseDecriptografadaDevolvidaServidor: TEdit;
56   - Label_OperacaoRecebidaServidor: TLabel;
57   - Edit_OperacaoRecebidaServidor: TEdit;
58   - PJVersionInfo1: TPJVersionInfo;
59   - StatusBar_Mensagens: TJvStatusBar;
60   - procedure Button_EfetuaTesteClick(Sender: TObject);
61   - function PadWithZeros(const str : string; size : integer) : string;
62   - procedure Button_FinalizaClick(Sender: TObject);
63   - procedure Edit_FraseOriginalKeyUp(Sender: TObject; var Key: Word;
64   - Shift: TShiftState);
65   - procedure FormCreate(Sender: TObject);
66   - procedure FormActivate(Sender: TObject);
67   - procedure Edit_FraseOriginalEnter(Sender: TObject);
68   - Procedure InicializaCampos;
69   - procedure Edit_FraseCriptografadaEnviadaEstacaoChange(Sender: TObject);
70   - procedure Edit_IVServerChange(Sender: TObject);
71   - procedure Edit_OperacaoRecebidaServidorChange(Sender: TObject);
72   - procedure ProcessaPausa;
73   - procedure Edit_CipherKeyStationChange(Sender: TObject);
74   - procedure Edit_FraseOriginalExit(Sender: TObject);
75   - procedure CriptografaPalavra;
76   - procedure Edit_IVStationExit(Sender: TObject);
77   - procedure Edit_CipherKeyStationExit(Sender: TObject);
78   - function VerFmt(const MS, LS: DWORD): string;
79   - function GetVersionInfo(p_File: string):string;
80   - procedure Edit_ScriptPathChange(Sender: TObject);
81   - procedure DesfazCriticas;
82   - procedure Edit_IVStationChange(Sender: TObject);
83   - procedure Edit_FraseCriptografadaEnviadaEstacaoExit(Sender: TObject);
84   - private
85   - { Private declarations }
86   - public
87   - { Public declarations }
88   - end;
89   -
90   -var Form1: TForm1;
91   - boolProcessaPausa : boolean;
92   -
93   -var
94   - g_oCacic: TCACIC;
95   -
96   -implementation
97   -
98   -{$R *.dfm}
99   -procedure TForm1.CriptografaPalavra;
100   -Begin
101   - if (trim(form1.Edit_FraseOriginal.Text)<>'') then
102   - Begin
103   - Form1.Edit_FraseCriptografadaEnviadaEstacao.Text := g_oCacic.enCrypt(trim(form1.Edit_FraseOriginal.Text))
104   - //else if (trim(form1.Edit_FraseCriptografadaEnviadaEstacao.Text)<>'') then
105   - // Form1.Edit_FraseOriginal.Text := g_oCacic.deCrypt(trim(form1.Edit_FraseCriptografadaEnviadaEstacao.Text));
106   - end;
107   -End;
108   -
109   -procedure TForm1.Button_EfetuaTesteClick(Sender: TObject);
110   -var v_retorno,
111   - v_strAux,
112   - v_Status : String;
113   -
114   - Request_Config : TStringList;
115   - Response_Config : TStringStream;
116   - IdHTTP1: TIdHTTP;
117   - intAux : integer;
118   -begin
119   - if (Trim(Edit_FraseCriptografadaEnviadaEstacao.Text) <> '') then
120   - Begin
121   - boolProcessaPausa := true;
122   - // InicializaCampos;
123   - CriptografaPalavra;
124   -
125   - intAux := POS('255.255.255.255',Edit_ScriptPath.Text);
126   - if (intAux > 0) then
127   - Begin
128   - StatusBar_Mensagens.Panels[0].Text := 'ATENÇÃO: Caso não seja um teste local, informe um endereço válido.';
129   - StatusBar_Mensagens.Color := clYellow;
130   - Edit_ScriptPath.SetFocus;
131   - End
132   - else
133   - Begin
134   -
135   - Request_Config := TStringList.Create;
136   - Request_Config.Values['cs_operacao'] := 'TestaCrypt';
137   - Request_Config.Values['cs_cipher'] := '1';
138   - Request_Config.Values['te_CipheredText'] := trim(Form1.Edit_FraseCriptografadaEnviadaEstacao.Text);
139   - Response_Config := TStringStream.Create('');
140   -
141   - Try
142   - idHTTP1 := TIdHTTP.Create(nil);
143   - idHTTP1.AllowCookies := true;
144   - idHTTP1.ASCIIFilter := false;
145   - idHTTP1.AuthRetries := 1;
146   - idHTTP1.BoundPort := 0;
147   - idHTTP1.HandleRedirects := false;
148   - idHTTP1.ProxyParams.BasicAuthentication := false;
149   - idHTTP1.ProxyParams.ProxyPort := 0;
150   - idHTTP1.ReadTimeout := 0;
151   - idHTTP1.RecvBufferSize := 32768;
152   - idHTTP1.RedirectMaximum := 15;
153   - idHTTP1.Request.Accept := 'text/html, */*';
154   - idHTTP1.Request.BasicAuthentication := true;
155   - idHTTP1.Request.ContentLength := -1;
156   - idHTTP1.Request.ContentRangeStart := 0;
157   - idHTTP1.Request.ContentRangeEnd := 0;
158   - idHTTP1.Request.ContentType := 'text/html';
159   - idHTTP1.SendBufferSize := 32768;
160   - idHTTP1.Tag := 0;
161   -
162   - Form1.StatusBar_Mensagens.Panels[0].Text := 'Fazendo comunicação com "'+form1.Edit_ScriptPath.Text+'"';
163   - Sleep(1000);
164   - Form1.StatusBar_Mensagens.Panels[0].Text := '';
165   -
166   - IdHTTP1.Post(trim(Form1.Edit_ScriptPath.Text), Request_Config, Response_Config);
167   -
168   - //ShowMessage('Retorno: '+Response_Config.DataString);
169   - idHTTP1.Free;
170   - v_retorno := Response_Config.DataString;
171   - v_Status := XML_RetornaValor('STATUS',v_retorno);
172   - Except
173   - Begin
174   - Form1.StatusBar_Mensagens.Panels[0].Text := 'Problemas na comunicação...';
175   - Sleep(1000);
176   - Form1.StatusBar_Mensagens.Panels[0].Text := '';
177   - End;
178   - End;
179   - Request_Config.Free;
180   - Response_Config.Free;
181   -
182   - if (v_Status <> '') then
183   - Begin
184   - v_strAux := XML_RetornaValor('UnCipheredText',v_retorno);
185   - form1.Edit_IVServer.Text := XML_RetornaValor('IVServer',v_retorno);
186   - form1.Edit_CipherKeyServer.Text := XML_RetornaValor('CipherKeyServer',v_retorno);
187   - form1.Edit_FraseCriptografadaRecebidaServidor.Text := XML_RetornaValor('CipheredTextRecepted',v_retorno);
188   - form1.Edit_OperacaoRecebidaServidor.Text := XML_RetornaValor('CS_OPERACAO',v_retorno);
189   - if (v_strAux <> '') then
190   - Begin
191   - form1.Edit_FraseDecriptografadaDevolvidaServidor.Text := v_strAux;
192   - if (trim(form1.Edit_FraseDecriptografadaDevolvidaServidor.Text) <> trim(form1.Edit_FraseOriginal.Text)) then
193   - Begin
194   - form1.Edit_FraseDecriptografadaDevolvidaServidor.Font.Color := clRed;
195   - if (Edit_CipherKeyStation.Text <> Edit_CipherKeyServer.Text) then
196   - Begin
197   - Edit_CipherKeyStation.Color := clYellow;
198   - Edit_CipherKeyServer.Color := clYellow;
199   - End;
200   - if (Edit_IVStation.Text <> Edit_IVServer.Text) then
201   - Begin
202   - Edit_IVStation.Color := clYellow;
203   - Edit_IVServer.Color := clYellow;
204   - End;
205   -
206   - End
207   - else
208   - form1.Edit_FraseDecriptografadaDevolvidaServidor.Font.Color := clBlue;
209   - End
210   - else
211   - Begin
212   - form1.Edit_FraseDecriptografadaDevolvidaServidor.Text := 'NÃO FOI POSSÍVEL DECRIPTOGRAFAR!!!';
213   - form1.Edit_FraseDecriptografadaDevolvidaServidor.Font.Style := [fsBold];
214   - form1.Edit_FraseDecriptografadaDevolvidaServidor.Font.Color := clRed;
215   - End;
216   - Form1.StatusBar_Mensagens.Panels[0].Text := 'Teste Concluído!';
217   - End
218   - else
219   - Begin
220   - Form1.StatusBar_Mensagens.Panels[0].Text := 'Problemas na comunicação...';
221   - Sleep(1000);
222   - Form1.StatusBar_Mensagens.Panels[0].Text := '';
223   - End;
224   - End;
225   - end;
226   -end;
227   -// Pad a string with zeros so that it is a multiple of size
228   -function TForm1.PadWithZeros(const str : string; size : integer) : string;
229   -var
230   - origsize, i : integer;
231   -begin
232   - Result := str;
233   - origsize := Length(Result);
234   - if ((origsize mod size) <> 0) or (origsize = 0) then
235   - begin
236   - SetLength(Result,((origsize div size)+1)*size);
237   - for i := origsize+1 to Length(Result) do
238   - Result[i] := #0;
239   - end;
240   -end;
241   -
242   -
243   -
244   -procedure TForm1.Button_FinalizaClick(Sender: TObject);
245   -begin
246   - Application.Terminate;
247   -end;
248   -
249   -procedure TForm1.Edit_FraseOriginalKeyUp(Sender: TObject; var Key: Word;
250   - Shift: TShiftState);
251   -begin
252   - if (form1.Edit_FraseOriginal.Text <> '') then
253   - Begin
254   - form1.Button_EfetuaTeste.Enabled := true;
255   - End;
256   -
257   -end;
258   -function TForm1.VerFmt(const MS, LS: DWORD): string;
259   - // Format the version number from the given DWORDs containing the info
260   -begin
261   - Result := Format('%d.%d.%d.%d',
262   - [HiWord(MS), LoWord(MS), HiWord(LS), LoWord(LS)])
263   -end;
264   -
265   -function TForm1.GetVersionInfo(p_File: string):string;
266   -var PJVersionInfo1: TPJVersionInfo;
267   -begin
268   - PJVersionInfo1 := TPJVersionInfo.Create(nil);
269   - PJVersionInfo1.FileName := PChar(p_File);
270   - Result := VerFmt(PJVersionInfo1.FixedFileInfo.dwFileVersionMS, PJVersionInfo1.FixedFileInfo.dwFileVersionLS);
271   - PJVersionInfo1.Free;
272   -end;
273   -
274   -procedure TForm1.FormCreate(Sender: TObject);
275   -begin
276   - g_oCacic := TCACIC.Create;
277   - g_oCacic.setBoolCipher(true);
278   -
279   - form1.Edit_IVStation.Text := g_oCacic.getIV;
280   - form1.Edit_CipherKeyStation.Text := g_oCacic.getCipherKey;
281   -
282   - Form1.StatusBar_Mensagens.Panels[1].Text := 'v: '+getVersionInfo(ParamStr(0));
283   - boolProcessaPausa := false;
284   -end;
285   -
286   -procedure TForm1.FormActivate(Sender: TObject);
287   -begin
288   - form1.Edit_FraseOriginal.Enabled := true;
289   - form1.Edit_FraseOriginal.Visible := true;
290   - form1.Edit_FraseOriginal.SetFocus;
291   -
292   -end;
293   -procedure TForm1.Edit_FraseOriginalEnter(Sender: TObject);
294   -begin
295   - InicializaCampos;
296   -end;
297   -
298   -procedure TForm1.Edit_FraseCriptografadaEnviadaEstacaoChange(
299   - Sender: TObject);
300   -begin
301   - if trim(form1.Edit_FraseCriptografadaEnviadaEstacao.Text) = '' then
302   - form1.Button_EfetuaTeste.Enabled := true;
303   - ProcessaPausa;
304   -end;
305   -
306   -procedure TForm1.Edit_IVServerChange(Sender: TObject);
307   -begin
308   - if trim(form1.Edit_IVServer.Text) = '' then
309   - form1.GroupBox_TesteServidor.Visible := false
310   - else
311   - form1.GroupBox_TesteServidor.Visible := true;
312   -
313   - ProcessaPausa;
314   -end;
315   -
316   -procedure TForm1.Edit_OperacaoRecebidaServidorChange(Sender: TObject);
317   -begin
318   - if trim(form1.Edit_OperacaoRecebidaServidor.Text) = '' then
319   - form1.GroupBox_Resultado.Visible := false
320   - else
321   - form1.GroupBox_Resultado.Visible := true;
322   -
323   - ProcessaPausa;
324   -end;
325   -
326   -procedure TForm1.ProcessaPausa;
327   -Begin
328   - if boolProcessaPausa then
329   - Begin
330   - boolProcessaPausa := false;
331   - sleep(500);
332   - End;
333   - Application.ProcessMessages;
334   -End;
335   -procedure TForm1.Edit_CipherKeyStationChange(Sender: TObject);
336   -begin
337   - Form1.InicializaCampos;
338   - DesfazCriticas;
339   -end;
340   -
341   -procedure TForm1.Edit_FraseOriginalExit(Sender: TObject);
342   -begin
343   - CriptografaPalavra;
344   -end;
345   -
346   -procedure TForm1.Edit_IVStationExit(Sender: TObject);
347   -begin
348   - CriptografaPalavra;
349   -end;
350   -
351   -procedure TForm1.Edit_CipherKeyStationExit(Sender: TObject);
352   -begin
353   - CriptografaPalavra;
354   -end;
355   -
356   -procedure TForm1.DesfazCriticas;
357   -Begin
358   - Form1.StatusBar_Mensagens.Color := clBtnFace;
359   - Form1.Edit_CipherKeyStation.Color := clWindow;
360   - Form1.Edit_CipherKeyServer.Color := clWindow;
361   - Form1.Edit_IVStation.Color := clWindow;
362   - Form1.Edit_IVServer.Color := clWindow;
363   -
364   - Application.ProcessMessages;
365   -End;
366   -
367   -procedure TForm1.InicializaCampos;
368   -Begin
369   - form1.GroupBox_TesteServidor.Visible := false;
370   - form1.GroupBox_Resultado.Visible := false;
371   -// Form1.Edit_FraseDecriptografadaDevolvidaServidor.Visible := false;
372   -// form1.Edit_FraseCriptografadaRecebidaServidor.Visible := false;
373   -// form1.Edit_FraseCriptografadaEnviadaEstacao.Visible := false;
374   -// form1.Edit_FraseDecriptografadaDevolvidaServidor.Visible := false;
375   -// form1.Edit_OperacaoRecebidaServidor.Visible := false;
376   -// form1.Edit_IVServer.Visible := false;
377   -// form1.Edit_CipherKeyServer.Visible := false;
378   -
379   - Form1.Edit_FraseDecriptografadaDevolvidaServidor.Text := '';
380   - form1.Edit_FraseCriptografadaRecebidaServidor.Text := '';
381   -// form1.Edit_FraseCriptografadaEnviadaEstacao.Text := '';
382   - form1.Edit_FraseDecriptografadaDevolvidaServidor.Text := '';
383   - form1.Edit_OperacaoRecebidaServidor.Text := '';
384   - form1.Edit_IVServer.Text := '';
385   - form1.Edit_CipherKeyServer.Text := '';
386   - form1.Edit_FraseDecriptografadaDevolvidaServidor.Font.Style := [];
387   - form1.Edit_FraseDecriptografadaDevolvidaServidor.Font.Color := clBlack;
388   -
389   - Application.ProcessMessages;
390   -
391   -End;
392   -
393   -procedure TForm1.Edit_ScriptPathChange(Sender: TObject);
394   -begin
395   - InicializaCampos;
396   - DesfazCriticas;
397   -end;
398   -
399   -procedure TForm1.Edit_IVStationChange(Sender: TObject);
400   -begin
401   - DesfazCriticas;
402   -end;
403   -
404   -procedure TForm1.Edit_FraseCriptografadaEnviadaEstacaoExit(
405   - Sender: TObject);
406   -begin
407   - if (form1.Edit_FraseCriptografadaEnviadaEstacao.Text <> '') then
408   - Begin
409   - form1.Button_EfetuaTeste.Enabled := true;
410   - End;
411   -
412   -end;
413   -
414   -end.
testacrypt/testacrypt.cfg
View file @7684306
... ... @@ -1,42 +0,0 @@
1   --$A8
2   --$B-
3   --$C+
4   --$D+
5   --$E-
6   --$F-
7   --$G+
8   --$H+
9   --$I+
10   --$J-
11   --$K-
12   --$L+
13   --$M-
14   --$N+
15   --$O+
16   --$P+
17   --$Q-
18   --$R-
19   --$S-
20   --$T-
21   --$U-
22   --$V+
23   --$W-
24   --$X+
25   --$YD
26   --$Z1
27   --cg
28   --AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
29   --H+
30   --W+
31   --M
32   --$M16384,1048576
33   --K$00400000
34   --LE"c:\arquivos de programas\borland\delphi7\Projects\Bpl"
35   --LN"c:\arquivos de programas\borland\delphi7\Projects\Bpl"
36   --U"C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\Indy;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\CriptografiaDCP"
37   --O"C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\Indy;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\CriptografiaDCP"
38   --I"C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\Indy;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\CriptografiaDCP"
39   --R"C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\Indy;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\CriptografiaDCP"
40   --w-UNSAFE_TYPE
41   --w-UNSAFE_CODE
42   --w-UNSAFE_CAST
testacrypt/testacrypt.dof
View file @7684306
... ... @@ -1,154 +0,0 @@
1   -[FileVersion]
2   -Version=7.0
3   -[Compiler]
4   -A=8
5   -B=0
6   -C=1
7   -D=1
8   -E=0
9   -F=0
10   -G=1
11   -H=1
12   -I=1
13   -J=0
14   -K=0
15   -L=1
16   -M=0
17   -N=1
18   -O=1
19   -P=1
20   -Q=0
21   -R=0
22   -S=0
23   -T=0
24   -U=0
25   -V=1
26   -W=0
27   -X=1
28   -Y=1
29   -Z=1
30   -ShowHints=1
31   -ShowWarnings=1
32   -UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
33   -NamespacePrefix=
34   -SymbolDeprecated=1
35   -SymbolLibrary=1
36   -SymbolPlatform=1
37   -UnitLibrary=1
38   -UnitPlatform=1
39   -UnitDeprecated=1
40   -HResultCompat=1
41   -HidingMember=1
42   -HiddenVirtual=1
43   -Garbage=1
44   -BoundsError=1
45   -ZeroNilCompat=1
46   -StringConstTruncated=1
47   -ForLoopVarVarPar=1
48   -TypedConstVarPar=1
49   -AsgToTypedConst=1
50   -CaseLabelRange=1
51   -ForVariable=1
52   -ConstructingAbstract=1
53   -ComparisonFalse=1
54   -ComparisonTrue=1
55   -ComparingSignedUnsigned=1
56   -CombiningSignedUnsigned=1
57   -UnsupportedConstruct=1
58   -FileOpen=1
59   -FileOpenUnitSrc=1
60   -BadGlobalSymbol=1
61   -DuplicateConstructorDestructor=1
62   -InvalidDirective=1
63   -PackageNoLink=1
64   -PackageThreadVar=1
65   -ImplicitImport=1
66   -HPPEMITIgnored=1
67   -NoRetVal=1
68   -UseBeforeDef=1
69   -ForLoopVarUndef=1
70   -UnitNameMismatch=1
71   -NoCFGFileFound=1
72   -MessageDirective=1
73   -ImplicitVariants=1
74   -UnicodeToLocale=1
75   -LocaleToUnicode=1
76   -ImagebaseMultiple=1
77   -SuspiciousTypecast=1
78   -PrivatePropAccessor=1
79   -UnsafeType=0
80   -UnsafeCode=0
81   -UnsafeCast=0
82   -[Linker]
83   -MapFile=0
84   -OutputObjs=0
85   -ConsoleApp=1
86   -DebugInfo=0
87   -RemoteSymbols=0
88   -MinStackSize=16384
89   -MaxStackSize=1048576
90   -ImageBase=4194304
91   -ExeDescription=
92   -[Directories]
93   -OutputDir=
94   -UnitOutputDir=
95   -PackageDLLOutputDir=
96   -PackageDCPOutputDir=
97   -SearchPath=C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\Indy;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\CriptografiaDCP
98   -Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOffice2k;XLSMini_D7
99   -Conditionals=
100   -DebugSourceDirs=C:\Arquivos de programas\Borland\Delphi7\Mitec\D7
101   -UsePackages=0
102   -[Parameters]
103   -RunParams=
104   -HostApplication=
105   -Launcher=
106   -UseLauncher=0
107   -DebugCWD=
108   -[Language]
109   -ActiveLang=
110   -ProjectLang=
111   -RootDir=C:\Arquivos de programas\Borland\Delphi7\Bin\
112   -[Version Info]
113   -IncludeVerInfo=1
114   -AutoIncBuild=0
115   -MajorVer=2
116   -MinorVer=4
117   -Release=0
118   -Build=601
119   -Debug=0
120   -PreRelease=0
121   -Special=0
122   -Private=0
123   -DLL=0
124   -Locale=1033
125   -CodePage=1252
126   -[Version Info Keys]
127   -CompanyName=
128   -FileDescription=
129   -FileVersion=2.4.0.601
130   -InternalName=
131   -LegalCopyright=
132   -LegalTrademarks=
133   -OriginalFilename=
134   -ProductName=
135   -ProductVersion=2.4.0.371
136   -Comments=
137   -[HistoryLists\hlDebugSourcePath]
138   -Count=1
139   -Item0=C:\Arquivos de programas\Borland\Delphi7\Mitec\D7
140   -[HistoryLists\hlUnitAliases]
141   -Count=1
142   -Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
143   -[HistoryLists\hlSearchPath]
144   -Count=10
145   -Item0=C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\Indy;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\CriptografiaDCP
146   -Item1=C:\Arquivos de programas\Borland\Delphi7\Source\Rtl\Common;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\CriptografiaDCP;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\Mitec\v1010_Delphi7;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\NTFileSecurity;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\PJVersion;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\Indy
147   -Item2=C:\Arquivos de programas\Borland\Delphi7\Source\Rtl\Common;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\CriptografiaDCP;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\Mitec\v1010_Delphi7;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\NTFileSecurity;C:\Arquivos de programas\Borland\Delphi7\Comps_CACIC\PJVersion
148   -Item3=C:\Arquivos de programas\Borland\Delphi7\D7;C:\Arquivos de programas\Borland\Delphi7\Mitec\D7;C:\Arquivos de programas\Borland\Delphi7\Source\Rtl\Common;C:\Arquivos de programas\Borland\Delphi7\CriptografiaDCP;C:\Arquivos de programas\Borland\Delphi7\CriptografiaDCP\Hashes;C:\Arquivos de programas\Borland\Delphi7\CriptografiaDCP\Ciphers
149   -Item4=C:\Arquivos de programas\Borland\Delphi7\D7;C:\Arquivos de programas\Borland\Delphi7\Mitec\D7;C:\Arquivos de programas\Borland\Delphi7\Source\Rtl\Common;C:\Arquivos de programas\Borland\Delphi7\CriptografiaDCP;C:\Arquivos de programas\Borland\Delphi7\CriptografiaDCP\Hashes
150   -Item5=C:\Arquivos de programas\Borland\Delphi7\D7;C:\Arquivos de programas\Borland\Delphi7\Mitec\D7;C:\Arquivos de programas\Borland\Delphi7\Source\Rtl\Common;C:\Arquivos de programas\Borland\Delphi7\CriptografiaDCP
151   -Item6=C:\Arquivos de programas\Borland\Delphi7\D7;C:\Arquivos de programas\Borland\Delphi7\Mitec\D7;C:\Arquivos de programas\Borland\Delphi7\Source\Rtl\Common
152   -Item7=C:\Arquivos de programas\Borland\Delphi7\D7;C:\Arquivos de programas\Borland\Delphi7\Mitec\D7
153   -Item8=C:\Arquivos de programas\Borland\Delphi7\D7
154   -Item9=C:\Arquivos de programas\Borland\Delphi7\Mitec\D7
testacrypt/testacrypt.dpr
View file @7684306
... ... @@ -1,13 +0,0 @@
1   -program testacrypt;
2   -
3   -uses
4   - Forms,
5   - main_testacrypt in 'main_testacrypt.pas' {Form1};
6   -
7   -{$R *.res}
8   -
9   -begin
10   - Application.Initialize;
11   - Application.CreateForm(TForm1, Form1);
12   - Application.Run;
13   -end.
testacrypt/testacrypt.res
View file @7684306
No preview for this file type
testacrypt/xml.pas
View file @7684306
... ... @@ -1,34 +0,0 @@
1   -unit XML;
2   -
3   -
4   -interface
5   -
6   -Uses LibXmlParser, SysUtils;
7   -
8   -Function XML_RetornaValor(Tag : String; Fonte : String) : String;
9   -
10   -implementation
11   -
12   -
13   -Function XML_RetornaValor(Tag : String; Fonte : String): String;
14   -VAR
15   - Parser : TXmlParser;
16   -begin
17   - Parser := TXmlParser.Create;
18   - Parser.Normalize := TRUE;
19   - Parser.LoadFromBuffer(PAnsiChar(Fonte));
20   - Parser.StartScan;
21   - WHILE Parser.Scan DO
22   - Begin
23   - if (Parser.CurPartType in [ptContent, ptCData]) Then // Process Parser.CurContent field here
24   - begin
25   - if (UpperCase(Parser.CurName) = UpperCase(Tag)) then
26   - Begin
27   - Result := Parser.CurContent;
28   - end;
29   - end;
30   - end;
31   - Parser.Free;
32   -end;
33   -
34   -end.