sax.pp 27 KB

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