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 +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,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,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,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,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,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,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,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.