procedure CollectURLs(AHTMLContent :
String; URLList : TStrings);
var
TempStr :
String;
begin
while Pos('
<a ', AHTMLContent) > 0
do
begin
TempStr := Trim(Copy(AHTMLContent, Pos('
<a ', AHTMLContent) + length('
<a '), length(AHTMLContent)));
System.Delete(AHTMLContent, 1, Pos('
<a ', AHTMLContent) + length('
<a '));
If (Pos('
</a>', TempStr) > 0)
then
begin
System.Delete(AHTMLContent, 1, Pos('
</a>', AHTMLContent) + length('
</a>'));
TempStr := Copy(TempStr, 1, Pos('
</a>', TempStr) - 1);
If (Pos('
>', TempStr) > 0)
then
begin
TempStr := Copy(TempStr, 1, Pos('
>', TempStr) - 1);
If (Pos('
href', TempStr) > 0)
and (Pos('
=', TempStr) > Pos('
href', TempStr))
then
begin
TempStr := Trim(Copy(TempStr, Pos('
href', TempStr) + length('
href'), length(TempStr)));
TempStr := Trim(Copy(TempStr, Pos('
=' , TempStr) + length('
=' ), length(TempStr)));
If (Pos('
"', TempStr) > 0)
then
begin
TempStr := Trim(Copy(TempStr, Pos('
"', TempStr) + length('
"'), length(TempStr)));
TempStr := Trim(Copy(TempStr, 1, Pos('
"', TempStr) - 1));
end;
URLList.Add(TempStr);
end;
// If (Pos('href', TempStr) > 0)
end;
// If (Pos('>', TempStr) > 0) then
end;
// If (Pos('</a>', TempStr) > 0)
end;
// while
end;
begin
//...
If (Msg.ContentType = '
text/plain')
or
(Pos('
text/plain' + '
;', Msg.ContentType) = 1)
then
begin
CollectURLs(Msg.Body.Text, Memo1.Lines);
end
else
for intIndex := 0
to Pred(Msg.MessageParts.Count)
do
if Msg.MessageParts.Items[intIndex]
is TIdText
then
If (Msg.MessageParts.Items[intIndex].ContentType = '
text/html')
or
(Pos('
text/html' + '
;', Msg.MessageParts.Items[intIndex].ContentType) = 1)
then
begin
CollectURLs(TIdText(Msg.MessageParts.Items[intIndex]).Body.Text, Memo1.Lines);
end;
//...
end;