HTML Tags entfernen

[knolli]

Hi!

Ich melde mich nun schon wieder mit einem euene Problem.
Mir geht es darum, alle HTML-Tags zu entfernen, damit ich nur noch z.B.: Linkbeschriftungen oder den auf der Seite sichtbaren Text habe und diesen bearbeiten kann. Wer kann mir sagen, wie das funktionieren könnte? Wohlgemerkt es soll alles mit delphi passieren^^.

Ich freue mich schon auf eure Hilfe und hoffe das ich mir auch selbst eine Antwort geben kann!

[DeddyH]

Ein Anfang wäre, alle < zu ermitteln und von deren Position bis zum folgenden > alles zu löschen.

[tr909]

Hatte gerade das gleiche Problem und habe nu provisorisch erst mal folgendes gebastelt und zusammengesucht

Delphi-Quellcode:

function GiveSZ(HCode: string): Char;
var
  i                           : Integer;
begin
  Result := ' ';
  if (HCode = '"') or (HCode = '"') then Result := '"';
  if (HCode = '&') or (HCode = '&') then Result := '&';
  if (HCode = '&lt;') or (HCode = '<') then Result := '<';
  if (HCode = '&gt;') or (HCode = '>') then Result := '>';
  // ISO 160 bis ISO 255 Codes
  if (HCode = '') or (HCode = ' ') then Result := ' ';
  if (HCode = '&iexl;') or (HCode = '¡') then Result := '¡';
  if (HCode = '&cent;') or (HCode = '¢') then Result := '¢';
  if (HCode = '&pound;') or (HCode = '£') then Result := '£';
  if (HCode = '&curren;') or (HCode = '¤') then Result := '¤';
  if (HCode = '&yen;') or (HCode = '¥') then Result := '¥';
  if (HCode = '&brkbar;') or (HCode = '¦') then Result := '¦';
  if (HCode = '&sect;') or (HCode = '§') then Result := '§';
  if (HCode = '&uml;') or (HCode = '¨') then Result := '¨';
  if (HCode = '&copy;') or (HCode = '©') then Result := '©';
  if (HCode = '&ordf;') or (HCode = 'ª') then Result := 'ª';
  if (HCode = '&laquo;') or (HCode = '«') then Result := '«';
  if (HCode = '&not;') or (HCode = '¬') then Result := '¬';
  if (HCode = '&shy;') or (HCode = '*') then Result := '*';
  if (HCode = '&reg;') or (HCode = '®') then Result := '®';
  if (HCode = '&hibar;') or (HCode = '¯') then Result := '¯';
  if (HCode = '&deg;') or (HCode = '°') then Result := '°';
  if (HCode = '&plusmn;') or (HCode = '±') then Result := '±';
  if (HCode = '&sup2;') or (HCode = '²') then Result := '²';
  if (HCode = '&sup3;') or (HCode = '³') then Result := '³';
  if (HCode = '&acute;') or (HCode = '´') then Result := '´';
  if (HCode = '&micro;') or (HCode = 'µ') then Result := 'µ';
  if (HCode = '&para;') or (HCode = '¶') then Result := '¶';
  if (HCode = '&middot;') or (HCode = '·') then Result := '·';
  if (HCode = '&cedil;') or (HCode = '¸') then Result := '¸';
  if (HCode = '&sup1;') or (HCode = '¹') then Result := '¹';
  if (HCode = '&ordm;') or (HCode = 'º') then Result := 'º';
  if (HCode = '&raquo;') or (HCode = '»') then Result := '»';
  if (HCode = '&frac14;') or (HCode = '¼') then Result := '¼';
  if (HCode = '&frac12;') or (HCode = '½') then Result := '½';
  if (HCode = '&frac34;') or (HCode = '¾') then Result := '¾';
  if (HCode = '&iquest;') or (HCode = '¿') then Result := '¿';
  if (HCode = '&Agrave;') or (HCode = 'À') then Result := 'À';
  if (HCode = '&Aacute;') or (HCode = 'Á') then Result := 'Á';
  if (HCode = '&Acirc;') or (HCode = 'Â') then Result := 'Â';
  if (HCode = '&Atilde;') or (HCode = 'Ã') then Result := 'Ã';
  if (HCode = '&Auml;') or (HCode = 'Ä') then Result := 'Ä';
  if (HCode = '&Aring;') or (HCode = 'Å') then Result := 'Å';
  if (HCode = '&AEling;') or (HCode = 'Æ') then Result := 'Æ';
  if (HCode = '&Ccedil;') or (HCode = 'Ç') then Result := 'Ç';
  if (HCode = '&Egrave;') or (HCode = 'È') then Result := 'È';
  if (HCode = '&Eacute;') or (HCode = 'É') then Result := 'É';
  if (HCode = '&Ecirce;') or (HCode = 'Ê') then Result := 'Ê';
  if (HCode = '&Euml;') or (HCode = 'Ë') then Result := 'Ë';
  if (HCode = '&Igrave;') or (HCode = 'Ì') then Result := 'Ì';
  if (HCode = '&Iacute;') or (HCode = 'Í') then Result := 'Í';
  if (HCode = '&Icirce;') or (HCode = 'Î') then Result := 'Î';
  if (HCode = '&Iuml;') or (HCode = 'Ï') then Result := 'Ï';
  if (HCode = '&ETH;') or (HCode = 'Ð') then Result := 'Ð';
  if (HCode = '&Ntilde;') or (HCode = 'Ñ') then Result := 'Ñ';
  if (HCode = '&Ograve;') or (HCode = 'Ò') then Result := 'Ò';
  if (HCode = '&Oacute;') or (HCode = 'Ó') then Result := 'Ó';
  if (HCode = '&Ocirc;') or (HCode = 'Ô') then Result := 'Ô';
  if (HCode = '&Otilde;') or (HCode = 'Õ') then Result := 'Õ';
  if (HCode = '&Ouml;') or (HCode = 'Ö') then Result := 'Ö';
  if (HCode = '&times;') or (HCode = '×') then Result := '×';
  if (HCode = '&Oslash;') or (HCode = 'Ø') then Result := 'Ø';
  if (HCode = '&Ugrave;') or (HCode = 'Ù') then Result := 'Ù';
  if (HCode = '&Uacute;') or (HCode = 'Ú') then Result := 'Ú';
  if (HCode = '&Ucirc;') or (HCode = 'Û') then Result := 'Û';
  if (HCode = '&Uuml;') or (HCode = 'Ü') then Result := 'Ü';
  if (HCode = '&Yacute;') or (HCode = 'Ý') then Result := 'Ý';
  if (HCode = '&THORN;') or (HCode = 'Þ') then Result := 'Þ';
  if (HCode = '&szlig;') or (HCode = 'ß') then Result := 'ß';
  if (HCode = '&agrave;') or (HCode = 'à') then Result := 'à';
  if (HCode = '&aacute;') or (HCode = 'á') then Result := 'á';
  if (HCode = '&acirc;') or (HCode = 'â') then Result := 'â';
  if (HCode = '&atilde;') or (HCode = 'ã') then Result := 'ã';
  if (HCode = '&auml;') or (HCode = 'ä') then Result := 'ä';
  if (HCode = '&aring;') or (HCode = 'å') then Result := 'å';
  if (HCode = '&aeling;') or (HCode = 'æ') then Result := 'æ';
  if (HCode = '&ccedil;') or (HCode = 'ç') then Result := 'ç';
  if (HCode = '&egrave;') or (HCode = 'è') then Result := 'è';
  if (HCode = '&eacute;') or (HCode = 'é') then Result := 'é';
  if (HCode = '&ecirc;') or (HCode = 'ê') then Result := 'ê';
  if (HCode = '&euml;') or (HCode = 'ë') then Result := 'ë';
  if (HCode = '&igrave;') or (HCode = 'ì') then Result := 'ì';
  if (HCode = '&iacute;') or (HCode = 'í') then Result := 'í';
  if (HCode = '&icirc;') or (HCode = 'î') then Result := 'î';
  if (HCode = '&iuml;') or (HCode = 'ï') then Result := 'ï';
  if (HCode = '&eth;') or (HCode = 'ð') then Result := 'ð';
  if (HCode = '&ntilde;') or (HCode = 'ñ') then Result := 'ñ';
  if (HCode = '&ograve;') or (HCode = 'ò') then Result := 'ò';
  if (HCode = '&oacute;') or (HCode = 'ó') then Result := 'ó';
  if (HCode = '&ocirc;') or (HCode = 'ô') then Result := 'ô';
  if (HCode = '&otilde;') or (HCode = 'õ') then Result := 'õ';
  if (HCode = '&ouml;') or (HCode = 'ö') then Result := 'ö';
  if (HCode = '&divide;') or (HCode = '÷') then Result := '÷';
  if (HCode = '&oslash;') or (HCode = 'ø') then Result := 'ø';
  if (HCode = '&ugrave;') or (HCode = 'ù') then Result := 'ù';
  if (HCode = '&uacude;') or (HCode = 'ú') then Result := 'ú';
  if (HCode = '&ucirc;') or (HCode = 'û') then Result := 'û';
  if (HCode = '&uuml;') or (HCode = 'ü') then Result := 'ü';
  if (HCode = '&yacute;') or (HCode = 'ý') then Result := 'ý';
  if (HCode = '&thorn;') or (HCode = 'þ') then Result := 'þ';
  if (HCode = '&yuml;') or (HCode = 'ÿ') then Result := 'ÿ';
  if Result = ' ' then
    begin
      delete(HCode, 1, 2);
      delete(HCode, length(HCode), 1);
      if TryStrToInt(HCode, i) then
        Result := Char(i);
    end;
