Delphi-PRAXiS - Delphi HTML Tags entfernen

Seite 3 von 3

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)

- Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)

- - Delphi HTML Tags entfernen (https://www.delphipraxis.net/106763-html-tags-entfernen.html)

Re: HTML Tags entfernen

ok danke...
das es aus java kommt wusste ich bis jetzt noch nicht... ich werd mal mein bestes geben und mal suchen...

Re: HTML Tags entfernen

Zitat:

Zitat von omata

Hier auch nochmal ein Vorschlag mit regulären Ausdrücken...

Delphi-Quellcode:

			function CleanHtmlTags(Html:string):string;

var RegExpr:TRegExpr;

begin

  Result:='';

  RegExpr:=TRegExpr.Create;

  try

    RegExpr.ModifierG:=false;

    RegExpr.Expression:='<body>(.*)</body>';

    if RegExpr.Exec(Html) then begin

      Html:=RegExpr.Match[0];

      RegExpr.Expression:='<.*>';

      Result:=RegExpr.Replace(Html, ' ', false);

      Result:=trim(StringReplace(Result, '  ', ' ', [rfReplaceAll]));

    end;

  finally

    RegExpr.Free;

  end;

end;

RegExpr

Gruss
Thorsten

Durch das "gierige Verhalten" von RegExp würde das aber alles vom ersten bis zum letzten Tag löschen...

Re: HTML Tags entfernen

Zitat:

Zitat von NamenLozer

Durch das "gierige Verhalten" von RegExp würde das aber alles vom ersten bis zum letzten Tag löschen...

Hast du das getestet?

Dafür hatte ich eigentlich...

Delphi-Quellcode:

RegExpr.ModifierG:=false;

eingefügt.

Re: HTML Tags entfernen

Ok, darauf hab ich nicht geachtet. Ich kenn die Komponente nicht, aber RegExp von PHP...

Re: HTML Tags entfernen

zur der lösung mit ner regex...
man sollte noch drauf achten, dass <...> auch in einem string vorkommen kann der dann ignoriert werden sollte.
z.B. in sowas

XML-Code:

[img]image.jpg[/img] tag">

Code:

<.*>

würde hier fehlerhaft funktionieren.
ich würde das dann etwas erweitern. so ausm kopf in diese richtung:

Code:

<(.*)(".*")*>

sollte zwar nicht oft vorkommen, aber möglich ist es halt.

Re: HTML Tags entfernen

Zitat:

Zitat von NamenLozer

Ok, darauf hab ich nicht geachtet. Ich kenn die Komponente nicht, aber RegExp von PHP...

Auch in PHP kann man das gierige Verhalten unterbinden.

Re: HTML Tags entfernen

Da ich grad selbst an dem Problem hing und auch die bereits erwähnte Zugriffsverletzung bekam, hier mal eine einfachere und funktionierende, dafür geringfügig weniger performante Lösung:

Code:

			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;

AW: HTML Tags entfernen

Hi Leute,

ich weiß der Thread ist etwas älter. Aber 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.

Bei CleanHTMLTags habe ich eine kleine Änderung vorgenommen und sieht so aus:

Delphi-Quellcode:

			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;

Das Ergebnis sah bei allen Funktionen gleich aus, wobei ich hier keinen genauen vergleich gemacht habe.

LG
Monday

AW: HTML Tags entfernen

Ja, auch ich muss dem alten Thread noch eine Ergänzung beisteuern.

Die Funktion ReplaceHTMLChar (in Beitrag #3 zu sehen), kann in eine Endlosschleife laufen und endet dann mit OutOfMemory.

Das passiert bei fehlerhaften Tags im Eingangsstring.

Beispiel: 'Dies ist ein Test &nbsp: &nbsp und so weiter.'

Das Problem kann einfach gelöst werden, wenn die unter IF noch einen ELSE-Zweig erhält.

Hier die korrigierte Version:

Delphi-Quellcode:

			  function ReplaceHTMLChar(sValue: string): string;

  var

    tagStartPos                 : Integer;

    tagEndPos                   : Integer;

    tag, newTag                 : string;

    temp                        : string;

  begin

    tagStartPos := Pos('&', sValue);

    tagEndPos := PosEx(';', sValue, tagStartPos);

    if (tagEndPos > 0) AND ((tagEndPos - tagStartPos) < 8) then

      begin

        tag := copy(sValue, tagStartPos, tagEndPos - tagStartPos + 1);

        newTag := GiveSZ(tag);

        temp := copy(sValue, 1, tagStartPos - 1) + newTag +

          copy(sValue, tagEndPos + 1, length(sValue) - tagEndPos);

        sValue := temp;

        tagEndPos := tagEndPos - length(tag) + length(newTag);

        while (PosEx('&', sValue, tagEndPos) <> 0) and

          (PosEx(';', sValue, tagEndPos) <> 0) do

          begin

            tagStartPos := PosEx('&', sValue, tagEndPos);

            tagEndPos := PosEx(';', sValue, tagStartPos);

            if tagEndPos - tagStartPos < 8 then

            begin

              tag := copy(sValue, tagStartPos, tagEndPos - tagStartPos + 1);

              newTag := GiveSZ(tag);

              temp := copy(sValue, 1, tagStartPos - 1) + newTag +

                copy(sValue, tagEndPos + 1, length(sValue) - tagEndPos);

              sValue := temp;

              tagEndPos := tagEndPos - length(tag) + length(newTag);

            end

            ELSE

              tagEndPos:=tagStartPos+1;

          end;

      end;

    Result := sValue;

  end;

Sehe gerade, dass ich oben, in der ersten IF, schon mal ein "tagEndPos > 0" einfügte. ;-)

AW: Re: HTML Tags entfernen

Die Funktion ReplaceHTMLChar machte noch immer Probleme bei nicht abgeschlossenem Tag oder wenn einfach mal so ein "&" vorkam.

Habe das nun komplett neu durchdacht:

Delphi-Quellcode:

			  function ReplaceHTMLChar(sValue: string): string;

  var

    tagStartPos, tagNxtStartPos : Integer;

    tagEndPos                   : Integer;

    tag, newTag                 : string;

    Found                       : BOOLEAN;

  begin

    tagEndPos:=1;

    Result:=sValue;

    TRY

      REPEAT

        Found:=FALSE;

        tagStartPos:=PosEx('&', Result, tagEndPos);

        if tagStartPos > 0 then

        BEGIN

          tagEndPos:=PosEx(';', Result, tagStartPos);

          Found:=(tagEndPos > tagStartPos);

          if Found then

          BEGIN

            tagNxtStartPos:=tagStartPos;

            REPEAT                                                               // Gibts vielleicht noch ein Start- vor dem Ende-Zeichen?

              tagNxtStartPos:=PosEx('&', Result, tagNxtStartPos+1);

              if (tagNxtStartPos > 0) AND (tagNxtStartPos < tagEndPos) then

                tagStartPos:=tagNxtStartPos;

            UNTIL (tagNxtStartPos = 0) OR (tagNxtStartPos > tagEndPos);

            if (tagEndPos - tagStartPos < 8) then

            BEGIN

              tag:=copy(Result, tagStartPos, tagEndPos - tagStartPos + 1);

              newTag:=GiveSZ(tag);

              Result:=copy(Result, 1, tagStartPos - 1) + newTag +

                      copy(Result, tagEndPos + 1, length(Result) - tagEndPos);

              tagEndPos:=tagEndPos - length(tag) + length(newTag);

            END

            ELSE

              tagEndPos:=tagStartPos+1;

          END;

        END;

      UNTIL Not Found;

    EXCEPT

      Result:=sValue;                  // Wenn doch was unvorhergesehenes passiert, dann lieber ungewandelt zurück!

    END;

Bitte Melden, wenn auch damit Probleme entstehen sollten.

Seite 3 von 3