sax.pp 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888
  1. {
  2. This file is part of the Free Component Library
  3. SAX 2 (Simple API for XML) implementation
  4. Copyright (c) 2000 - 2002 by
  5. Areca Systems GmbH / Sebastian Guenther, [email protected]
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. {$IFNDEF FPC_DOTTEDUNITS}
  13. unit SAX;
  14. {$ENDIF FPC_DOTTEDUNITS}
  15. {$MODE objfpc}
  16. {$H+}
  17. interface
  18. {$IFDEF FPC_DOTTEDUNITS}
  19. uses System.SysUtils, System.Classes, Xml.Utils;
  20. {$ELSE FPC_DOTTEDUNITS}
  21. uses SysUtils, Classes, xmlutils;
  22. {$ENDIF FPC_DOTTEDUNITS}
  23. resourcestring
  24. SSAXAttributeIndexError = 'Invalid attribute index %d';
  25. SSAXUnrecognizedFeature = 'Unknown SAX feature: "%s"';
  26. SSAXUnrecognizedProperty = 'Unknown SAX property: "%s"';
  27. const
  28. XMLNS = 'http://www.w3.org/XML/1998/namespace';
  29. type
  30. SAXString = XMLString;
  31. SAXChar = WideChar;
  32. PSAXChar = PXMLChar;
  33. { Exceptions }
  34. ESAXError = class(Exception);
  35. ESAXAttributeIndexError = class(ESAXError)
  36. public
  37. constructor Create(Index: Integer);
  38. end;
  39. ESAXParseException = class(ESAXError);
  40. ESAXNotRecognizedException = class(ESAXError);
  41. { TSAXInputSource: A single input source for an XML entity }
  42. TSAXInputSource = class
  43. private
  44. FStream: TStream;
  45. FEncoding: String;
  46. FPublicID, FSystemID: SAXString;
  47. public
  48. constructor Create; overload;
  49. constructor Create(AStream: TStream); overload;
  50. constructor Create(const ASystemID: SAXString); overload;
  51. property Stream: TStream read FStream write FStream;
  52. property Encoding: String read FEncoding write FEncoding;
  53. property PublicID: SAXString read FPublicID write FPublicID;
  54. property SystemID: SAXString read FSystemID write FSystemID;
  55. end;
  56. { TSAXAttributes: List of XML attributes }
  57. TSAXAttributeData = record
  58. URI, LocalName, QName, Value: SAXString;
  59. AttrType: String;
  60. end;
  61. PSAXAttributeData = ^TSAXAttributeData;
  62. TSAXAttributes = class
  63. protected
  64. FData: TFPList;
  65. function GetData(Index: Integer): PSAXAttributeData;
  66. property Data[Index:Integer]: PSAXAttributeData read GetData;
  67. procedure BadIndex(Index: Integer);
  68. public
  69. constructor Create; overload;
  70. constructor Create(Atts: TSAXAttributes); overload;
  71. destructor Destroy; override;
  72. function GetIndex(const QName: SAXString): Integer; overload;
  73. function GetIndex(const URI, LocalPart: SAXString): Integer; overload;
  74. function GetLength: Integer;
  75. function GetLocalName(Index: Integer): SAXString;
  76. function GetQName(Index: Integer): SAXString;
  77. function GetType(Index: Integer): String; overload;
  78. function GetType(const QName: SAXString): String; overload;
  79. function GetType(const URI, LocalName: SAXString): String; overload;
  80. function GetURI(Index: Integer): SAXString;
  81. function GetValue(Index: Integer): SAXString; overload;
  82. function GetValue(const QName: SAXString): SAXString; overload;
  83. function GetValue(const URI, LocalName: SAXString): SAXString; overload;
  84. // Manipulation methods:
  85. procedure Clear;
  86. procedure SetAttributes(Atts: TSAXAttributes);
  87. procedure AddAttribute(const AURI, ALocalName, AQName: SAXString;
  88. const AType: String; const AValue: SAXString);
  89. procedure SetAttribute(Index: Integer;
  90. const AURI, ALocalName, AQName: SAXString; const AType: String;
  91. const AValue: SAXString);
  92. procedure RemoveAttribute(Index: Integer);
  93. procedure SetURI(Index: Integer; const AURI: SAXString);
  94. procedure SetLocalName(Index: Integer; const ALocalName: SAXString);
  95. procedure SetQName(Index: Integer; const AQName: SAXString);
  96. procedure SetType(Index: Integer; const AType: String);
  97. procedure SetValue(Index: Integer; const AValue: SAXString);
  98. property Length: Integer read GetLength;
  99. property LocalNames[Index: Integer]: SAXString read GetLocalName;
  100. property QNames[Index: Integer]: SAXString read GetQName;
  101. property Types[Index: Integer]: String read GetType;
  102. property URIs[Index: Integer]: SAXString read GetURI;
  103. property Values[Index: Integer]: SAXString read GetValue;
  104. end;
  105. { TSAXReader: Reading an XML document using callbacks }
  106. TCharactersEvent = procedure(Sender: TObject; const ch: PSAXChar; AStart, ALength: Integer) of object;
  107. TCommentEvent = procedure(Sender: TObject; const ch: PSAXChar; AStart, ALength: Integer) of object;
  108. TEndElementEvent = procedure(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString) of object;
  109. TEndPrefixMappingEvent = procedure(Sender: TObject; const Prefix: SAXString) of object;
  110. TIgnorableWhitespaceEvent = procedure(Sender: TObject; const ch: PSAXChar; AStart, ALength: Integer) of object;
  111. TProcessingInstructionEvent = procedure(Sender: TObject; const Target, Data: SAXString) of object;
  112. TSkippedEntityEvent = procedure(Sender: TObject; const Name: SAXString) of object;
  113. TStartElementEvent = procedure(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString; Atts: TSAXAttributes) of object;
  114. TStartPrefixMappingEvent = procedure(Sender: TObject; const Prefix, URI: SAXString) of object;
  115. TNotationDeclEvent = procedure(Sender: TObject; const Name, PublicID, SystemID: SAXString) of object;
  116. TUnparsedEntityDeclEvent = procedure(Sender: TObject; const Name, PublicID, SystemID, NotationName: SAXString) of object;
  117. TResolveEntityEvent = function(Sender: TObject; const PublicID, SystemID: SAXString): TSAXInputSource of object;
  118. TErrorEvent = procedure(Sender: TObject; AException: ESAXParseException) of object;
  119. TFatalErrorEvent = procedure(Sender: TObject; AException: ESAXParseException) of object;
  120. TWarningEvent = procedure(Sender: TObject; AException: ESAXParseException) of object;
  121. TSAXReader = class
  122. private
  123. FOnCharacters: TCharactersEvent;
  124. FOnComment: TCommentEvent;
  125. FOnEndDocument: TNotifyEvent;
  126. FOnEndElement: TEndElementEvent;
  127. FOnEndPrefixMapping: TEndPrefixMappingEvent;
  128. FOnIgnorableWhitespace: TIgnorableWhitespaceEvent;
  129. FOnProcessingInstruction: TProcessingInstructionEvent;
  130. FOnSkippedEntity: TSkippedEntityEvent;
  131. FOnStartDocument: TNotifyEvent;
  132. FOnStartElement: TStartElementEvent;
  133. FOnStartPrefixMapping: TStartPrefixMappingEvent;
  134. FOnNotationDecl: TNotationDeclEvent;
  135. FOnUnparsedEntityDecl: TUnparsedEntityDeclEvent;
  136. FOnResolveEntity: TResolveEntityEvent;
  137. FOnError: TErrorEvent;
  138. FOnFatalError: TFatalErrorEvent;
  139. FOnWarning: TWarningEvent;
  140. protected
  141. FCurColumnNumber, FCurLineNumber: Integer;
  142. FCurPublicID, FCurSystemID: SAXString;
  143. FStopFlag: Boolean;
  144. function GetFeature(const Name: String): Boolean; virtual;
  145. function GetProperty(const Name: String): TObject; virtual;
  146. procedure SetFeature(const Name: String; Value: Boolean); virtual;
  147. procedure SetProperty(const Name: String; Value: TObject); virtual;
  148. // Notification of the content of a document
  149. procedure DoCharacters(const ch: PSAXChar; AStart, ALength: Integer); virtual;
  150. procedure DoComment(const ch: PSAXChar; AStart, ALength: Integer); virtual;
  151. procedure DoEndDocument; virtual;
  152. procedure DoEndElement(const NamespaceURI, LocalName, QName: SAXString); virtual;
  153. procedure DoEndPrefixMapping(const Prefix: SAXString); virtual;
  154. procedure DoIgnorableWhitespace(const ch: PSAXChar; AStart, ALength: Integer); virtual;
  155. procedure DoProcessingInstruction(const Target, Data: SAXString); virtual;
  156. procedure DoSkippedEntity(const Name: SAXString); virtual;
  157. procedure DoStartDocument; virtual;
  158. procedure DoStartElement(const NamespaceURI, LocalName, QName: SAXString; Atts: TSAXAttributes); virtual;
  159. procedure DoStartPrefixMapping(const Prefix, URI: SAXString); virtual;
  160. // Notification of basic DTD-related events
  161. procedure DoNotationDecl(const Name, PublicID, SystemID: SAXString); virtual;
  162. procedure DoUnparsedEntityDecl(const Name, PublicID,
  163. SystemID, NotationName: SAXString); virtual;
  164. // Resolving entities
  165. function DoResolveEntity(const PublicID,
  166. SystemID: SAXString): TSAXInputSource; virtual;
  167. // SAX error handlers
  168. procedure DoError(AException: ESAXParseException); virtual;
  169. procedure DoFatalError(AException: ESAXParseException); virtual;
  170. procedure DoWarning(AException: ESAXParseException); virtual;
  171. public
  172. procedure Parse(AInput: TSAXInputSource); virtual; abstract; overload;
  173. procedure Parse(const SystemID: SAXString); virtual; overload;
  174. procedure ParseStream(AStream: TStream);
  175. procedure Abort;
  176. // Current location
  177. property CurColumnNumber: Integer read FCurColumnNumber;
  178. property CurLineNumber: Integer read FCurLineNumber;
  179. property CurPublicID: SAXString read FCurPublicID;
  180. property CurSystemID: SAXString read FCurSystemID;
  181. property Features[const Name: String]: Boolean read GetFeature write SetFeature;
  182. property Properties[const Name: String]: TObject read GetProperty write SetProperty;
  183. // Content handler callbacks
  184. property OnCharacters: TCharactersEvent read FOnCharacters write FOnCharacters;
  185. property OnComment: TCommentEvent read FOnComment write FOnComment;
  186. property OnEndDocument: TNotifyEvent read FOnEndDocument write FOnEndDocument;
  187. property OnEndElement: TEndElementEvent read FOnEndElement write FOnEndElement;
  188. property OnEndPrefixMapping: TEndPrefixMappingEvent read FOnEndPrefixMapping write FOnEndPrefixMapping;
  189. property OnIgnorableWhitespace: TIgnorableWhitespaceEvent read FOnIgnorableWhitespace write FOnIgnorableWhitespace;
  190. property OnProcessingInstruction: TProcessingInstructionEvent read FOnProcessingInstruction write FOnProcessingInstruction;
  191. property OnSkippedEntity: TSkippedEntityEvent read FOnSkippedEntity write FOnSkippedEntity;
  192. property OnStartDocument: TNotifyEvent read FOnStartDocument write FOnStartDocument;
  193. property OnStartElement: TStartElementEvent read FOnStartElement write FOnStartElement;
  194. property OnStartPrefixMapping: TStartPrefixMappingEvent read FOnStartPrefixMapping write FOnStartPrefixMapping;
  195. // DTD handler callbacks
  196. property OnNotationDecl: TNotationDeclEvent read FOnNotationDecl write FOnNotationDecl;
  197. property OnUnparsedEntityDecl: TUnparsedEntityDeclEvent read FOnUnparsedEntityDecl write FOnUnparsedEntityDecl;
  198. // Entity resolver callbacks
  199. property OnResolveEntity: TResolveEntityEvent read FOnResolveEntity write FOnResolveEntity;
  200. // Error handler callbacks
  201. property OnError: TErrorEvent read FOnError write FOnError;
  202. property OnFatalError: TFatalErrorEvent read FOnFatalError write FOnFatalError;
  203. property OnWarning: TWarningEvent read FOnWarning write FOnWarning;
  204. end;
  205. { TSAXFilter: XML filter }
  206. TSAXFilter = class(TSAXReader)
  207. private
  208. FParent: TSAXReader;
  209. protected
  210. procedure DoCharacters(const ch: PSAXChar; AStart, ALength: Integer); override;
  211. procedure DoEndDocument; override;
  212. procedure DoEndElement(const NamespaceURI, LocalName, QName: SAXString); override;
  213. procedure DoEndPrefixMapping(const Prefix: SAXString); override;
  214. procedure DoIgnorableWhitespace(const ch: PSAXChar; AStart, ALength: Integer); override;
  215. procedure DoProcessingInstruction(const Target, Data: SAXString); override;
  216. procedure DoSkippedEntity(const Name: SAXString); override;
  217. procedure DoStartDocument; override;
  218. procedure DoStartElement(const NamespaceURI, LocalName, QName: SAXString; Atts: TSAXAttributes); override;
  219. procedure DoStartPrefixMapping(const Prefix, URI: SAXString); override;
  220. procedure DoNotationDecl(const Name, PublicID, SystemID: SAXString); override;
  221. procedure DoUnparsedEntityDecl(const Name, PublicID, SystemID, NotationName: SAXString); override;
  222. function DoResolveEntity(const PublicID, SystemID: SAXString): TSAXInputSource; override;
  223. procedure DoError(AException: ESAXParseException); override;
  224. procedure DoFatalError(AException: ESAXParseException); override;
  225. procedure DoWarning(AException: ESAXParseException); override;
  226. public
  227. property Parent: TSAXReader read FParent write FParent;
  228. end;
  229. // ===================================================================
  230. // ===================================================================
  231. implementation
  232. constructor ESAXAttributeIndexError.Create(Index: Integer);
  233. begin
  234. inherited CreateFmt(SSAXAttributeIndexError, [Index]);
  235. end;
  236. { TSAXInputSource }
  237. constructor TSAXInputSource.Create;
  238. begin
  239. inherited Create;
  240. end;
  241. constructor TSAXInputSource.Create(AStream: TStream);
  242. begin
  243. inherited Create;
  244. FStream := AStream;
  245. end;
  246. constructor TSAXInputSource.Create(const ASystemID: SAXString);
  247. begin
  248. inherited Create;
  249. FSystemID := ASystemID;
  250. end;
  251. { TSAXAttributes }
  252. constructor TSAXAttributes.Create;
  253. begin
  254. inherited Create;
  255. FData := TFPList.Create;
  256. end;
  257. constructor TSAXAttributes.Create(Atts: TSAXAttributes);
  258. begin
  259. inherited Create;
  260. FData := TFPList.Create;
  261. SetAttributes(Atts);
  262. end;
  263. destructor TSAXAttributes.Destroy;
  264. begin
  265. Clear;
  266. FData.Free;
  267. inherited Destroy;
  268. end;
  269. function TSAXAttributes.GetIndex(const QName: SAXString): Integer;
  270. begin
  271. Result := 0;
  272. while Result < FData.Count do
  273. begin
  274. if Data[Result]^.QName = QName then
  275. exit;
  276. Inc(Result);
  277. end;
  278. Result := -1;
  279. end;
  280. function TSAXAttributes.GetIndex(const URI, LocalPart: SAXString): Integer;
  281. begin
  282. Result := 0;
  283. while Result < FData.Count do
  284. begin
  285. if (Data[Result]^.URI = URI) and (Data[Result]^.LocalName = LocalPart) then
  286. exit;
  287. Inc(Result);
  288. end;
  289. Result := -1;
  290. end;
  291. function TSAXAttributes.GetLength: Integer;
  292. begin
  293. Result := FData.Count;
  294. end;
  295. function TSAXAttributes.GetLocalName(Index: Integer): SAXString;
  296. begin
  297. if (Index >= 0) and (Index < FData.Count) then
  298. Result := Data[Index]^.LocalName
  299. else
  300. SetLength(Result, 0);
  301. end;
  302. function TSAXAttributes.GetQName(Index: Integer): SAXString;
  303. begin
  304. if (Index >= 0) and (Index < FData.Count) then
  305. Result := Data[Index]^.QName
  306. else
  307. SetLength(Result, 0);
  308. end;
  309. function TSAXAttributes.GetType(Index: Integer): String;
  310. begin
  311. if (Index >= 0) and (Index < FData.Count) then
  312. Result := Data[Index]^.AttrType
  313. else
  314. SetLength(Result, 0);
  315. end;
  316. function TSAXAttributes.GetType(const QName: SAXString): String;
  317. var
  318. i: Integer;
  319. begin
  320. for i := 0 to FData.Count - 1 do
  321. if Data[i]^.QName = QName then
  322. begin
  323. Result := Data[i]^.AttrType;
  324. exit;
  325. end;
  326. SetLength(Result, 0);
  327. end;
  328. function TSAXAttributes.GetType(const URI, LocalName: SAXString): String;
  329. var
  330. i: Integer;
  331. begin
  332. for i := 0 to FData.Count - 1 do
  333. if (Data[i]^.URI = URI) and (Data[i]^.LocalName = LocalName) then
  334. begin
  335. Result := Data[i]^.AttrType;
  336. exit;
  337. end;
  338. SetLength(Result, 0);
  339. end;
  340. function TSAXAttributes.GetURI(Index: Integer): SAXString;
  341. begin
  342. if (Index >= 0) and (Index < FData.Count) then
  343. Result := Data[Index]^.URI
  344. else
  345. SetLength(Result, 0);
  346. end;
  347. function TSAXAttributes.GetValue(Index: Integer): SAXString;
  348. begin
  349. if (Index >= 0) and (Index < FData.Count) then
  350. Result := Data[Index]^.Value
  351. else
  352. SetLength(Result, 0);
  353. end;
  354. function TSAXAttributes.GetValue(const QName: SAXString): SAXString;
  355. var
  356. i: Integer;
  357. begin
  358. for i := 0 to FData.Count - 1 do
  359. if Data[i]^.QName = QName then
  360. begin
  361. Result := Data[i]^.Value;
  362. exit;
  363. end;
  364. SetLength(Result, 0);
  365. end;
  366. function TSAXAttributes.GetValue(const URI, LocalName: SAXString): SAXString;
  367. var
  368. i: Integer;
  369. begin
  370. for i := 0 to FData.Count - 1 do
  371. if (Data[i]^.URI = URI) and (Data[i]^.LocalName = LocalName) then
  372. begin
  373. Result := Data[i]^.Value;
  374. exit;
  375. end;
  376. SetLength(Result, 0);
  377. end;
  378. procedure TSAXAttributes.Clear;
  379. var
  380. i: Integer;
  381. begin
  382. for i := 0 to FData.Count - 1 do
  383. Dispose(PSAXAttributeData(FData[i]));
  384. end;
  385. procedure TSAXAttributes.SetAttributes(Atts: TSAXAttributes);
  386. var
  387. i: Integer;
  388. begin
  389. FData.Count := Atts.Length;
  390. for i := 0 to FData.Count - 1 do
  391. with Data[i]^ do
  392. begin
  393. URI := Atts.URIs[i];
  394. LocalName := Atts.LocalNames[i];
  395. QName := Atts.QNames[i];
  396. AttrType := Atts.Types[i];
  397. Value := Atts.Values[i];
  398. end;
  399. end;
  400. procedure TSAXAttributes.AddAttribute(const AURI, ALocalName, AQName: SAXString;
  401. const AType: String; const AValue: SAXString);
  402. var
  403. p: PSAXAttributeData;
  404. begin
  405. New(p);
  406. FData.Add(p);
  407. p^.URI := AURI;
  408. p^.LocalName := ALocalName;
  409. p^.QName := AQName;
  410. p^.AttrType := AType;
  411. p^.Value := AValue;
  412. end;
  413. procedure TSAXAttributes.SetAttribute(Index: Integer;
  414. const AURI, ALocalName, AQName: SAXString; const AType: String;
  415. const AValue: SAXString);
  416. begin
  417. if (Index >= 0) and (Index < FData.Count) then
  418. with Data[Index]^ do
  419. begin
  420. URI := AURI;
  421. LocalName := ALocalName;
  422. QName := AQName;
  423. AttrType := AType;
  424. Value := AValue;
  425. end
  426. else
  427. BadIndex(Index);
  428. end;
  429. procedure TSAXAttributes.RemoveAttribute(Index: Integer);
  430. begin
  431. if (Index >= 0) and (Index < FData.Count) then
  432. begin
  433. FData.Delete(Index);
  434. end else
  435. BadIndex(Index);
  436. end;
  437. procedure TSAXAttributes.SetURI(Index: Integer; const AURI: SAXString);
  438. begin
  439. if (Index >= 0) and (Index < FData.Count) then
  440. Data[Index]^.URI := AURI
  441. else
  442. BadIndex(Index);
  443. end;
  444. procedure TSAXAttributes.SetLocalName(Index: Integer;
  445. const ALocalName: SAXString);
  446. begin
  447. if (Index >= 0) and (Index < FData.Count) then
  448. Data[Index]^.LocalName := ALocalName
  449. else
  450. BadIndex(Index);
  451. end;
  452. procedure TSAXAttributes.SetQName(Index: Integer; const AQName: SAXString);
  453. begin
  454. if (Index >= 0) and (Index < FData.Count) then
  455. Data[Index]^.QName := AQName
  456. else
  457. BadIndex(Index);
  458. end;
  459. procedure TSAXAttributes.SetType(Index: Integer; const AType: String);
  460. begin
  461. if (Index >= 0) and (Index < FData.Count) then
  462. Data[Index]^.AttrType := AType
  463. else
  464. BadIndex(Index);
  465. end;
  466. procedure TSAXAttributes.SetValue(Index: Integer; const AValue: SAXString);
  467. begin
  468. if (Index >= 0) and (Index < FData.Count) then
  469. Data[Index]^.Value := AValue
  470. else
  471. BadIndex(Index);
  472. end;
  473. function TSAXAttributes.GetData(Index: Integer): PSAXAttributeData;
  474. begin
  475. Result := PSAXAttributeData(FData[Index]);
  476. end;
  477. procedure TSAXAttributes.BadIndex(Index: Integer);
  478. begin
  479. raise ESAXAttributeIndexError.Create(Index) at pointer(get_caller_addr(get_frame));
  480. end;
  481. { TSAXReader }
  482. procedure TSAXReader.Parse(const SystemID: SAXString);
  483. var
  484. Input: TSAXInputSource;
  485. begin
  486. Input := TSAXInputSource.Create(SystemID);
  487. try
  488. Input.Stream := TFileStream.Create(SystemID, fmOpenRead);
  489. try
  490. Parse(Input);
  491. finally
  492. Input.Stream.Free;
  493. end;
  494. finally
  495. Input.Free;
  496. end;
  497. end;
  498. procedure TSAXReader.ParseStream(AStream: TStream);
  499. var
  500. Input: TSAXInputSource;
  501. begin
  502. Input := TSAXInputSource.Create(AStream);
  503. try
  504. Parse(Input);
  505. finally
  506. Input.Free;
  507. end;
  508. end;
  509. procedure TSAXReader.Abort;
  510. begin
  511. FStopFlag := True;
  512. end;
  513. function TSAXReader.DoResolveEntity(const PublicID,
  514. SystemID: SAXString): TSAXInputSource;
  515. begin
  516. if Assigned(OnResolveEntity) then
  517. Result := OnResolveEntity(Self, PublicID, SystemID)
  518. else
  519. Result := nil;
  520. end;
  521. procedure TSAXReader.DoNotationDecl(const Name, PublicID, SystemID: SAXString);
  522. begin
  523. if Assigned(OnNotationDecl) then
  524. OnNotationDecl(Self, Name, PublicID, SystemID);
  525. end;
  526. procedure TSAXReader.DoUnparsedEntityDecl(const Name, PublicID,
  527. SystemID, NotationName: SAXString);
  528. begin
  529. if Assigned(OnUnparsedEntityDecl) then
  530. OnUnparsedEntityDecl(Self, Name, PublicID, SystemID, NotationName);
  531. end;
  532. function TSAXReader.GetFeature(const Name: String): Boolean;
  533. begin
  534. raise ESAXNotRecognizedException.CreateFmt(SSAXUnrecognizedFeature, [Name]);
  535. Result := False;
  536. end;
  537. function TSAXReader.GetProperty(const Name: String): TObject;
  538. begin
  539. raise ESAXNotRecognizedException.CreateFmt(SSAXUnrecognizedProperty, [Name]);
  540. Result := nil;
  541. end;
  542. procedure TSAXReader.SetFeature(const Name: String; Value: Boolean);
  543. begin
  544. raise ESAXNotRecognizedException.CreateFmt(SSAXUnrecognizedFeature, [Name]);
  545. end;
  546. procedure TSAXReader.SetProperty(const Name: String; Value: TObject);
  547. begin
  548. raise ESAXNotRecognizedException.CreateFmt(SSAXUnrecognizedProperty, [Name]);
  549. end;
  550. procedure TSAXReader.DoCharacters(const ch: PSAXChar;
  551. AStart, ALength: Integer);
  552. begin
  553. if Assigned(OnCharacters) then
  554. OnCharacters(Self, ch, AStart, ALength);
  555. end;
  556. procedure TSAXReader.DoComment(const ch: PSAXChar;
  557. AStart, ALength: Integer);
  558. begin
  559. if Assigned(OnComment) then
  560. OnComment(Self, ch, AStart, ALength);
  561. end;
  562. procedure TSAXReader.DoEndDocument;
  563. begin
  564. if Assigned(OnEndDocument) then
  565. OnEndDocument(Self);
  566. end;
  567. procedure TSAXReader.DoEndElement(const NamespaceURI,
  568. LocalName, QName: SAXString);
  569. begin
  570. if Assigned(OnEndElement) then
  571. OnEndElement(Self, NamespaceURI, LocalName, QName);
  572. end;
  573. procedure TSAXReader.DoEndPrefixMapping(const Prefix: SAXString);
  574. begin
  575. if Assigned(OnEndPrefixMapping) then
  576. OnEndPrefixMapping(Self, Prefix);
  577. end;
  578. procedure TSAXReader.DoIgnorableWhitespace(const ch: PSAXChar;
  579. AStart, ALength: Integer);
  580. begin
  581. if Assigned(OnIgnorableWhitespace) then
  582. OnIgnorableWhitespace(Self, ch, AStart, ALength);
  583. end;
  584. procedure TSAXReader.DoProcessingInstruction(const Target,
  585. Data: SAXString);
  586. begin
  587. if Assigned(OnProcessingInstruction) then
  588. OnProcessingInstruction(Self, Target, Data);
  589. end;
  590. procedure TSAXReader.DoSkippedEntity(const Name: SAXString);
  591. begin
  592. if Assigned(OnSkippedEntity) then
  593. OnSkippedEntity(Self, Name);
  594. end;
  595. procedure TSAXReader.DoStartDocument;
  596. begin
  597. if Assigned(OnStartDocument) then
  598. OnStartDocument(Self);
  599. end;
  600. procedure TSAXReader.DoStartElement(const NamespaceURI,
  601. LocalName, QName: SAXString; Atts: TSAXAttributes);
  602. begin
  603. if Assigned(OnStartElement) then
  604. OnStartElement(Self, NamespaceURI, LocalName, QName, Atts);
  605. end;
  606. procedure TSAXReader.DoStartPrefixMapping(const Prefix, URI: SAXString);
  607. begin
  608. if Assigned(OnStartPrefixMapping) then
  609. OnStartPrefixMapping(Self, Prefix, URI);
  610. end;
  611. procedure TSAXReader.DoError(AException: ESAXParseException);
  612. begin
  613. if Assigned(OnError) then
  614. OnError(Self, AException);
  615. AException.Free;
  616. end;
  617. procedure TSAXReader.DoFatalError(AException: ESAXParseException);
  618. begin
  619. if Assigned(OnFatalError) then
  620. OnFatalError(Self, AException)
  621. else
  622. raise AException;
  623. AException.Free;
  624. end;
  625. procedure TSAXReader.DoWarning(AException: ESAXParseException);
  626. begin
  627. if Assigned(OnWarning) then
  628. OnWarning(Self, AException);
  629. AException.Free;
  630. end;
  631. { TSAXFilter }
  632. function TSAXFilter.DoResolveEntity(const PublicID,
  633. SystemID: SAXString): TSAXInputSource;
  634. begin
  635. if Assigned(OnResolveEntity) then
  636. Result := OnResolveEntity(Self, PublicID, SystemID)
  637. else if Assigned(Parent) then
  638. Result := Parent.DoResolveEntity(PublicID, SystemID)
  639. else
  640. Result := nil;
  641. end;
  642. procedure TSAXFilter.DoNotationDecl(const Name, PublicID, SystemID: SAXString);
  643. begin
  644. if Assigned(OnNotationDecl) then
  645. OnNotationDecl(Self, Name, PublicID, SystemID)
  646. else if Assigned(Parent) then
  647. Parent.DoNotationDecl(Name, PublicID, SystemID);
  648. end;
  649. procedure TSAXFilter.DoUnparsedEntityDecl(const Name, PublicID,
  650. SystemID, NotationName: SAXString);
  651. begin
  652. if Assigned(OnUnparsedEntityDecl) then
  653. OnUnparsedEntityDecl(Self, Name, PublicID, SystemID, NotationName)
  654. else if Assigned(Parent) then
  655. Parent.DoUnparsedEntityDecl(Name, PublicID, SystemID, NotationName);
  656. end;
  657. procedure TSAXFilter.DoCharacters(const ch: PSAXChar;
  658. AStart, ALength: Integer);
  659. begin
  660. if Assigned(OnCharacters) then
  661. OnCharacters(Self, ch, AStart, ALength)
  662. else if Assigned(Parent) then
  663. Parent.DoCharacters(ch, AStart, ALength);
  664. end;
  665. procedure TSAXFilter.DoEndDocument;
  666. begin
  667. if Assigned(OnEndDocument) then
  668. OnEndDocument(Self)
  669. else if Assigned(Parent) then
  670. Parent.DoEndDocument;
  671. end;
  672. procedure TSAXFilter.DoEndElement(const NamespaceURI,
  673. LocalName, QName: SAXString);
  674. begin
  675. if Assigned(OnEndElement) then
  676. OnEndElement(Self, NamespaceURI, LocalName, QName)
  677. else if Assigned(Parent) then
  678. Parent.DoEndElement(NamespaceURI, LocalName, QName);
  679. end;
  680. procedure TSAXFilter.DoEndPrefixMapping(const Prefix: SAXString);
  681. begin
  682. if Assigned(OnEndPrefixMapping) then
  683. OnEndPrefixMapping(Self, Prefix)
  684. else if Assigned(Parent) then
  685. Parent.DoEndPrefixMapping(Prefix);
  686. end;
  687. procedure TSAXFilter.DoIgnorableWhitespace(const ch: PSAXChar;
  688. AStart, ALength: Integer);
  689. begin
  690. if Assigned(OnIgnorableWhitespace) then
  691. OnIgnorableWhitespace(Self, ch, AStart, ALength)
  692. else if Assigned(Parent) then
  693. Parent.DoIgnorableWhitespace(ch, AStart, ALength);
  694. end;
  695. procedure TSAXFilter.DoProcessingInstruction(const Target,
  696. Data: SAXString);
  697. begin
  698. if Assigned(OnProcessingInstruction) then
  699. OnProcessingInstruction(Self, Target, Data)
  700. else if Assigned(Parent) then
  701. Parent.DoProcessingInstruction(Target, Data);
  702. end;
  703. procedure TSAXFilter.DoSkippedEntity(const Name: SAXString);
  704. begin
  705. if Assigned(OnSkippedEntity) then
  706. OnSkippedEntity(Self, Name)
  707. else if Assigned(Parent) then
  708. Parent.DoSkippedEntity(Name);
  709. end;
  710. procedure TSAXFilter.DoStartDocument;
  711. begin
  712. if Assigned(OnStartDocument) then
  713. OnStartDocument(Self)
  714. else if Assigned(Parent) then
  715. Parent.DoStartDocument;
  716. end;
  717. procedure TSAXFilter.DoStartElement(const NamespaceURI,
  718. LocalName, QName: SAXString; Atts: TSAXAttributes);
  719. begin
  720. if Assigned(OnStartElement) then
  721. OnStartElement(Self, NamespaceURI, LocalName, QName, Atts)
  722. else if Assigned(Parent) then
  723. Parent.DoStartElement(NamespaceURI, LocalName, QName, Atts);
  724. end;
  725. procedure TSAXFilter.DoStartPrefixMapping(const Prefix, URI: SAXString);
  726. begin
  727. if Assigned(OnStartPrefixMapping) then
  728. OnStartPrefixMapping(Self, Prefix, URI)
  729. else if Assigned(Parent) then
  730. Parent.DoStartPrefixMapping(Prefix, URI);
  731. end;
  732. procedure TSAXFilter.DoError(AException: ESAXParseException);
  733. begin
  734. if Assigned(OnError) then
  735. OnError(Self, AException)
  736. else if Assigned(Parent) then
  737. Parent.DoError(AException);
  738. AException.Free;
  739. end;
  740. procedure TSAXFilter.DoFatalError(AException: ESAXParseException);
  741. begin
  742. if Assigned(OnFatalError) then
  743. OnFatalError(Self, AException)
  744. else if Assigned(Parent) then
  745. Parent.DoFatalError(AException)
  746. else
  747. raise AException;
  748. AException.Free;
  749. end;
  750. procedure TSAXFilter.DoWarning(AException: ESAXParseException);
  751. begin
  752. if Assigned(OnWarning) then
  753. OnWarning(Self, AException)
  754. else if Assigned(Parent) then
  755. Parent.DoWarning(AException);
  756. AException.Free;
  757. end;
  758. end.