Artigos Delphi Dicas - Extraindo tags HTML

Extraindo tags de arquivos HTML

 

Como poderíamos extrair informação HTML Tag tais como Links/Images/Frames, contidas em uma determinada página?

Extrair informação tag do HTML sempre foi uma coisa complicada de fazer, pois teremos que prever a maioria dos erros, texto quebrado ou erros do código. Sempre procuramos uma função precisa e correta para extrair links de páginas HTML, mas todas as que achamos, tinham suas desvantagens com relação a linhas quebradas ou espaços mal colocados ou até mesmo de lentidão.

Assim, como a maioria dos programadores diz, depois de uma longa procura decidimos escrever NOSSA PRÓPRIA função para controlar tudo do melhor modo possível, esperando desta maneira, por um fim para todas essas funções bobas ou mal escritas que dizem que fazem o trabalho do melhor modo.

Por favor, repare que a função que estamos propondo poderá não ser a mais rápida, mas certamente funciona da melhor forma e pode inclusive ser expandida para no futuro extrair mais informação.

Eis aqui a função. Inserimos alguns comentários, e não nos aprofundamos a respeito de como a mesma trabalha, pois foi escrita de uma maneira simples, de forma que mesmo um iniciante poderá entendê-la e expandi-la para seu próprio uso:

 

function ExtractHtmlTagValues(const HtmlText: string; TagName, AttribName: string;

  var Values: TStrings): integer;

 

function FindFirstCharAfterSpace(const Line: string; StartPos: integer): Integer;

var

  i: integer;

begin

  Result := -1;

  for i := StartPos to Length(Line) do

  begin

    if (Line[i] <> ' ') then

    begin

      Result := i;

      exit;

    end;

  end;

end;

 

function FindFirstSpaceAfterChars(const Line: string; StartPos: integer): Integer;

begin

  Result := PosEx(' ', Line, StartPos);

end;

 

function FindFirstSpaceBeforeChars(const Line: string; StartPos: integer): Integer;

var

  i: integer;

begin

  Result := 1;

  for i := StartPos downto 1 do

  begin

    if (Line[i] = ' ') then

    begin

      Result := i;

      exit;

    end;

  end;

end;

 

var

  InnerTag: string;

  LastPos, LastInnerPos: Integer;

  SPos, LPos, RPos: Integer;

  AttribValue: string;

  ClosingChar: char;

  TempAttribName: string;

begin

  Result := 0;

  LastPos := 1;

  while (true) do

  begin

    { achar  outer tags '<' & '>' }

    LPos := PosEx('<', HtmlText, LastPos);

    if (LPos <= 0) then

      break;

    RPos := PosEx('>', HtmlText, LPos+1);

    if (RPos <= 0) then

      LastPos := LPos + 1

    else

      LastPos := RPos + 1;

    { obter inner tag }

    InnerTag := Copy(HtmlText, LPos+1, RPos-LPos-1);

    InnerTag := Trim(InnerTag); // remove spaces

    if (Length(InnerTag) < Length(TagName)) then

      Continue;

    { verificar os tag name }

    if (SameText(Copy(InnerTag, 1, Length(TagName)), TagName)) then

    begin

      { tag achada }

      AttribValue := '';

      LastInnerPos := Length(TagName)+1;

      while (LastInnerPos < Length(InnerTag)) do

      begin

        { achar primeiro '=' after LastInnerPos }

        RPos := PosEx('=', InnerTag, LastInnerPos);

        if (RPos <= 0) then

          break;

        { Deste modo, podemos verificar a existência de nomes de atributos múltiplos e não um atributo especifico }

        SPos := FindFirstSpaceBeforeChars(InnerTag, RPos);

        TempAttribName := Trim(Copy(InnerTag, SPos, RPos-SPos));

        if (true) then

       begin

          { achar a tag correta }

          LPos := FindFirstCharAfterSpace(InnerTag, RPos+1);

          if (LPos <= 0) then

          begin

            LastInnerPos := RPos + 1;

            continue;

          end;

          LPos := FindFirstCharAfterSpace(InnerTag, LPos);

          if (LPos <= 0) then

            Continue;

          if ((InnerTag[LPos] <> '"') and (InnerTag[LPos] <> '''')) then

          begin

            { AttribValue não esta delimitado por '"' ou ''' portanto obte-lo }

            RPos := FindFirstSpaceAfterChars(InnerTag, LPos+1);

            if (RPos <= 0) then

              AttribValue := Copy(InnerTag, LPos, Length(InnerTag)-LPos+1)

            else

              AttribValue := Copy(InnerTag, LPos, RPos-LPos+1);

          end

          else

          begin

            { obter url delimitada por '"' ou ''' }

            ClosingChar := InnerTag[LPos];

            RPos := PosEx(ClosingChar, InnerTag, LPos+1);

            if (RPos <= 0) then

              AttribValue := Copy(InnerTag, LPos+1, Length(InnerTag)-LPos-1)

            else

              AttribValue := Copy(InnerTag, LPos+1, RPos-LPos-1)

          end;

 

          if (SameText(TempAttribName, AttribName)) and (AttribValue <> '') then

          begin

            Values.Add(AttribValue);

            inc(Result);

          end;

        end;

        if (RPos <= 0) then

          LastInnerPos := Length(InnerTag)

        else

          LastInnerPos := RPos+1;

      end;

    end;

  end;

end;

 

Por exemplo, se quisermos extrair todos os links contidos em uma página, é só fazer o seguinte:

 

var

  Links: TStrings;

  Html: TStrings;

begin

  Links := TStringList.Create;

  Html := TStringList.Create;
  Html.LoadFromFile('arquivo.htm');

  try  

    LinksFound := ExtractHtmlTagValues(Html.Text, 'A', 'HREF', Links);

    Memo1.Lines := Links;

  finally

    Links.Free;

  end;

end;