Zusammengehörige HTML Tags finden

DieHardMan · Beiträge: 19

Hallo,
hat jemand eine Lösung oder einen Lösungsvorschlag wie ich z.B. zu "<DIV class=artikel-teasertext>" den schließenden Tag finde, also den an letzer Stelle und nicht den vorherigen?
Habe schon sämtliche freien HTML Parser ausprobiert aber keiner bietet diese Möglichkeit.

markieren

Quelltext

1:
2:
3:
4:
5:

<DIV class=artikel-teasertext>
<H1>Überschrift</H1>
<P>Text</P>
<DIV>Authortext</DIV>
</DIV>

_________________
Mahlzeit

Lannes · Verfasst: Mo 19.06.06 11:19

Hallo,

hab in meiner Sammlung was gefunden, die Funktion FindOuterHTML gibt einen String incl. des gesuchten Tags zurück. Wird der Tag nicht gefunden, einen Leerstring.

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:

function FindOuterHTML(sHTML,sTag: String;Start: Integer): String;
var i,ii,l,x,PosA,PosE : Integer;
    s : String;
begin
  Result := '';
  s := UpperCase(sTag);
  l := Length(s);
  x := -1;
  i := Start;
  PosA := 0;
  while i < Length(sHTML) do
    begin
    inc(i);
    if sHTML[i] = '<' then
      begin
      ii := 1;
      inc(i);
      if sHTML[i] = '/' then
        begin
        inc(i);
        while UpCase(sHTML[i]) = s[ii] do
          begin
          inc(ii);
          inc(i);
          end;{}
        if ii = l+1 then
          begin
          if sHTML[i] = '>' then
            dec(x);
          if x = -1 then
            begin
            PosE := i+1;
            break;
            end;
          end;
        end{if sHTML[i] = '/' then}
        else
          begin
          while UpCase(sHTML[i]) = s[ii] do
            begin
            inc(ii);
            inc(i);
            end;{}
          if ii = l+1 then
            begin
            if (sHTML[i] = ' ') or (sHTML[i] = '>') then
              inc(x);
            if x = 0 then
              PosA := i-l-1;
            end;
          end;{else sHTML[i] <> '/'}
        end;{if sHTML[i] = '<' then}
    end;{while i < Length(sHTML) do}
  if PosA <> 0 then
    Result := Copy(sHTML,PosA,PosE-PosA);
end;{FindOuterHTML}

_________________
MfG Lannes
(Nichts ist nicht Nichts) and ('' <> nil ) and (Pointer('') = nil ) and (@('') <> nil )

DieHardMan · Beiträge: 19

Hey danke, hätte nicht gedacht da ne Antwort zu erhalten. Habe gerade alles eingebaut und funktioniert tadellos.

Hier eine ergänzende Funktion falls sie jemand braucht (Achtung nicht optimiert):

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:

function DeleteHtmlSubStr(TagElement, S: String; Repetitions: Integer): String;
var
  strTagName, strTemp: String;
  intPos, i: Integer;
begin
  { Bei leeren übergegebenen Strings abbrechen }
  If (TagElement = '') or (S = '') or (Repetitions = 0) then
  begin
    Result := S;
    exit;
  end;

  If (Copy(TagElement, 1, 1) = '<') and
    (Copy(TagElement, Length(TagElement), 1) = '>') then
  begin
    Delete(TagElement, 1, 1);
    Delete(TagElement, Length(TagElement), 1);
  end;

  For i := 1 to Repetitions do
  begin
    intPos := Pos(UpperCase('<' + TagElement + '>'), UpperCase(S));

    { Wenn TagName im String nicht gefunden werden kann, abbrechen }
    If intPos = 0 then
      continue;

    strTagName := TagElement;
    { Ab dem Leerzeichen nach dem Tag löschen }
//    DeleteFrom(strTagName, ' ', True);
    If Pos(' ', strTagName) <> 0 then
      Delete(strTagName, Pos(' ', strTagName), Length(strTagName));
    strTagName := UpperCase(Trim(strTagName));

    strTemp := Trim(FindOuterHtml(S, strTagName, intPos - 2));

    { Nichts gefunden deshalb abbrechen }
    If strTemp = '' then
    begin
      Result := S;
      exit;
    end;

    Delete(S, intPos, Length(strTemp));
//  ALTERNATIVE:   S := StringReplace(S, strTemp, '', []);    
  end;  // For-Schleife Ende

  If Length(S) < 3 then S := '';

  Result := S;  // Ergebnis zuweisen
