从文本中提出EMAIL地址的函数

function GetEmail(htmlText:String):String;
var
  I: Integer;
  leftI,rightI:Integer;
  atPos:Integer;
  htmlTextLen:integer;
  haveDot:Boolean;
begin
  leftI:=0;
  rightI:=0;
  haveDot:=False;

http://www.prize8.com

  htmlTextLen:=Length(htmlText);

  atPos:=Pos('@',htmlText);

  if atPos<=0 then
  begin
    Result:='';
    Exit;
  end;

  for leftI:=atPos-1 Downto 1 do
  begin
    if not( htmlText[leftI] in ['A'..'Z','_','a'..'z','0'..'9','.'] )then
      break;
  end;

  for rightI:=atPos+1 to htmlTextLen do
  begin
    if htmlText[rightI]='.' then
      haveDot:=true;

    if (not (htmlText[rightI]  in ['A'..'Z','_','a'..'z','0'..'9','.'])) and haveDot then
    begin
      Result:=Copy(htmlText,leftI+1,RightI-leftI);
      break;
    end
    else
    begin
      Result:=Result+GetEmail(copy(htmlText,atPos+1,htmlTextLen-atPos));
    end;
  end;

  Showmessage(Copy(htmlText,leftI+1,RightI-leftI));
end;