end;

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 - 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;
        end;
    end;
  Result := sValue;
end;

function Html2Txt(html: string): string;
var
  istag                       : boolean;
  i                           : Integer;
  ch                          : Char;
  temp                        : string;
  slRes                       : TStrings;
begin
  result := '';
      temp := '';
      istag := false;
      html := ReplaceHTMLChar(html);
      for i := 1 to length(html) do
        begin
          ch := html[i];
          if (ch = '<') and (istag = false) then
            begin
              istag := true;
              continue;
            end;
          if (ch = '>') and (istag = true) then
            begin
              istag := false;
              continue;
            end;
          if istag = false then
            temp := temp + ch;
        end;
      slRes := TStringList.Create;
      try
        slRes.Text := temp;
        for i := 0 to slRes.Count - 1 do
          slRes[i] := Trim(slRes[i]);
        while slRes.IndexOf('') <> -1 do
          slRes.delete(slRes.IndexOf(''));
      finally
        Result := slRes.Text;
        slRes.Free;
      end;
end;

einfach mit html2txt() aufrufen
Damit werden alle html-tags und scripte entfernt, sowie die html-sonderzeichen ersetzt.

Ich arbeite immo noch an einer Lösung mit regulären Ausdrücken.

Gruß
tr909

[knolli]

