whtml.pas 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687
  1. unit WHTML;
  2. interface
  3. {$ifndef FPC}
  4. {$define TPUNIXLF}
  5. {$endif}
  6. uses Objects;
  7. type
  8. PTextFile = ^TTextFile;
  9. TTextFile = object(TObject)
  10. function GetLine(Idx: sw_integer; var S: string): boolean; virtual;
  11. end;
  12. PDOSTextFile = ^TDOSTextFile;
  13. TDOSTextFile = object(TTextFile)
  14. constructor Init(AFileName: string);
  15. function GetLine(Idx: sw_integer; var S: string): boolean; virtual;
  16. destructor Done; virtual;
  17. private
  18. Lines : PUnsortedStrCollection;
  19. end;
  20. PSGMLParser = ^TSGMLParser;
  21. TSGMLParser = object(TObject)
  22. constructor Init;
  23. function Process(HTMLFile: PTextFile): boolean; virtual;
  24. function ProcessLine(LineText: string): boolean; virtual;
  25. destructor Done; virtual;
  26. public
  27. Line,LinePos: sw_integer;
  28. procedure DocSoftBreak; virtual;
  29. procedure DocAddTextChar(C: char); virtual;
  30. procedure DocAddText(S: string); virtual;
  31. procedure DocProcessTag(Tag: string); virtual;
  32. procedure DocProcessComment(Comment: string); virtual;
  33. function DocDecodeNamedEntity(Name: string; var Entity: string): boolean; virtual;
  34. private
  35. CurTag: string;
  36. InTag,InComment,InString: boolean;
  37. end;
  38. PHTMLParser = ^THTMLParser;
  39. THTMLParser = object(TSGMLParser)
  40. procedure DocSoftBreak; virtual;
  41. procedure DocAddTextChar(C: char); virtual;
  42. procedure DocProcessTag(Tag: string); virtual;
  43. function DocGetTagParam(Name: string; var Value: string): boolean; virtual;
  44. procedure DocProcessComment(Comment: string); virtual;
  45. function DocDecodeNamedEntity(Name: string; var E: string): boolean; virtual;
  46. public
  47. TagName,TagParams: string;
  48. procedure DocUnknownTag; virtual;
  49. procedure DocTYPE; virtual;
  50. procedure DocHTML(Entered: boolean); virtual;
  51. procedure DocHEAD(Entered: boolean); virtual;
  52. procedure DocMETA; virtual;
  53. procedure DocTITLE(Entered: boolean); virtual;
  54. procedure DocBODY(Entered: boolean); virtual;
  55. procedure DocAnchor(Entered: boolean); virtual;
  56. procedure DocHeading(Level: integer; Entered: boolean); virtual;
  57. procedure DocParagraph(Entered: boolean); virtual;
  58. procedure DocBreak; virtual;
  59. procedure DocImage; virtual;
  60. procedure DocBold(Entered: boolean); virtual;
  61. procedure DocCite(Entered: boolean); virtual;
  62. procedure DocCode(Entered: boolean); virtual;
  63. procedure DocEmphasized(Entered: boolean); virtual;
  64. procedure DocItalic(Entered: boolean); virtual;
  65. procedure DocKbd(Entered: boolean); virtual;
  66. procedure DocPreformatted(Entered: boolean); virtual;
  67. procedure DocSample(Entered: boolean); virtual;
  68. procedure DocStrong(Entered: boolean); virtual;
  69. procedure DocTeleType(Entered: boolean); virtual;
  70. procedure DocVariable(Entered: boolean); virtual;
  71. procedure DocList(Entered: boolean); virtual;
  72. procedure DocOrderedList(Entered: boolean); virtual;
  73. procedure DocListItem; virtual;
  74. procedure DocDefList(Entered: boolean); virtual;
  75. procedure DocDefTerm; virtual;
  76. procedure DocDefExp; virtual;
  77. procedure DocHorizontalRuler; virtual;
  78. end;
  79. implementation
  80. function UpcaseStr(S: string): string;
  81. var I: Longint;
  82. begin
  83. for I:=1 to length(S) do
  84. S[I]:=Upcase(S[I]);
  85. UpcaseStr:=S;
  86. end;
  87. function LowCase(C: char): char;
  88. begin
  89. if ('A'<=C) and (C<='Z') then C:=chr(ord(C)+32);
  90. LowCase:=C;
  91. end;
  92. function LowcaseStr(S: string): string;
  93. var I: Longint;
  94. begin
  95. for I:=1 to length(S) do
  96. S[I]:=Lowcase(S[I]);
  97. LowcaseStr:=S;
  98. end;
  99. function LTrim(S: string): string;
  100. begin
  101. while copy(S,1,1)=' ' do Delete(S,1,1);
  102. LTrim:=S;
  103. end;
  104. function RTrim(S: string): string;
  105. begin
  106. while copy(S,length(S),1)=' ' do Delete(S,length(S),1);
  107. RTrim:=S;
  108. end;
  109. function Trim(S: string): string;
  110. begin
  111. Trim:=RTrim(LTrim(S));
  112. end;
  113. function TTextFile.GetLine(Idx: sw_integer; var S: string): boolean;
  114. begin
  115. Abstract;
  116. GetLine:=false;
  117. end;
  118. constructor TDOSTextFile.Init(AFileName: string);
  119. {$ifdef TPUNIXLF}
  120. procedure readln(var t:text;var s:string);
  121. var
  122. c : char;
  123. i : longint;
  124. begin
  125. c:=#0;
  126. i:=0;
  127. while (not eof(t)) and (c<>#10) and (i<255) do
  128. begin
  129. read(t,c);
  130. if (i<255) and (c<>#10) then
  131. begin
  132. inc(i);
  133. s[i]:=c;
  134. end;
  135. end;
  136. if (i>0) and (s[i]=#13) then
  137. dec(i);
  138. s[0]:=chr(i);
  139. end;
  140. {$endif}
  141. var f: text;
  142. S: string;
  143. begin
  144. inherited Init;
  145. {$I-}
  146. Assign(f,AFileName);
  147. Reset(f);
  148. if IOResult<>0 then Fail;
  149. New(Lines, Init(500,2000));
  150. while (Eof(f)=false) and (IOResult=0) do
  151. begin
  152. readln(f,S);
  153. Lines^.Insert(NewStr(S));
  154. end;
  155. Close(f);
  156. {$I+}
  157. end;
  158. function TDOSTextFile.GetLine(Idx: sw_integer; var S: string): boolean;
  159. var OK: boolean;
  160. PS: PString;
  161. begin
  162. OK:=(Lines<>nil) and (Idx<Lines^.Count);
  163. if OK then
  164. begin
  165. PS:=Lines^.At(Idx);
  166. if PS=nil then S:='' else S:=PS^;
  167. end;
  168. GetLine:=OK;
  169. end;
  170. destructor TDOSTextFile.Done;
  171. begin
  172. inherited Done;
  173. if Lines<>nil then Dispose(Lines, Done); Lines:=nil;
  174. end;
  175. constructor TSGMLParser.Init;
  176. begin
  177. inherited Init;
  178. end;
  179. function TSGMLParser.Process(HTMLFile: PTextFile): boolean;
  180. var S: string;
  181. OK,LineOK: boolean;
  182. begin
  183. if HTMLFile=nil then Exit;
  184. InTag:=false; InComment:=false; InString:=false; CurTag:='';
  185. Line:=0; OK:=true;
  186. repeat
  187. LineOK:=HTMLFile^.GetLine(Line,S);
  188. if LineOK then
  189. begin
  190. OK:=ProcessLine(S);
  191. Inc(Line);
  192. end;
  193. until (LineOK=false) or (OK=false);
  194. Process:=OK;
  195. end;
  196. function TSGMLParser.ProcessLine(LineText: string): boolean;
  197. var OK: boolean;
  198. C: char;
  199. NewInString: boolean;
  200. OldInComment: boolean;
  201. WasThereAnyText: boolean;
  202. Pos2: integer;
  203. Name,Entity: string;
  204. LiteralCode: boolean;
  205. LiteralStart,LiteralEnd: integer;
  206. begin
  207. WasThereAnyText:=false;
  208. OK:=true; LinePos:=1;
  209. LiteralStart:=0; LiteralEnd:=0;
  210. while (LinePos<=length(LineText)) and OK do
  211. begin
  212. LiteralCode:=false;
  213. NewInString:=InString; OldInComment:=InComment;
  214. C:=LineText[LinePos];
  215. LiteralCode:=(LiteralStart<=LinePos) and (LinePos<=LiteralEnd);
  216. if (LiteralCode=false) and (C='&') then
  217. begin
  218. LiteralStart:=0; LiteralEnd:=0;
  219. Name:=''; Pos2:=LinePos+1;
  220. while (Pos2<=length(LineText)) and (LineText[Pos2]<>';') do
  221. begin
  222. Name:=Name+LineText[Pos2];
  223. Inc(Pos2);
  224. end;
  225. Inc(Pos2);
  226. if DocDecodeNamedEntity(Name,Entity) then
  227. begin
  228. LineText:=copy(LineText,1,LinePos-1)+Entity+copy(LineText,Pos2,255);
  229. LiteralStart:=LinePos; LiteralEnd:=LiteralStart+length(Entity)-1;
  230. C:=LineText[LinePos];
  231. end;
  232. end;
  233. LiteralCode:=(LiteralStart<=LinePos) and (LinePos<=LiteralEnd);
  234. if (LiteralCode=false) and (C='"') and (InTag=true) and (InString=false) then
  235. NewInString:=true;
  236. if (LiteralCode=false) and (C='<') and (InTag=false) then
  237. InTag:=true;
  238. if InTag then CurTag:=CurTag+C else
  239. begin
  240. DocAddTextChar(C);
  241. WasThereAnyText:=true;
  242. end;
  243. if (LiteralCode=false) and InTag and (InString=false) and (CurTag='<!--') then
  244. InComment:=true;
  245. if (LiteralCode=false) and InTag and InComment and (InString=false) and (length(CurTag)>=3) and
  246. (copy(CurTag,length(CurTag)-2,3)='-->') then
  247. InComment:=false;
  248. if (LiteralCode=false) and (C='"') and (InTag=true) and (InString=true) then
  249. NewInString:=false;
  250. if (LiteralCode=false) and (C='>') and (InTag=true) then
  251. begin
  252. InTag:=false;
  253. if OldInComment then
  254. DocProcessComment(CurTag)
  255. else
  256. DocProcessTag(CurTag);
  257. CurTag:='';
  258. end;
  259. InString:=NewInString;
  260. Inc(LinePos);
  261. end;
  262. if WasThereAnyText then DocSoftBreak;
  263. ProcessLine:=true;
  264. end;
  265. procedure TSGMLParser.DocSoftBreak;
  266. begin
  267. Abstract;
  268. end;
  269. procedure TSGMLParser.DocAddTextChar(C: char);
  270. begin
  271. Abstract;
  272. end;
  273. procedure TSGMLParser.DocAddText(S: string);
  274. var I: sw_integer;
  275. begin
  276. for I:=1 to length(S) do
  277. DocAddTextChar(S[I]);
  278. end;
  279. function TSGMLParser.DocDecodeNamedEntity(Name: string; var Entity: string): boolean;
  280. begin
  281. DocDecodeNamedEntity:=false;
  282. end;
  283. procedure TSGMLParser.DocProcessTag(Tag: string);
  284. begin
  285. Abstract;
  286. end;
  287. procedure TSGMLParser.DocProcessComment(Comment: string);
  288. begin
  289. Abstract;
  290. end;
  291. destructor TSGMLParser.Done;
  292. begin
  293. inherited Done;
  294. end;
  295. procedure THTMLParser.DocSoftBreak;
  296. begin
  297. end;
  298. procedure THTMLParser.DocAddTextChar(C: char);
  299. begin
  300. end;
  301. function THTMLParser.DocDecodeNamedEntity(Name: string; var E: string): boolean;
  302. var Found: boolean;
  303. Code: integer;
  304. CC: integer;
  305. begin
  306. Found:=true; Code:=-1;
  307. Name:=LowCaseStr(Name);
  308. if copy(Name,1,1)='#' then
  309. begin
  310. Val(copy(Name,2,255),Code,CC);
  311. if CC<>0 then Code:=-1;
  312. end;
  313. if (Name='lt') then E:='<' else { less-than sign }
  314. if (Name='gt') then E:='>' else { greater-than sign }
  315. if (Name='amp') then E:='&' else { ampersand }
  316. if (Name='quot') then E:='"' else { double quote sign }
  317. if (Code=160) or (Name='nbsp') then E:=#255 else { no-break space }
  318. if (Code=161) or (Name='iexcl') then E:='­' else { inverted excalamation mark }
  319. if (Code=162) or (Name='cent') then E:='›' else { cent sign }
  320. if (Code=163) or (Name='pound') then E:='œ' else { pound sterling sign }
  321. if (Code=164) or (Name='curren') then E:='$' else { general currency sign }
  322. if (Code=165) or (Name='yen') then E:='�' else { yen sign }
  323. if (Code=166) or (Name='brvbar') then E:='|' else { broken vertical bar }
  324. (* if (Code=167) or (Name='sect') then E:=#255 else { section sign }*)
  325. (* if (Code=168) or (Name='uml') then E:=#255 else { umlaut (dieresis) }*)
  326. if (Code=169) or (Name='copy') then E:='(C)' else { copyright sign }
  327. (* if (Code=170) or (Name='ordf') then E:=#255 else { ordinal indicator, feminine }*)
  328. if (Code=171) or (Name='laquo') then E:='"' else { angle quotation mark -left }
  329. if (Code=172) or (Name='not') then E:='!' else { not sign }
  330. if (Code=173) or (Name='shy') then E:='-' else { soft hypen }
  331. if (Code=174) or (Name='reg') then E:='(R)' else { registered sign }
  332. (* if (Code=175) or (Name='macr') then E:='?' else { macron }*)
  333. if (Code=176) or (Name='deg') then E:='ø' else { degree sign }
  334. if (Code=177) or (Name='plusmn') then E:='ñ' else { plus-or-minus sign }
  335. if (Code=178) or (Name='sup2') then E:='ý' else { superscript 2 }
  336. if (Code=179) or (Name='sup3') then E:='^3' else { superscript 3 }
  337. if (Code=180) or (Name='acute') then E:='''' else { acute accent }
  338. if (Code=181) or (Name='micro') then E:='æ' else { micro sign }
  339. (* if (Code=182) or (Name='para') then E:='?' else { paragraph sign }*)
  340. if (Code=183) or (Name='middot') then E:='ù' else { middle dot }
  341. (* if (Code=184) or (Name='cedil') then E:='?' else { cedilla }*)
  342. if (Code=185) or (Name='sup1') then E:='^1' else { superscript 1 }
  343. (* if (Code=186) or (Name='ordm') then E:='?' else { ordinal indicator, masculine }*)
  344. if (Code=187) or (Name='raquo') then E:='"' else { angle quoatation mark -right }
  345. if (Code=188) or (Name='frac14') then E:='¬' else { fraction one-quarter }
  346. if (Code=189) or (Name='frac12') then E:='«' else { fraction one-half }
  347. if (Code=190) or (Name='frac34') then E:='3/4' else { fraction three-quarters }
  348. if (Code=191) or (Name='iquest') then E:='¨' else { inverted question mark }
  349. if (Code=192) or (Name='Agrave') then E:='A' else { capital A, grave accent }
  350. if (Code=193) or (Name='Aacute') then E:='A' else { capital A, acute accent }
  351. if (Code=194) or (Name='Acirc') then E:='A' else { capital A, circumflex accent }
  352. if (Code=195) or (Name='Atilde') then E:='A' else { capital A, tilde accent }
  353. if (Code=196) or (Name='Auml') then E:='Ž' else { capital A, dieresis or umlaut }
  354. if (Code=197) or (Name='Aring') then E:='�' else { capital A, ring }
  355. if (Code=198) or (Name='AElig') then E:='AE' else { capital AE diphthong }
  356. (* if (Code=199) or (Name='Ccedil') then E:='?' else { capital C, cedilla }*)
  357. if (Code=200) or (Name='Egrave') then E:='�' else { capital E, grave accent }
  358. if (Code=201) or (Name='Eacute') then E:='�' else { capital E, acute accent }
  359. if (Code=202) or (Name='Ecirc') then E:='E' else { capital E, circumflex accent }
  360. if (Code=203) or (Name='Euml') then E:='E' else { capital E, dieresis or umlaut }
  361. if (Code=204) or (Name='Igrave') then E:='I' else { capital I, grave accent }
  362. if (Code=205) or (Name='Iacute') then E:='I' else { capital I, acute accent }
  363. if (Code=206) or (Name='Icirc') then E:='I' else { capital I, circumflex accent }
  364. if (Code=207) or (Name='Iuml') then E:='I' else { capital I, dieresis or umlaut }
  365. (* if (Code=208) or (Name='ETH') then E:='?' else { capital Eth, Icelandic }*)
  366. if (Code=209) or (Name='Ntidle') then E:='¥' else { capital N, tilde }
  367. if (Code=210) or (Name='Ograve') then E:='O' else { capital O, grave accent }
  368. if (Code=211) or (Name='Oacute') then E:='O' else { capital O, acute accent }
  369. if (Code=212) or (Name='Ocirc') then E:='O' else { capital O, circumflex accent }
  370. if (Code=213) or (Name='Otilde') then E:='O' else { capital O, tilde }
  371. if (Code=214) or (Name='Ouml') then E:='™' else { capital O, dieresis or umlaut }
  372. if (Code=215) or (Name='times') then E:='*' else { multiply sign }
  373. if (Code=216) or (Name='Oslash') then E:='O' else { capital O, slash }
  374. if (Code=217) or (Name='Ugrave') then E:='U' else { capital U, grave accent }
  375. if (Code=218) or (Name='Uacute') then E:='U' else { capital U, acute accent }
  376. if (Code=219) or (Name='Ucirc') then E:='U' else { capital U, circumflex accent }
  377. if (Code=220) or (Name='Uuml') then E:='š' else { capital U, dieresis or umlaut }
  378. if (Code=221) or (Name='Yacute') then E:='Y' else { capital Y, acute accent }
  379. (* if (Code=222) or (Name='THORN') then E:='?' else { capital THORN, Icelandic }*)
  380. if (Code=223) or (Name='szlig') then E:='á' else { small sharp S, German }
  381. if (Code=224) or (Name='agrave') then E:='…' else { small a, grave accent }
  382. if (Code=225) or (Name='aacute') then E:=' ' else { small a, acute accent }
  383. if (Code=226) or (Name='acirc') then E:='ƒ' else { small a, circumflex accent }
  384. if (Code=227) or (Name='atilde') then E:='ƒ' else { small a, tilde }
  385. if (Code=228) or (Name='auml') then E:='„' else { small a, dieresis or umlaut }
  386. if (Code=229) or (Name='aring') then E:='†' else { small a, ring }
  387. if (Code=230) or (Name='aelig') then E:='ae' else { small ae, diphthong }
  388. (* if (Code=231) or (Name='ccedil') then E:='?' else { small c, cedilla }*)
  389. if (Code=232) or (Name='egrave') then E:='Š' else { small e, grave accent }
  390. if (Code=233) or (Name='eacute') then E:='‚' else { small e, acute accent }
  391. if (Code=234) or (Name='ecirc') then E:='ˆ' else { small e, circumflex accent }
  392. if (Code=235) or (Name='euml') then E:='‰' else { small e, dieresis or umlaut }
  393. if (Code=236) or (Name='igrave') then E:='�' else { small i, grave accent }
  394. if (Code=237) or (Name='iacute') then E:='¡' else { small i, acute accent }
  395. if (Code=238) or (Name='icirc') then E:='Œ' else { small i, circumflex accent }
  396. if (Code=239) or (Name='iuml') then E:='‹' else { small i, dieresis or umlaut }
  397. (* if (Code=240) or (Name='eth') then E:='?' else { small eth, Icelandic }*)
  398. if (Code=241) or (Name='ntilde') then E:='¤' else { small n, tilde }
  399. if (Code=242) or (Name='ograve') then E:='•' else { small o, grave accent }
  400. if (Code=243) or (Name='oacute') then E:='¢' else { small o, acute accent }
  401. if (Code=244) or (Name='ocirc') then E:='“' else { small o, circumflex accent }
  402. if (Code=245) or (Name='otilde') then E:='“' else { small o, tilde }
  403. if (Code=246) or (Name='ouml') then E:='”' else { small o, dieresis or umlaut }
  404. if (Code=247) or (Name='divide') then E:='/' else { divide sign }
  405. if (Code=248) or (Name='oslash') then E:='"' else { small o, slash }
  406. if (Code=249) or (Name='ugrave') then E:='—' else { small u, grave accent }
  407. if (Code=250) or (Name='uacute') then E:='£' else { small u, acute accent }
  408. if (Code=251) or (Name='ucirc') then E:='–' else { small u, circumflex accent }
  409. if (Code=252) or (Name='uuml') then E:='�' else { small u, dieresis or umlaut }
  410. if (Code=253) or (Name='yacute') then E:='y' else { small y, acute accent }
  411. (* if (Code=254) or (Name='thorn') then E:='?' else { small thorn, Icelandic }*)
  412. if (Code=255) or (Name='yuml') then E:='y' else { small y, dieresis or umlaut }
  413. Found:=false;
  414. DocDecodeNamedEntity:=Found;
  415. end;
  416. procedure THTMLParser.DocProcessTag(Tag: string);
  417. var UTagName,ETagName: string[30];
  418. P: byte;
  419. NotEndTag: boolean;
  420. begin
  421. if copy(Tag,1,1)='<' then Delete(Tag,1,1);
  422. if copy(Tag,length(Tag),1)='>' then Delete(Tag,length(Tag),1);
  423. Tag:=Trim(Tag);
  424. P:=Pos(' ',Tag); if P=0 then P:=length(Tag)+1;
  425. TagName:=copy(Tag,1,P-1); TagParams:=copy(Tag,P+1,255);
  426. UTagName:=UpcaseStr(TagName);
  427. NotEndTag:=copy(TagName,1,1)<>'/';
  428. if NotEndTag then ETagName:=UTagName else ETagName:=copy(UTagName,2,255);
  429. if (UTagName='!DOCTYPE') then DocTYPE else
  430. { Section tags }
  431. if (ETagName='HTML') then DocHTML(NotEndTag) else
  432. if (ETagName='HEAD') then DocHEAD(NotEndTag) else
  433. if (ETagName='TITLE') then DocTITLE(NotEndTag) else
  434. if (ETagName='BODY') then DocBODY(NotEndTag) else
  435. { Anchor tags }
  436. if (ETagName='A') then DocAnchor(NotEndTag) else
  437. { Direct formatting directives }
  438. if (ETagName='H1') then DocHeading(1,NotEndTag) else
  439. if (ETagName='H2') then DocHeading(2,NotEndTag) else
  440. if (ETagName='H3') then DocHeading(3,NotEndTag) else
  441. if (ETagName='H4') then DocHeading(4,NotEndTag) else
  442. if (ETagName='H5') then DocHeading(5,NotEndTag) else
  443. if (ETagName='H6') then DocHeading(6,NotEndTag) else
  444. if (ETagName='P') then DocParagraph(NotEndTag) else
  445. if (ETagName='BR') then DocBreak else
  446. if (ETagName='B') then DocBold(NotEndTag) else
  447. if (ETagName='CITE') then DocCite(NotEndTag) else
  448. if (ETagName='CODE') then DocCode(NotEndTag) else
  449. if (ETagName='EM') then DocEmphasized(NotEndTag) else
  450. if (ETagName='I') then DocItalic(NotEndTag) else
  451. if (ETagName='KBD') then DocKbd(NotEndTag) else
  452. if (ETagName='PRE') then DocPreformatted(NotEndTag) else
  453. if (ETagName='SAMP') then DocSample(NotEndTag) else
  454. if (ETagName='STRONG') then DocStrong(NotEndTag) else
  455. if (ETagName='TT') then DocTeleType(NotEndTag) else
  456. if (ETagName='VAR') then DocVariable(NotEndTag) else
  457. { Unordered & ordered lists }
  458. if (ETagName='UL') then DocList(NotEndTag) else
  459. if (ETagName='OL') then DocOrderedList(NotEndTag) else
  460. if (UTagName='LI') then DocListItem else
  461. { Definition list }
  462. if (ETagName='DL') then DocDefList(NotEndTag) else
  463. if (UTagName='DT') then DocDefTerm else
  464. if (UTagName='DD') then DocDefExp else
  465. { Misc. tags }
  466. if (UTagName='META') then DocMETA else
  467. if (UTagName='IMG') then DocImage else
  468. if (UTagName='HR') then DocHorizontalRuler else
  469. DocUnknownTag;
  470. end;
  471. function THTMLParser.DocGetTagParam(Name: string; var Value: string): boolean;
  472. var Found: boolean;
  473. S: string;
  474. ParamName,ParamValue: string;
  475. InStr: boolean;
  476. I: sw_integer;
  477. begin
  478. Found:=false; Name:=UpcaseStr(Name);
  479. S:=TagParams;
  480. repeat
  481. InStr:=false;
  482. ParamName:=''; ParamValue:='';
  483. S:=Trim(S); I:=1;
  484. while (I<=length(S)) and (S[I]<>'=') do
  485. begin
  486. ParamName:=ParamName+S[I];
  487. Inc(I);
  488. end;
  489. ParamName:=Trim(ParamName);
  490. if S[I]='=' then
  491. begin
  492. Inc(I); InStr:=false;
  493. while (I<=length(S)) and (S[I]=' ') do
  494. Inc(I);
  495. if (I<=length(S)) and (S[I]='"') then
  496. begin
  497. InStr:=true;
  498. Inc(I);
  499. end;
  500. while (I<=length(S)) and ((InStr=true) or (S[I]<>' ')) do
  501. begin
  502. if S[I]='"' then
  503. begin
  504. InStr:=not InStr;
  505. if InStr=false then Break;
  506. end
  507. else
  508. ParamValue:=ParamValue+S[I];
  509. Inc(I);
  510. end;
  511. end;
  512. Found:=(Name=UpcaseStr(ParamName));
  513. if Found then Value:=ParamValue;
  514. Delete(S,1,I);
  515. until Found or (S='');
  516. DocGetTagParam:=Found;
  517. end;
  518. procedure THTMLParser.DocProcessComment(Comment: string);
  519. begin
  520. end;
  521. procedure THTMLParser.DocUnknownTag;
  522. begin
  523. end;
  524. procedure THTMLParser.DocTYPE;
  525. begin
  526. end;
  527. procedure THTMLParser.DocHTML(Entered: boolean);
  528. begin
  529. end;
  530. procedure THTMLParser.DocHEAD(Entered: boolean);
  531. begin
  532. end;
  533. procedure THTMLParser.DocMETA;
  534. begin
  535. end;
  536. procedure THTMLParser.DocTITLE(Entered: boolean);
  537. begin
  538. end;
  539. procedure THTMLParser.DocBODY(Entered: boolean);
  540. begin
  541. end;
  542. procedure THTMLParser.DocAnchor(Entered: boolean);
  543. begin
  544. end;
  545. procedure THTMLParser.DocHeading(Level: integer; Entered: boolean);
  546. begin
  547. end;
  548. procedure THTMLParser.DocParagraph(Entered: boolean);
  549. begin
  550. end;
  551. procedure THTMLParser.DocBreak;
  552. begin
  553. end;
  554. procedure THTMLParser.DocImage;
  555. begin
  556. end;
  557. procedure THTMLParser.DocBold(Entered: boolean);
  558. begin
  559. end;
  560. procedure THTMLParser.DocCite(Entered: boolean);
  561. begin
  562. end;
  563. procedure THTMLParser.DocCode(Entered: boolean);
  564. begin
  565. end;
  566. procedure THTMLParser.DocEmphasized(Entered: boolean);
  567. begin
  568. end;
  569. procedure THTMLParser.DocItalic(Entered: boolean);
  570. begin
  571. end;
  572. procedure THTMLParser.DocKbd(Entered: boolean);
  573. begin
  574. end;
  575. procedure THTMLParser.DocPreformatted(Entered: boolean);
  576. begin
  577. end;
  578. procedure THTMLParser.DocSample(Entered: boolean);
  579. begin
  580. end;
  581. procedure THTMLParser.DocStrong(Entered: boolean);
  582. begin
  583. end;
  584. procedure THTMLParser.DocTeleType(Entered: boolean);
  585. begin
  586. end;
  587. procedure THTMLParser.DocVariable(Entered: boolean);
  588. begin
  589. end;
  590. procedure THTMLParser.DocList(Entered: boolean);
  591. begin
  592. end;
  593. procedure THTMLParser.DocOrderedList(Entered: boolean);
  594. begin
  595. end;
  596. procedure THTMLParser.DocListItem;
  597. begin
  598. end;
  599. procedure THTMLParser.DocDefList(Entered: boolean);
  600. begin
  601. end;
  602. procedure THTMLParser.DocDefTerm;
  603. begin
  604. end;
  605. procedure THTMLParser.DocDefExp;
  606. begin
  607. end;
  608. procedure THTMLParser.DocHorizontalRuler;
  609. begin
  610. end;
  611. END.