sax.pp 26 KB

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