erstmal danke tr909!

könntest du mir noch schreiben, wie du funktionen aufrufst?
also in welcher reihenfolge und was du übergibst?

[DeddyH]

Zitat:

Zitat von tr909

einfach mit html2txt() aufrufen

;)

[Blackheart]

Delphi-Quellcode:

WebBrowser1.OleObject.Document.documentElement.innerText;

[knolli]

hups das hab ich glat übersehen!
:wall: :oops: *peinlich*

danke!

[mkinzler]

Allgemeine Lösung:

Delphi-Quellcode:

function StripTags( line: string): string;
var
   p, p1, p2, pr: PChar;
begin
   p:= PChar(line);
   while( p <> nil) and ( p <> '')  do
   begin
      p1 := StrScan( p, '<');
      if p1 <> nil then
      begin
        p2 := StrScan( p1, '>');
        if p2 <> Nil then
        begin
          StrLCopy( pr, p, p1-p);
          Result := Result +  pr;
          p := p2+1;
        end
        else
        begin
          Result := Result + p;
          p:= nil;
        end
      end
      else
      begin
        Result := Result + p;
        p:= nil;
      end;
   end;
end;

[Bernhard Geyer]

Zitat:

Zitat von Blackheart

Delphi-Quellcode:

WebBrowser1.OleObject.Document.documentElement.innerText;

