[Pascal/Delphi] HTML entfernen - Geschwindigkeitstest mit verschiedenen Funktionen

9. Mai 2018 - Lesezeit: 7 Minuten

(Entstammt aus einen Forenbeitrag unter Delphipraxis. Hier die Zusammenfassung:)

Da viele Leute auf diese Funktionen hier zurückgreifen, möchte ich noch ergänzen.

Unter dem Geschwindigkeitsaspekt habe ich gemessen:

dwStrips benötigte im Durchschnitt 77,6 ms
StripTags benötigte im Durchschnitt 56,3 ms
CleanHTMLTags benötigte im Durchschnitt 4,6 ms

Für kleinere Anwendungen oder wenigen Anrufen spielt es keine Rolle welche Funktion man nimmt. Möchte man aber größere Texte, öfters Texte durchlaufen lassen sollte man CleanHTMLTags nehmen. dwStrips zieht sich schnell in die Länge.

Funktionen

function CleanHtmlTags(Html:string):string;
var RegExpr:TRegExpr;
begin
  Result:='';
  RegExpr:=TRegExpr.Create;
  try
    RegExpr.ModifierG:=false;
    RegExpr.Expression:='<.*>';
    Result:=RegExpr.Replace(Html, ' ', false);
    Result:=trim(StringReplace(Result, ' ', ' ', [rfReplaceAll]));
  finally
    RegExpr.Free;
  end;
end;

function dwStripTags(AHTML: String): String;
var
TagBegin, TagEnd, TagLength: integer;
begin
TagBegin := Pos( '<', AHTML);
while (TagBegin > 0) do begin
TagEnd := Pos('>', AHTML);
TagLength := TagEnd - TagBegin + 1;
Delete(AHTML, TagBegin, TagLength);
TagBegin:= Pos( '<', AHTML);
end;
Result := AHTML;
end;

function StripTags( line: string; c1, c2: Char): string;
var
   p, p1, p2, pr, pt: PChar;
   res: string;
   Buf: string;
   i: Integer;
begin
   p:= PChar(line);
   SetLength( Buf, Length( line));
   while( p <> nil) and ( p <> '') do
   begin
      p1 := StrScan( p, c1);
      if p1 <> nil then
      begin
        p2 := StrScan( p1, c2);
        pt := StrScan( p1+1, c1);
        if pt <> Nil then
            if pt < p2 then //Weitere Tagöffnung vor Tagschliessung
            begin
              pr := PChar( Buf);
              StrLCopy( pr, p, p1-p);
              Res := Res + pr;
              p := p1;
              p1 := pt;
            end;
        if p2 <> Nil then
        begin
          pr := PChar( Buf);
          StrLCopy( pr, p, p1-p);
          Res := Res + pr;
          p := p2+1;
        end
        else
        begin
          Res := Res + p;
          p:= nil;
        end
      end
      else
      begin
        Res := Res + p;
        p:= nil;
      end;
   end;
   result := res;
end;