Шустрый
Профиль
Группа: Участник
Сообщений: 95
Регистрация: 12.1.2007
Где: Москва
Репутация: 6
Всего: 8
|
Мне тоже такое скоро понадобится, поэтому сделал  , немного черезчур, но работает: | Код |
unit HTMLCharsCls;
interface
uses SysUtils, Classes;
type
THTMLChar = record
Tag: string;
Char: WideChar;
end;
PHTMLCharArray = ^THTMLCharArray;
THTMLCharArray = array[0..MaxInt div SizeOf(THTMLChar) - 1] of THTMLChar;
THTMLChars = class
private
FCapacity: Integer;
FCount: Integer;
FList: PHTMLCharArray;
function GetChar(Index: Integer): WideChar;
function GetMap(const Tag: string): WideChar;
function GetTag(Index: Integer): string;
protected
function Add(const Tag: string; Char: WideChar): Integer;
procedure Clear;
procedure Delete(Index: Integer);
procedure Init;
public
constructor Create;
destructor Destroy; override;
function Find(const Tag: string; var Index: Integer): Boolean;
property Count: Integer read FCount;
property Map[const Tag: string]: WideChar read GetMap; default;
property Tags[Index: Integer]: string read GetTag;
property Chars[Index: Integer]: WideChar read GetChar;
end;
function ReplaceHTMLChars(const S: WideString): WideString;
var
HTMLChars: THTMLChars;
implementation
const
MaxTagLength = 15;
WideNull = WideChar(#0);
WideAmp = WideChar('&');
WideSep = WideChar(';');
function ReplaceHTMLChars(const S: WideString): WideString;
var
I, L: Integer;
Tag: WideString;
Ch: WideChar;
begin
Result := '';
I := 1;
L := 1;
while I <= Length(S) do
begin
if S[I] = WideAmp then
begin
if I > L then
begin
Result := Result + Copy(S, L, I - L);
L := I;
end;
Inc(I);
while (I <= Length(S)) and ((I - L) < MaxTagLength) do
begin
if S[I] = WideSep then
begin
Tag := Copy(S, L + 1, I - L - 1);
Ch := HTMLChars[Tag];
if Ch > #0 then
begin
Result := Result + Ch;
L := I + 1;
end;
Break;
end
else if S[I] = WideAmp then
begin
Dec(I);
Break;
end;
Inc(I);
end;
end;
Inc(I);
end;
if I > L then
Result := Result + Copy(S, L, I - L);
end;
{ THTMLChars }
constructor THTMLChars.Create;
begin
FList := nil;
FCapacity := 0;
FCount := 0;
Init;
end;
destructor THTMLChars.Destroy;
begin
FreeMem(FList);
FList := nil;
FCount := 0;
FCapacity := 0;
inherited;
end;
procedure THTMLChars.Init;
begin
Add('amp' , #38);
Add('gt' , #62);
Add('lt' , #60);
Add('quot' , #34);
Add('AElig' , #198);
Add('Aacute', #193);
Add('Acirc' , #194);
Add('Agrave', #192);
Add('Aring' , #197);
Add('Atilde', #195);
Add('Auml' , #196);
Add('Ccedil', #199);
Add('ETH' , #208);
Add('Eacute', #201);
Add('Ecirc' , #202);
Add('Egrave', #200);
Add('Euml' , #203);
Add('Iacute', #205);
Add('Icirc' , #206);
Add('Igrave', #204);
Add('Iuml' , #207);
Add('Ntilde', #209);
Add('Oacute', #211);
Add('Ocirc' , #212);
Add('Ograve', #210);
Add('Oslash', #216);
Add('Otilde', #213);
Add('Ouml' , #214);
Add('THORN' , #222);
Add('Uacute', #218);
Add('Ucirc' , #219);
Add('Ugrave', #217);
Add('Uuml' , #220);
Add('Yacute', #221);
Add('aacute', #225);
Add('acirc' , #226);
Add('acute' , #180);
Add('aelig' , #230);
Add('agrave', #224);
Add('aring' , #229);
Add('atilde', #227);
Add('auml' , #228);
Add('brvbar', #166);
Add('ccedil', #231);
Add('cedil' , #184);
Add('cent' , #162);
Add('copy' , #169);
Add('curren', #164);
Add('deg' , #176);
Add('divide', #247);
Add('eacute', #233);
Add('ecirc' , #234);
Add('egrave', #232);
Add('eth' , #240);
Add('euml' , #235);
Add('euro' , #8364);
Add('frac12', #189);
Add('frac14', #188);
Add('frac34', #190);
Add('iacute', #237);
Add('icirc' , #238);
Add('iexcl' , #161);
Add('igrave', #236);
Add('iquest', #191);
Add('iuml' , #239);
Add('macr' , #175);
Add('micro' , #181);
Add('middot', #183);
Add('not' , #172);
Add('ntilde', #241);
Add('oacute', #243);
Add('ocirc' , #244);
Add('ograve', #242);
Add('ordf' , #170);
Add('ordm' , #186);
Add('oslash', #248);
Add('otilde', #245);
Add('ouml' , #246);
Add('para' , #182);
Add('plusmn', #177);
Add('pound' , #163);
Add('reg' , #174);
Add('sect' , #167);
Add('shy' , #173);
Add('sup1' , #185);
Add('sup2' , #178);
Add('sup3' , #179);
Add('szlig' , #223);
Add('thorn' , #254);
Add('times' , #215);
Add('trade' , #8482);
Add('uacute', #250);
Add('ucirc' , #251);
Add('ugrave', #249);
Add('uml' , #168);
Add('uuml' , #252);
Add('yacute', #253);
Add('yen' , #165);
Add('yuml' , #255);
Add('bdquo' , #8222);
Add('bull' , #8226);
Add('emsp' , #8195);
Add('ensp' , #8194);
Add('laquo' , #171);
Add('ldquo' , #8220);
Add('lsaquo', #8249);
Add('lsquo' , #8216);
Add('mdash' , #8212);
Add('nbsp' , #160);
Add('ndash' , #8211);
Add('raquo' , #187);
Add('rdquo' , #8221);
Add('rsaquo', #8250);
Add('rsquo' , #8217);
Add('sbquo' , #8218);
end;
function THTMLChars.Add(const Tag: string; Char: WideChar): Integer;
begin
if Find(Tag, Result) then
Result := -1
else
begin
if FCount = FCapacity then
begin
Inc(FCapacity, 16);
ReallocMem(FList, FCapacity * SizeOf(THTMLChar));
end;
if Result < FCount then
Move(FList^[Result], FList^[Result + 1], (FCount - Result) * SizeOf(THTMLChar));
Pointer(FList^[Result].Tag) := nil;
FList^[Result].Char := Char;
FList^[Result].Tag := LowerCase(Tag);
Inc(FCount);
end;
end;
procedure THTMLChars.Clear;
begin
FreeMem(FList);
FList := nil;
FCount := 0;
FCapacity := 0;
end;
procedure THTMLChars.Delete(Index: Integer);
begin
Finalize(FList^[Index]);
Dec(FCount);
if Index < FCount then
Move(FList^[Index + 1], FList^[Index], (FCount - Index) * SizeOf(THTMLChar));
end;
function THTMLChars.Find(const Tag: string; var Index: Integer): Boolean;
var
L, H, I, C: Integer;
begin
Result := False;
L := 0;
H := FCount - 1;
while L <= H do
begin
I := (L + H) shr 1;
C := CompareText(FList^[I].Tag, Tag);
if C < 0 then
L := I + 1
else
begin
H := I - 1;
if C = 0 then
begin
Result := True;
L := I;
end;
end;
end;
Index := L;
end;
function THTMLChars.GetChar(Index: Integer): WideChar;
begin
Result := FList[Index].Char;
end;
function THTMLChars.GetMap(const Tag: string): WideChar;
var
Index: Integer;
begin
if Find(Tag, Index) then
Result := FList[Index].Char
else
Result := #0;
end;
function THTMLChars.GetTag(Index: Integer): string;
begin
Result := FList[Index].Tag;
end;
initialization
HTMLChars := THTMLChars.Create;
finalization
HTMLChars.Free;
end.
|
|
Парсер HTML-символов. Парсер html-спец-символов (не тегов!) 
Загрузка ...