Wenn ich eine WebBrowser-Control habe dann würde ich doch die von MS bereitgestellt Interfaces nehmen und dort einfach die Aufzählung für Links durchlaufen und nicht selbst versuchen mit ein paar Pos/Copy-Aufrufen den eigentlich nötigen Parser zu vermeiden. Werden z.B. Auskommentierte Links erkannt? Wie sieht es aus wenn Sonderzeichen nicht per HTML-Escapes angegeben sind sondern z.B. eine UTF8-Codierte Datei vorliegt? ...

[mkinzler]

Optimierte Version, die einzelne < oder > erkennt:

Delphi-Quellcode:

function StripTags( line: string): string;
var
   p, p1, p2, pr, pt: PChar;
begin
   p:= PChar(line);
   while( p <> nil) and ( p <> '')  do
   begin
      p1 := StrScan( p, '<');
      if p1 <> nil then
      begin
        p2 := StrScan( p1, '>');
        pt := StrScan( p1+1, '<');
        if pt <> Nil then
            if pt < p2 then //weiteres < vor >
            begin
              StrLCopy( pr, p, p1-p);
              Result := Result + pr;
              p := p1;
              p1 := pt;
            end;
        if p2 <> Nil then
        begin
          StrLCopy( pr, p, p1-p);
          Result := Result +  pr;
          p := p2+1;
        end
        else
        begin
          Result := Result + p;
          p:= nil;
        end
      end
      else
      begin
        Result := Result + p;
        p:= nil;
      end;
   end;
end;

Problem nur noch wenn beides in "richtiger" Reihenfolge auftritt.

[knolli]

also sowohl bei mkinzler als auch bei tr909 kommt folgende fehlermeldung:

http://img169.imageshack.us/img169/650/fehleriz4.png

ich möchte das ganze ohne webbrowser machen. ich habe den quelltext in einem memofeld und daraus möchte ich alles Tags entfernen.

[tr909]

ich bekomme bei mkinzlers Variante eine Zugriffsverletzung an der Stelle :

Delphi-Quellcode:

if p1 <> nil then
      begin
        p2 := StrScan( p1, '>');
        if p2 <> Nil then
        begin
          StrLCopy( pr, p, p1-p);    <---- an dieser Stelle knallt es
          Result := Result +  pr;
          p := p2+1;
        end
        else

