Html Parse işleminde Uygulama donuyor

[hakanharbeli]

Kod: Tümünü seç

function htmld(S: string): string;
var
  TagBegin, TagEnd, TagLength: integer;
begin
  TagBegin := Pos( '<', S);

  while (TagBegin > 0) do begin
    TagEnd := Pos('>', S);
    TagLength := TagEnd - TagBegin + 1;
    Delete(S, TagBegin, TagLength);
    TagBegin:= Pos( '<', S);
  end;

  Result := S;
end;

merhaba bu fonksiyonla html tag'leri memo'dan siliyorum fakat memo'daki satır sayısı çok fazla olunca uygulama donuyor bunun için ne yapabilirim? ne yaptıysam bir türlü çözemedim

[Lord_Ares]

Application.progresmessage satırını ekle. Tam ne yapmak istediğinizi bilmiyorum ama Html parse ile ilgili daha basit yöntemler paylaşıldı dilersen onlara göz atabilir, tag temizlemekten kurtulabilirsin.

[hakanharbeli]

hocam onu denedim fakat yanıt vermiyor sorununu aşamadım sanırım thread oluşturmalıyım yukardaki fonksiyon şu şekilde çalışıyor.

Kod: Tümünü seç

var
s:string;
begin
memo1.text:=htmld(s);
end;

bu buton click olayında program yanıt vermiyor memodaki kelime sayısı az olunca sorun olmuyor. buraya nasıl thread oluşturabilirm?

[ertank]

Merhaba,

Bahsettiğiniz uygulamayı donduran HTML bilgisini bir dosya olarak paylaşmanız mümkün müdür?

[hakanharbeli]

Çözdüm arkadaşlar bu daha sağlıklı bir fonksiyon

Kod: Tümünü seç

function StripHtmlMarkup(const source:string):string;
var i, count: Integer;
    InTag: Boolean;
    P: PChar;
begin
  SetLength(Result, Length(source));
  P := PChar(Result);
  InTag := False;
  count := 0;
  for i:=1 to Length(source) do
    if InTag then
      begin
        if source[i] = '>' then InTag := False;
      end
    else
      if source[i] = '<' then InTag := True
      else
        begin
          P[count] := source[i];
          Inc(count);
        end;
  SetLength(Result, count);
end;