Position von Text/Links in einer HTML Datei finden

[Hiele]

Hi marabu,

das was du da machst ist genau, was ich wollte. Der Textparser ist lediglich eine Notlösung und dauert furchtbar lange.
Aber Arbeit geht vor - lass dich also von mir (und meinen Vorstellungen) nicht ablenken.

Mein Delphiwissen ist dem kaum würdig (Naja vieleicht ein bischen)

Wäre aber schön, wenn du dran bleibst, ist bei mir nicht allzu Zeitkritisch.

Aber für ein Tip um die Prozedur zu beschleunigen wäre ich dankbar.
Mit doc.body.innerHTML habe ich es auch schon versucht. Würde ein virtueller Richedit das beschleunigen?

Gruß
Hiele

Hier der Parser:

Delphi-Quellcode:

procedure TForm4.sbanalyseClick(Sender: TObject);
var 
    i2                   : longint;    // Für verschachtelte Tags
    s, stag              : string;     // s=Text/Link/Bild  stag=Was für ein Tag
    tagclose,scriptclose : boolean;    // Verschachtelter Tag geschlossen / Script geschlossen
    listitem             : TListItem;  // Ergebnissliste (Text/Link/Bild mit Position)

begin
  // Quelltextparser

  progbar.Max := length(quelltext1.Text);  //Status des Parsers
  progbar.Visible := true;                 

  liste.Clear;                            // Ergebnissliste vorbereiten
  liste.Items.BeginUpdate;

  posqt := 0;                            // Position im Quelltext
  s := '';
  i2 := 0;
  stag := '';
  tagclose := false;
  scriptclose := false;
  statusbar.Panels[0].Text := 'Analysiere Page ...';

  while posqt < length(quelltext1.text) do
  begin
    if quelltext1.text[posqt] = '<' then
    begin
      s := '';
      inc(posqt);
      application.ProcessMessages;
      progbar.Position := posqt;

      // IST SCRIPT
      if lowercase(copy(quelltext1.text,posqt,6)) = 'script' then
      begin
        while not(scriptclose) and (posqt<length(quelltext1.text)) do
        begin
          if lowercase(copy(quelltext1.text,posqt,5)) <> '</scr' then inc(posqt) else
          scriptclose := true;
          application.ProcessMessages;
        end;
      end else
      begin

        // IST Normaler Tags
        stag := '';
        stag := stag + quelltext1.text[posqt];
        while not(tagclose) and (posqt<length(quelltext1.text)) do
        begin
          if (quelltext1.text[posqt] = '>') and (i2 = 0) then tagclose := true;
          if (quelltext1.text[posqt] = '<') then inc(i2);
          if (i2>0) and (quelltext1.text[posqt]='>') then dec(i2);

          // IST LINK
          if (lowercase(copy(quelltext1.text,posqt,6)) = 'href="') and mlinks.checked then   // Suche nach Links
          begin
            // LINK FINDEN
            inc(posqt,6);
            application.ProcessMessages;
            while quelltext1.text[posqt] <> '"' do
            begin
              s := s + quelltext1.text[posqt];
              inc(posqt);
              progbar.Position := posqt;
            end;

            // LINK HINZUFÜGEN
            listitem := liste.Items.Add;
            listitem.Caption := s;
            listitem.ImageIndex := 10;
            listitem.StateIndex := 10;
            listitem.SubItems.Add(inttostr(posqt));
            s := '';
          end;

          // IST BILD
          if (lowercase(copy(quelltext1.text,posqt,5)) = 'src="') and mbilder.checked then   // Suche nach Bildern
          begin
            // BILD FINDEN
            inc(posqt,5);
            while quelltext1.text[posqt] <> '"' do
            begin
              s := s + quelltext1.text[posqt];
              inc(posqt);
              progbar.Position := posqt;
            end;

            // BILD HINZUFÜGEN
            listitem := liste.Items.Add;
            listitem.Caption := s;
            listitem.ImageIndex := 11;
            listitem.StateIndex := 11;
            listitem.SubItems.Add(inttostr(posqt));
            s := '';
          end;
          stag := stag + quelltext1.text[posqt];
          inc(posqt);
          progbar.Position := posqt;
          application.ProcessMessages;
        end;
        i2 := 0;
        tagclose := false;
        scriptclose := false;
      end;
    end else
    begin
      if mtext.checked then  // MIT TEXT (Suche nach Texten)
      begin
        while (quelltext1.text[posqt] <> '<') and (posqt<length(quelltext1.text)) do
        begin
          s := s + quelltext1.text[posqt];
          inc(posqt);
          progbar.Position := posqt;
          application.ProcessMessages;
        end;
        if length(s)>0 then
        if (s[1] in ['a'..'z','A'..'Z','0'..'9']) and (copy(stag,1,2)<>'<!') then
        begin
          listitem := liste.Items.Add;
          listitem.Caption := s;
          listitem.ImageIndex := 8;
          listitem.StateIndex := 8;
          listitem.SubItems.Add(inttostr(posqt));
          stag := '';
        end;
      end else inc(posqt);
    end;
  end;
  statusbar.Panels[0].Text := 'Fertig!';
  progbar.Visible := false;
  liste.Items.EndUpdate;
end;