@knolli
probier mal bei mir in der Funktion html2txt die Zeile html := ReplaceHTMLChar(html); auszukommentieren / wegzulassen
und alles ab slRes := TStringList.Create; kann auch weg (ist dazu da um die Leerzeilen zu entfernen

Gruß
tr909

[knolli]

ok funktioniert soweit...

aus dem quelltext

kommt das raus:

XML-Code:

@import url("./formIE.css");






Delphi-PRAXiS :: HTML Tags entfernen




if ( 0 ) { window.open('privmsg.php?mode=newpm', '_phpbbprivmsg', 'HEIGHT=225,resizable=no,WIDTH=400'); }

//-->






function openDPWindow(docURL, wndName, wndWidth, wndHeight, posLeft, posTop)

{

var session_id = '43861d35d1712e67c427884297b7a05b';


if (!posLeft)

var posLeft = (screen.width - wndWidth) / 2;

if (!posTop)

var posTop = ((screen.height - wndHeight) / 2)-20;


docURL = docURL.replace( '[SID]', session_id );


var parameters = "width="+wndWidth+",height="+wndHeight+",left="+posLeft+",top="+posTop+",
dependent=no,menubar=no,location=no,resizable=yes,scrollbars=yes,status=no";

window.open(docURL, wndName, parameters );

}

//-->





var L_EXPANDTEXT   = "aufklappen";

var L_COLLAPSETEXT = "zusammenfalten";

var clpHeight = "123px";



function toggle(elementId, allowToggle) {

var srcId, srcImage, srcLink = null;


if (allowToggle=='0') return false;


srcId = document.getElementById(elementId + "_code");

srcImage = document.getElementById(elementId + "_image");

srcLink = document.getElementById(elementId + "_link");


if (srcId != null)

srcId.style.height = (srcId.style.height=="") ? clpHeight : "";


if (srcImage != null && srcId != null)

srcImage.src = (srcId.style.height==clpHeight) ? './images/common/plus.png' : './images/common/minus.png';


if (srcLink != null)

{

txt = (document.documentElement) ? srcLink.firstChild.nodeValue : srcLink.innerText;

txt = (srcId.style.height==clpHeight) ? L_EXPANDTEXT : L_COLLAPSETEXT;

if (document.documentElement)

srcLink.firstChild.nodeValue = txt;

else

srcLink.innerText = txt;

}


//

//  Im Beitragseditor muessen die DHTML-Elemente neu angeordnet werden,

//  wenn wir getoggelt haben. Dazu stellt der Editor die Methode

//  "doRealignEditorElemets" bereit. Wenn diese Methode existiert, dann

//  muss sie jetzt aufgerufen werden.

if ( window.doRealignEditorElemets ) {

doRealignEditorElemets();

}


return false;

}


function selectAll(elementId) {

var element = document.getElementById(elementId);

if ( document.selection ) {

var range = document.body.createTextRange();

range.moveToElementText(element);

range.select();

} else

if ( window.getSelection ) {

var range = document.createRange();

range.selectNodeContents(element);

var blockSelection = window.getSelection();

blockSelection.removeAllRanges();

blockSelection.addRange(range);

} else {

alert( 'Dein Browser unterstützt diese Funktion leider nicht.' );

}

return false;

}


var init_toggle = 0;

var init_linenumbers = 0;

//-->



window.name = 'wndDelphiPRAXiSMain';

















Site-Map

Suchen

Code-Library

Mailbox


Logout[knolli]

































var dpSearchURL = "http://www.delphipraxis.net/search.php";


function post_time_edit(topic_id, post_id) {

window.open("./edit_post_time.php?t="+topic_id+"&p="+post_id, '_postedittime', 'HEIGHT=200,WIDTH=500,resizable=no,scrollbars=no');

}


//-->
















Titel:-->HTML Tags entfernen

Ein Delphi (Win32)-Thema von knolli.


Vorheriges Thema anzeigen|Nächstes Thema anzeigen

Avatare einblenden





sdrucken" border="0" hspace="2" vspace="2">









Delphi-PRAXiS Forum - Übersicht->Object-Pascal / Delphi-Language




Seite 1 von 1[ 10 Beiträge ]












Autor

Nachricht













knolli


#1|Verfasst am:Heute um 11:53Titel:HTML Tags entfernen











MitgliedStatus:onlineBeiträge: 9angemeldet: 22.09.2006

Sprache: Delphi (Win32) Hi!





Ich melde mich nun schon wieder mit einem euene Problem.


Mir geht es darum, alle HTML-Tags zu entfernen, damit ich nur noch  z.B.: Linkbeschriftungen oder den auf der Seite 
sichtbaren Text habe und diesen bearbeiten kann. Wer kann mir sagen, wie das funktionieren könnte? Wohlgemerkt es soll alles mit delphi passieren^^.




Ich freue mich schon auf eure Hilfe und hoffe das ich mir auch selbst eine Antwort geben kann!











*] -->



test -->

























DeddyH


#2|Verfasst am:Heute um 11:59Titel:Re: HTML Tags entfernen











"Rüsselmops" ;-)Alter: 41Status:onlineBeiträge: 3.281angemeldet: 17.09.2006Wohnort: Schweina/ThüringenDelphi 7 Enterprise


Ein Anfang wäre, alle < zu ermitteln und von deren Position bis zum folgenden > alles zu löschen.



Gruß Deddy


21 ist nur die halbe Antwort