end;

_________________
Mahlzeit

Lannes · Verfasst: Di 20.06.06 14:45

DieHardMan hat folgendes geschrieben:

...Hier eine ergänzende Funktion falls sie jemand braucht (Achtung nicht optimiert):

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:

//function DeleteHtmlSubStr(
//...
    intPos := Pos(UpperCase('<' + TagElement + '>'), UpperCase(S));

    { Wenn TagName im String nicht gefunden werden kann, abbrechen }
    If intPos = 0 then
      continue;
//...

ist so nicht ideal, denn durch + '>' werden nur Tag-Blöcke berücksichtigt die im Eröffnungs-Tag keine Tag-Attribute enthalten.

In der Funktion FindOuterHtml werden Tags mit Attributen berücksichtigt, das könnte unter Umständen Fehler erzeugen. Außerdem ist es nicht gerade optimal das die Funktion FindOuterHtml einen String zurückliefert, der dann in Der Funktion DeleteHtmlSubStr mittels Length() zum löschen des Tag-Blocks genutzt wird.

Hab die beiden Funktionen mal kombiniert und optimiert(geht bestimmt noch besser).
Mit der Funktion können verschachtelte Tag-Blöcke und auch Standalone-Tags(z.B. <!-- <META, <br ... , mit und ohne Attribute, gelöscht werden.:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:

function DeleteOuterHTML(sHTML,sTag: String;Start,Repetitions: Integer): String;
var z,i,ii,L_TmpTag,x,PosA,PosE : Integer;
    sTmpTag : String;
begin
  for z := 1 to Length(sTag) do
    if (sTag[z] <> '<') and (sTag[z] <> '>') then
      if sTag[z] = ' ' then
        break
        else
          sTmpTag := sTmpTag + sTag[z];

  If (sTmpTag = '') or (sHTML = '') or (Repetitions = 0) then
  begin
    Result := sHTML;
    exit;
  end;
  
  sTmpTag := UpperCase(sTmpTag);
  L_TmpTag := Length(sTmpTag);
  i := Start;
  Start := 1;

  for z := 1 to Repetitions do
    begin
    x := -1;
    PosA := 0;
    PosE := 0;
    while i < Length(sHTML) do
      begin
      inc(i);
      if sHTML[i] = '<' then
        begin
        ii := 1;
        inc(i);
        if sHTML[i] = '/' then
          begin
          inc(i);
          while UpCase(sHTML[i]) = sTmpTag[ii] do
            begin
            inc(ii);
            inc(i);
            end;{}
          if ii = L_TmpTag+1 then
            begin
            if sHTML[i] = '>' then
              dec(x);
            if x = -1 then
              begin
              PosE := i+1;
              break;
              end;
            end;
          end{if sHTML[i] = '/' then}
          else
            begin
            while UpCase(sHTML[i]) = sTmpTag[ii] do
              begin
              inc(ii);
              inc(i);
              end;{}
            if ii = L_TmpTag+1 then
              begin
              if (sHTML[i] = ' ') or (sHTML[i] = '>') then
                inc(x);
              if x = 0 then
                PosA := i-L_TmpTag-1;
              end;
            end;{else sHTML[i] <> '/'}
          end;{if sHTML[i] = '<' then}
      end;{while i < Length(sHTML) do}

    //Tag und abschließendes Tag gefunden
    if (PosA <> 0) and (PosE <> 0) then
      begin
      Result := Result+Copy(sHTML,Start,PosA-Start);
      Start := PosE;
      end;

    //Tag gefunden, aber kein abschließendes Tag
    if (PosA <> 0) and (PosE = 0) then
      begin
      Result := Result+Copy(sHTML,Start,PosA-Start);
      ii := PosA+L_TmpTag;//beginnen ab z.B.'<br' oder '<!--'
      while sHTML[ii] <> '>' do
        inc(ii);
      //PosE := ii+1;
      //Start := PosE;
      Start := ii+1;
      i := ii;
      end;

    //Tag nicht, oder keine weitereren gefunden
    if (PosA = 0) and (PosE = 0) then
      break;
      
    end;{for z := 1 to Repetitions do}
  Result := Result+Copy(sHTML,Start,MAXINT);
end;{DeleteOuterHTML}

Hoffe mal das keine Fehler drinn sind :angel:

, kannst es ja mal testen.

_________________
MfG Lannes
(Nichts ist nicht Nichts) and ('' <> nil ) and (Pointer('') = nil ) and (@('') <> nil )

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme