Медленный парсер HTML

← →
BorisMor © (2004-08-30 10:35) [0]

Требуется отделить текст от тегов. Написал простенький парсер, но как то все медленно работает.
Ищем <, затем > - это есть тег. Все что не входит между этими символами то текст.
Основная функция разбора:

// Находит в sIn символ sSep. То что справа оставляет в sIn, на выходе то что слева // Если sSep нет в sIn то sIn становится пустым, на выходе вся строка function ParseToken(var sIn :string; sSep:string):string; var s:string; i:integer; begin i:=Pos(sSep,sIn); if i=0 then begin result:=sIn; sIn:=""; exit; end else begin result := Copy(sIn,1,i-1); sIn :=Copy(sIn,i+Length(sSep),Length(sIn)); end; end;

Может посоветуете что побыстрей ?

← →
DiamondShark © (2004-08-30 10:47) [1]

mshtml

← →
Erik1 (2004-08-30 10:58) [2]

А ошибки ты вобще неучитываеш, что будет если у тебя 3 тега? Основной совет, неныделяй память заного! Даи функция у тебя маленькая, ее сложно оптимизировать. Я думя, что ее надо расматривать вместе с верхним циклом в котором вызывается эта функция.
Я еще лучще взять готовый парсер HTML и немучатся.

← →
Romkin © (2004-08-30 11:19) [3]

НАвскидку:

type TAuState = (ausInLine, ausInTag); function RemoveTags(const S: string): string; var AState: TAuState; i, k: integer; begin SetLength(Result, length(S)); if S = "" then exit; AState := ausInLine; k := 0; for i := 1 to length(S) do case AState of ausInLine: begin if S[i] <> "<" then begin inc(k); Result[k] := S[i]; end else AState := ausInTag; end; ausInTag: begin if S[i] := ">" then AState := ausInLine; end; end; //case SetLength(Result, k); end;
Вроде работать должно ;)

← →
GuAV © (2004-08-30 11:29) [4]

> Result[k] := S[i];

Это будет тормозить, т.к. там UniqueString будет.
Если [3] работает, то то что в for переписать на asm-е или хотя бы PChar юзануть.

← →
Romkin © (2004-08-30 11:33) [5]

Будет, но не слишком :)) Как войдет - так и выйдет.
Что, переписать на TMemoryStream? :)

← →
nicesc (2004-08-31 12:01) [6]

Romkin
При большом объеме будешь доолго ждать

GuAV
Полностью согласен

← →
Romkin © (2004-08-31 12:14) [7]

nicesc (31.08.04 12:01) [6] Долго? Эт сколько? И при каком объеме? Поконкретнее, плиз

Ладно, уговорили. Для боольших объемов:
type TAuState = (ausInLine, ausInTag); function RemoveTags(const S: string): string; var AState: TAuState; i, k: integer; Stream: TStream; begin Result := ""; if S = "" then exit; Stream := TMemoryStream.Create; try Stream.Size := Length(S); Stream.Position := 0; AState := ausInLine; k := 0; for i := 1 to Length(S) do case AState of ausInLine: begin if S[i] <> "<" then begin inc(k); Stream.Write(S[i],1); end else AState := ausInTag; end; ausInTag: begin if S[i] := ">" then AState := ausInLine; end; end; //case SetLength(Result, k); Stream.Position := 0; Stream.Read(Result[1], Length(Result)); finally Stream.Free; end; end;

Но скорость и первого варианта также вполне достаточна для большинства случаев ;)

← →
GuAV © (2004-08-31 12:18) [8]

> Что, переписать на TMemoryStream? :)

Да нет, я же сказал на asm :)

← →
Romkin © (2004-08-31 12:21) [9]

Впрочем, пройдет вроде и такое:
type TAuState = (ausInLine, ausInTag); function RemoveTags(const S: string): string; var AState: TAuState; i, k: integer; begin SetLength(Result, length(S)); if S = "" then exit; AState := ausInLine; k := 0; for i := 1 to length(S) do case AState of ausInLine: begin if S[i] <> "<" then begin PByte(pointer(Result) + k)^ := byte(S[i]); inc(k); end else AState := ausInTag; end; ausInTag: begin if S[i] := ">" then AState := ausInLine; end; end; //case SetLength(Result, k); end;

Но опять же: не люблю указатели, аккуратственнее надо :))

← →
Romkin © (2004-08-31 12:25) [10]

GuAV © (31.08.04 12:18) [8] Перепиши и сравни, много ли выиграешь? Несколько процентов? А надо ли? Чем понятнее программа, тем лучше.
Попробуй, разберись, что тут делается:
http://delphibase.endimus.ru/?action=viewfunc&topic=strsearch&id=10271
:))

> http://delphibase.endimus.ru/?action=viewfunc&topic=strsearch&id=10271
> :))

Вобщем то понятно ошибок не вижу. Сам подобное писал.
Я бы не извращался с LODSB и ESI.

А запутать на ООП можно лудше чем на asm, на то оно и ООП :->

> Я бы не извращался с LODSB и ESI.

Виноват, это когда до REPE CMPSB не дошел.

procedure ThousandAsm(var P: string);
asm
PUSH ESI
MOV ESI, EAX
MOV EAX, [EAX]
CALL System.@LStrLen
CMP EAX, 3
JLE @@1

PUSH EDI
MOV EDI, EAX

MOV ECX, 3
XOR EDX, EDX
DEC EAX
DIV ECX

PUSH EAX

MOV EDX, EDI
ADD EDX, EAX

MOV EAX, ESI
CALL System.@LStrSetLength

ADD EDI, [ESI]
POP ECX

DEC EDI // Предопследний
@@0: SUB EDI, 3 // На три символа к началу
MOV EDX, [EDI].DWord // Взять четыре символа
MOV DL, ThousandSeparator // Первый заменить пробелом
MOV [EDI+ECX].DWord, EDX // И вернуть на ECX выше
DEC ECX
JNZ @@0
POP EDI
@@1:
POP ESI
end;

// отделяет части числа пробелами
// для значений до 1 млрд быстрее FloatToStrF

function Thousand(Int: Int64): string;
begin
Result:=IntToStr(Int);
ThousandAsm(Result);
end;

Зачем придумывать лишнее? Я бы рекомендовал то же что и Erik1 (30.08.04 10:58) [2]
Если нужно писать самостоятельно то посмотри либо:
RegExp - модуль для работы с регулярными выражениями
Либо есть модуль с большим кол-вом функций для парсинга написанный (c) Alex Konshin mailto:alexk@mtgroup.ru
http://www.mtgroup.ru/~alexk/
И то и другое превзойти по скорости и безглючности поверьте сложно.

Меня так же интересует эта тема. Мне в отличии от автора требуется сделать XML прасер или использовать готовый. Сейчас использую LibXmlParser с www.destructor.de.

Однако надеюсь, если будет время написать свой.

[14] atruhin © (31.08.04 13:16)

Ничего связанного с разбором не нашел. :( Хотя сайт очень понравился. Жалко что ничего из расположенного там не компилируется под delphi 7. Очень мне интересен его хитрый грид, на выходных попробую подправить исходники.

PS от мелкомягких парсилку заюзать не могу т.к. проект CLXный.

Медленный парсер HTML Найти похожие ветки