*] -->


test -->


























tr909


#3|Verfasst am:Heute um 12:04Titel:Re: HTML Tags entfernen











MitgliedStatus:offlineBeiträge: 145angemeldet: 05.11.2004Turbo Delphi für Win32

Hatte gerade das gleiche Problem und habe nu provisorisch erst mal folgendes gebastelt und zusammengesucht



Delphi-Quellcode:     zusammenfalten | markieren

ace: nowrap; width: 100%; overflow-x: auto; overflow-y: auto; overflow: auto;">
1···5····10····15···
·20···&middot
;25····30····35[/b]
····40····45····50··
··55····60····65····
70····75····80····85··
··

0;">90····95····100····105·
···110····115····120···
·125····130····135····140·
···

180····185····190191function GiveSZ(HCode: string): Char;



var


 i             : Integer;



begin


 Result := ' ';


 if (HCode = '"') or (HCode = '"') then Result := '"';



 if (HCode = '&') or (HCode = '&') then Result := '&';



 if (HCode = '<') or (HCode = '<') then Result := '<';



 if (HCode = '>') or (HCode = '>') then Result := '>';



 // ISO 160 bis ISO 255 Codes


 if (HCode = ' ') or (HCode = ' ') then Result := ' ';



 if (HCode = '&iexl;') or (HCode = '¡') then Result := '¡';



 if (HCode = '¢') or (HCode = '¢') then Result := '¢';



 if (HCode = '£') or (HCode = '£') then Result := '£';



 if (HCode = '¤') or (HCode = '¤') then Result := '¤';



 if (HCode = '¥') or (HCode = '¥') then Result := '¥';



 if (HCode = '&brkbar;') or (HCode = '¦') then Result := '¦';



 if (HCode = '§') or (HCode = '§') then Result := '§';



 if (HCode = '¨') or (HCode = '¨') then Result := '¨';



 if (HCode = '©') or (HCode = '©') then Result := '©';



 if (HCode = 'ª') or (HCode = 'ª') then Result := 'ª';



 if (HCode = '«') or (HCode = '«') then Result := '«';



 if (HCode = '¬') or (HCode = '¬') then Result := '¬';



 if (HCode = '­') or (HCode = '­') then Result := '­';



 if (HCode = '®') or (HCode = '®') then Result := '®';



 if (HCode = '&hibar;') or (HCode = '¯') then Result := '¯';



 if (HCode = '°') or (HCode = '°') then Result := '°';



 if (HCode = '±') or (HCode = '±') then Result := '±';



 if (HCode = '²') or (HCode = '²') then Result := '²';



 if (HCode = '³') or (HCode = '³') then Result := '³';



 if (HCode = '´') or (HCode = '´') then Result := '´';



 if (HCode = 'µ') or (HCode = 'µ') then Result := 'µ';



 if (HCode = '¶') or (HCode = '¶') then Result := '¶';



 if (HCode = '·') or (HCode = '·') then Result := '·';



 if (HCode = '¸') or (HCode = '¸') then Result := '¸';



 if (HCode = '¹') or (HCode = '¹') then Result := '¹';



 if (HCode = 'º') or (HCode = 'º') then Result := 'º';



 if (HCode = '»') or (HCode = '»') then Result := '»';



 if (HCode = '¼') or (HCode = '¼') then Result := '¼';



 if (HCode = '½') or (HCode = '½') then Result := '½';



 if (HCode = '¾') or (HCode = '¾') then Result := '¾';



 if (HCode = '¿') or (HCode = '¿') then Result := '¿';



 if (HCode = 'À') or (HCode = 'À') then Result := 'À';



 if (HCode = 'Á') or (HCode = 'Á') then Result := 'Á';



 if (HCode = 'Â') or (HCode = 'Â') then Result := 'Â';



 if (HCode = 'Ã') or (HCode = 'Ã') then Result := 'Ã';



 if (HCode = 'Ä') or (HCode = 'Ä') then Result := 'Ä';



 if (HCode = 'Å') or (HCode = 'Å') then Result := 'Å';



 if (HCode = '&AEling;') or (HCode = 'Æ') then Result := 'Æ';



 if (HCode = 'Ç') or (HCode = 'Ç') then Result := 'Ç';



 if (HCode = 'È') or (HCode = 'È') then Result := 'È';



 if (HCode = 'É') or (HCode = 'É') then Result := 'É';



 if (HCode = '&Ecirce;') or (HCode = 'Ê') then Result := 'Ê';



 if (HCode = 'Ë') or (HCode = 'Ë') then Result := 'Ë';



 if (HCode = 'Ì') or (HCode = 'Ì') then Result := 'Ì';



 if (HCode = 'Í') or (HCode = 'Í') then Result := 'Í';



 if (HCode = '&Icirce;') or (HCode = 'Î') then Result := 'Î';



 if (HCode = 'Ï') or (HCode = 'Ï') then Result := 'Ï';



 if (HCode = 'Ð') or (HCode = 'Ð') then Result := 'Ð';



 if (HCode = 'Ñ') or (HCode = 'Ñ') then Result := 'Ñ';



 if (HCode = 'Ò') or (HCode = 'Ò') then Result := 'Ò';



 if (HCode = 'Ó') or (HCode = 'Ó') then Result := 'Ó';



 if (HCode = 'Ô') or (HCode = 'Ô') then Result := 'Ô';



 if (HCode = 'Õ') or (HCode = 'Õ') then Result := 'Õ';



 if (HCode = 'Ö') or (HCode = 'Ö') then Result := 'Ö';



 if (HCode = '×') or (HCode = '×') then Result := '×';



 if (HCode = 'Ø') or (HCode = 'Ø') then Result := 'Ø';



 if (HCode = 'Ù') or (HCode = 'Ù') then Result := 'Ù';



 if (HCode = 'Ú') or (HCode = 'Ú') then Result := 'Ú';



 if (HCode = 'Û') or (HCode = 'Û') then Result := 'Û';



 if (HCode = 'Ü') or (HCode = 'Ü') then Result := 'Ü';



 if (HCode = 'Ý')

