如何从S:STRING 提取全部电子邮件地址? ( 积分: 200 )

如何从S:STRING 提取全部电子邮件地址?
那位大哥帮帮小兄弟啊！

如何从S:STRING 提取全部电子邮件地址?
那位大哥帮帮小兄弟啊！

说的详细的嘛!

字符串有没有规则性，若没有，只能找@的位置，前后判断读取

<TD><A href="mailto:whiteezdm@yahoo.com.cn"><IMG title="给 网络在线 发电子邮件" src="ima

也可能是
dffdfd:whiteezdm@yahoo.com.cn
dffdfd:wteezdm@yahoo.com.cn

总之，只要是电子邮件都提取！

利用脚本语言的正则表达式来解决是最好的了，以下为本人原创：
function GeEmailAddress(Source:string):string;
var
obj,retVal:OleVariant;
code:WideString;
begin
code:='function getEmailAddress(Source)'
+'{'
+' if (typeof(Source)!="string" || Source=="&quot return null; '
+' var re = /[a-zA-Z0-9_/-]+@[a-zA-Z0-9_/-]+(/.(COM|CN|NET|EDU))+/ig;'
+' return Source.match(re);'
+'}';
obj:=CreateOleObject('MSScriptControl.ScriptControl');
obj.Language:='javascript';
obj.AddCode(code);
retVal:=obj.Run('getEmailAddress',Source);
if VarIsNull(retVal) then
Result:=''
else
Result:=retVal;
end;

调用：
procedure TForm1.Button2Click(Sender: TObject);
begin
ShowMessage(GeEmailAddress(Edit1.Text));
end;

to 楼上：非常正确！
我结合我的土法

function TFrm_Main.get_mp_mail(s: string; i: integer): string; //mp ëÅß
begin
result := copy(s, i - 21, 40);
end;

function TFrm_Main.get_qj_mail(s: string): string; //qj Çó¾«
var i: integer; tmp1, tmp2: string;
begin
i := pos('@', s);
result := '';
if i = 0 then exit;

tmp1 := copy(s, 1, i - 1);
tmp2 := copy(s, i + 1, 21);

if trim(tmp1) = '' then exit;

i := length(tmp1);

while i > 0 do
begin
if (tmp1 = #$A) and (TMP1[I - 1] = #$D) then BREAK;
if tmp1 = ' ' then break;
if tmp1 = '.' then break;
if tmp1 = ':' then break;
if tmp1 = '£º' then break;
if ord(tmp1) > 122 then break;
if ORD(TMP1) < 46 then BREAK;
if TMP1 = '/' then BREAK; //47
if (ORD(TMP1) >= 58) and (ORD(TMP1) <= 64) then BREAK;
if (ORD(TMP1) > 90) and (ORD(TMP1) < 95) then BREAK;
if (ORD(TMP1) = 96) then BREAK;

i := i - 1;
end;

tmp1 := copy(s, i + 1, length(tmp1)-i);

i := 1;
while length(tmp2) > i do
begin
if tmp2 = ' ' then break;
if tmp2 = ':' then break;
if tmp2 = '@' then break;
if tmp2 = '£º' then break;
if ord(tmp2) > 126 then break;
if ORD(TMP2) < 46 then BREAK;
if TMP2 = '/' then BREAK; //47
if (ORD(TMP2) >= 58) and (ORD(TMP2) <= 64) then BREAK;
if (ORD(TMP2) > 90) and (ORD(TMP2) < 95) then BREAK;
if (ORD(TMP2) = 96) then BREAK;

i := i + 1;
end;
tmp2 := copy(tmp2, 1, i - 1);

result := tmp1 + '@' + tmp2;
result := lowercase(result);
if rightstr(result, 1) = '.' then result := '';
if rightstr(result, 1) = '@' then result := '';
end;




function TFrm_Main.GetAllMail(value: string): tstrings;
var
s, mail: string; len, i: integer;
begin
result := tstringlist.Create;
s := value;
i := pos('@', s);
len := length(s);
while i > 0 do
begin
i := pos('@', s);
len := len - (i + 1);
mail := get_mp_mail(s, i);
mail := get_qj_mail(mail);
if mail <> '' then result.Add(mail);
s := copy(s, i + 1, len);
end;
end;

终于有满意的算法了！谢谢兄弟！

-

前两天刚写了，用PYTHON写的。
正则式：
/b/w{3,20}@(/w|/.).(com|net|org)/b