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;