java und der ganze rest muss auch raus... ich brauche nur das was wirklich auf der seite steht...

[edit=mkinzler]Zeilenumbrüche eingefügt Mfg, mkinzler[/edit]

[mkinzler]

Delphi-Quellcode:

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;

[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

[marabu]

Hallo,

Zitat:

Zitat von Blackheart

Delphi-Quellcode:

WebBrowser1.OleObject.Document.documentElement.innerText;

vermutlich ist Beitrag #6 ein wenig untergegangen ...

Grüße vom marabu

[knolli]

hm... nein ist nicht untergegangen... ich hab ein problem mit dem browser.. selbst wenn ich ihm erlaube ins internet zu verbinde, steht da das die seite nicht angezeigt werden kann... wie muss ich den browser konfigurieren damit er seiten auch anzeigt?

[edit= ich hab meinen fehler gefunden... hatte keinen IE installiert... funktioniert jetz alles! herzlichen dank!]

[knolli]

ähm... ich hab mal noch ne frage...

gibt es mit dem WebBrowser AUCH ne möglichkeit die links zu holen?
wenn ja wie heißt die?

[marabu]

Du kannst hier im Forum mehrere Versionen von ExtractLinks() finden, die dir dabei helfen.

[himitsu]

Zitat:

Zitat von knolli

gibt es mit dem WebBrowser AUCH ne möglichkeit die links zu holen?
wenn ja wie heißt die?

Zitat:

WebBrowser1.OleObject.Document.documentElement.innerText

das Rote entspricht dem, was in HTML>JavaScript möglich ist ...


also einfach mal versuchen dort analog zum JavaScript (z.B. siehe SelfHTML) versuchen darauf zuzugreifen :angel2:

[knolli]

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

[Namenloser]

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...

[omata]

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.

[Namenloser]

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

[nat]

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.

[quendolineDD]

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.

[Codehunter]

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;

[Monday]

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

[handyotto]

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:&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. ;-)

[handyotto]

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.