发信人: leezy (【HIT】穆子), 信区: BorlandDev
标  题: 扩展E-mail地址的检验和更正
发信站: 哈工大紫丁香 (2002年01月19日15:45:34 星期六), 站内信件

摘　要：你是否需要检验e-mail地址是否正确，或者处理过一串e-
关键字：地址 e-mail
类　别：网络
CoDelphi.com版权所有，未经允许，不得进行任何形式转载
你是否需要检验e-mail地址是否正确，或者处理过一串e-mail 地址并发现有一些可以很
容易用手工更正的错误？我在这里给出的函数就是为此而设计的。在本文中我给出两个
函数，一个用来检查e-mail地址是否合法，另一个则尝试更改不正确的e-mail地址。
那什么是正确的e-mail地址？
我所见过的大多数检验e-mail地址的文章使用的方法过于简单。例如，我所见过最常用
的方法是保证有一个"＠"号，或超过一个最小的长度（如7字节），或者两者的组合。还
有一个更好的，但用得较少的方法，就是检查在地址中只有允许出现的字符（根据SMTP
标准）。
这些方法的问题是它们只能用最高的级别告诉你这些地址可能是正确的。例如：
地址： ------@--------
可以认为是合法的e-mail地址，因为它既包含一个＠，至少有7个字符长，而且是合法字
符。
为保证地址是真正正确的，你必须检查它的所有部分都是正确的。我给出的函数完成以
下检查：
a) 保证地址不是空白的
b) 保证有一个＠
c) 保证只使用合法字符
然后把检查分成两部分：用户名（邮箱）和域名。
对用户名的检查：
a) 保证它不是空白的
b) 保证用户名不比目前的标准（RFC821）长
c) 保证句号正确使用，特别是不能使用连续的句号（如：David..Lederman就不正确）
，也不能在开头和结束处有句号。
对域名的检查：
a) 保证它不是空白的
b) 保证域名不比目前的标准长
d) 保证标点"."正确使用，特别是不能使用连续的句号（如：World..net就不正确），
也不能在开头和结束处有"."
e) 域名分段需要检查（如：在omeplace.somewhere.com 中，someplace ，somewhere和
com 被认为是分段），以保证它们不以连字号开(-)头或结束（如：somewhere.-somepl
ace.com 就不合法）
f) Ensure that at least two domain segments exists (ex. someplace.com is val
id, .com is not valid)　保证有两个域名分段（如：someplace.com 法，而.com就不
合法）
g) 保证在域名部分没有额外的＠符号。
通过心目的步骤，大多数的在语法上合法而又不正确的e-mail地址可以被检测出来，并
认定无效。
VerifyEmailAddress 函数：
本函数接收3个参数：
Email ：
要检查的e-mail地址
FailCode ：
如果不认证地址，函数就报告的错误代码
FailPosition ：
谁失败时的字符位置（如果有）
函数返回布尔值，地址合法返回true，不合法则返回false。失败时FailCode可以用来确
定确切的错误：
  flUnknown ：未知错误发生，由异常处理捕捉。
  flNoSeperator ：找不到＠号。
  flToSmall ：e-mail地址空白。
  flUserNameToLong ：用户名比SMTP标准长。
  flDomainNameToLong ：域名比SMTP标准长。
  flInvalidChar ：发现非法字符。（FailPosition返回字符位置）
  flMissingUser ：用户名部分不存在。
  flMissingDomain ：域名部分不存在。
  flMissingDomainSeperator ：找不到域名分段
  flMissingGeneralDomain ：没有顶级域名
  flToManyAtSymbols ：出现超过一个＠符号
对于简单的检查，FailCode和FailPosition 没有用处，但可以通过ValidationErrorSt
ring用来显示错误，ValidationErrorString接受参数FailCode并返回可用于显示的错误
文本。
E-mail地址改正
由于e-mail检查例程返回详细的错误信息，更正常见e-mail错误的自动化系统很容易就
能实现。下面的常见错误可以自动更正：
example2.aol.com：最常见的错误（据我的经验）是用户输入e-mail地址时没有按shif
t键就输入2。Example@.aol.com - 此错误是用户输入的额外字符，用户要输入的是exa
mple@aol.com。
example8080 @ aol .com：本例中另一个常见错误，空格。
A Cool Screen name@AOL.com：由于AOL允许名字中有空格，但因特网不允许。
myaddress@ispcom　在ISP和COM之间没有输入"."。
CorrectEmailAddress函数：
函数接收三个参数：
Email ?要检查和更正的e-mail地址。
Suggestion ?此字符串通过引用而传递的字符串，包含函数结果
MaxCorrections ?停止前尝试更正的最大数量（缺省为5）
本函数只是循环MaxCorrection次，检查e-mail地址，然后使用FailCode来确定要进行哪
一种改正，并重复直至找到匹配，确定地址不能修改，或循环超过MaxCorrection次。
按FailCode执行下面的更正（见上面的说明）：
flUnknown ?停止更正，因为没有更改此类问题的方法。
flNoSeperator ?当发生此错误时，系统执行简单但强大的函数，它会搜索e-mail地址直
至发现最后的2，然后把它转换成一个@符号。这会更正大多数转换错误。如果它转换了
一个不是@的2，可能会令e-mail地址无效。
flToSmall ？停止更正，因为没有更改此类问题的方法。
flUserNameToLong ?停止更正，因为没有更改此类问题的方法。
flDomainNameToLong ?停止更正，因为没有更改此类问题的方法。
flInvalidChar ?这种情况下只是删除错误的字符。
flMissingUser ?停止更正，因为没有更改此类问题的方法。
flMissingDomain ?停止更正，因为没有更改此类问题的方法。
flMissingDomainSeperator ?停止更正，因为没有更改此类问题的方法。
flMissingGeneralDomain ?停止更正，因为没有更改此类问题的方法。
flToManyAtSymbols ?停止更正，因为没有更改此类问题的方法。
虽然只是更正了一小部分错误，此函数还是能更正最常见的地址错误，特别是在数据是
由帐户持有者自己输入时。
以下是上面所述函数的源代码。
// ---------------------------ooo------------------------------ \\
unit abSMTPRoutines;
interface
uses
  SysUtils, Classes;
// ---------------------------ooo------------------------------ \\
// 这些常量代表各种可能发生的检查错误。
// ---------------------------ooo------------------------------ \\
const
  flUnknown = 0;
  flNoSeperator = 1;
  flToSmall = 2;
  flUserNameToLong = 3;
  flDomainNameToLong = 4;
  flInvalidChar = 5;
  flMissingUser = 6;
  flMissingDomain = 7;
  flMissingDomainSeperator = 8;
  flMissingGeneralDomain = 9;
  flToManyAtSymbols = 10;
function ValidateEmailAddress(Email : String; var FailCode, FailPosition : I
nteger) : Boolean;
function CorrectEmailAddress(Email : String; var Suggestion : String; MaxCor
rections : Integer = 5) : Boolean;
function ValidationErrorString(Code : Integer) : String;
implementation
// ---------------------------ooo------------------------------ \\
// 这列出错误说明，它保留在实现部分，因为单元外部并不直接需要它，
// 可以通过进行范围检查的ValidationErrorString来对它访问。
// ---------------------------ooo------------------------------ \\
const
  ErrorDescriptions : array[0..10] of String = ('Unknown error occured!', 'M
issing @ symbol!', 'Data to small!', 'User name to long!',
  'Domain name to long!', 'Invalid character!', 'Missing user name!', 'Missi
ng domain name!',
  'Missing domain portion (.com,.net,etc)', 'Invalid general domain!', 'To m
any @ symbols!');
  AllowedEmailChars : set of Char = ['A','B','C','D','E','F','G','H','I','J'
,'K','L','M','N','O','P','Q','R','S','T',
'U','V','W','X','Y','Z','a','b','c','d','e','f','g','h','i','j','k','l','m',
'n',
'o','p','q','r','s','t','u','v','w','x','y','z','0','1','2','3','4','5','6',
'7',
'8','9','@','-','.','_', '''', '+', '$', '/', '%'];
  MaxUsernamePortion = 64; // Per RFC 821
  MaxDomainPortion = 256; // Per RFC 821
function CorrectEmailAddress;
var
  CurITT, RevITT, ITT, FailCode, FailPosition, LastAt : Integer;
begin
try
  // 重置建议
  Suggestion := Email;
  CurITT := 1;
  // 按最大深度循环
  for ITT := CurITT to MaxCorrections do // 循环
  begin
    // 深度检查地址
    if ValidateEmailAddress(Suggestion, FailCode, FailPosition) then
    begin
      // (若)email有效，退出。
      result := True;
      exit;
    end;
    // 否则尝试更正
    case FailCode of //
      flUnknown:
      begin
        // 此错误不能修正
        Result := False;
        exit;
      end;
      flNoSeperator:
      begin
        // 此错误可能通过找出最后的2（很可能要换成@）来更正
        LastAt := 0;
        for RevITT := 1 to Length(Suggestion) do // 开始循环
          // 寻找 2
          if Suggestion[RevITT] = '2' then LastAt := RevITT;
        end;
        if LastAt = 0 then
        begin
          // 不可能再改善，退出
          Result := False;
          exit;
        end;
        // 把2改成@并继续
        Suggestion[LastAt] := '@';
      end;
      flToSmall:
      begin
        // 不可能再改善，退出
        Result := False;
        exit;
      end;
      flUserNameToLong:
      begin
        // 不可能再改善，退出
        Result := False;
        exit;
      end;
      flDomainNameToLong:
      begin
        // 不可能再改善，退出
        Result := False;
        exit;
      end;
      flInvalidChar:
      begin
        // 只是删去错误字符
        Delete(Suggestion, FailPosition, 1);
      end;
      flMissingUser:
      begin
        // 不可能再改善，退出
        Result := False;
        exit;
      end;
      flMissingDomain:
      begin
        // 不可能再改善，退出
        Result := False;
        exit;
      end;
      flMissingDomainSeperator:
      begin
        // 此处我们最多后退三个空格插入一个a。不检查字符串的长度，我们将引
        // 起一个异常，因为至此无法进行改善。
        Insert('.', Suggestion, Length(Suggestion) - 2);
      end;
      flMissingGeneralDomain:
      begin
        // 不可能再改善，退出
        Result := False;
        exit;
      end;
      flToManyAtSymbols:
      begin
        // 不可能再改善，退出
        Result := False;
        exit;
      end;
    end;
  end;
  // 如果此处得到布林值"假"
  Result := False;
except
  //　返回"假"
  Result := false;
end;
end;
// ---------------------------ooo------------------------------ \\
// 本函数检查一个地址，内容远比按RFC（821）语法验证要多得多。
// ---------------------------ooo------------------------------ \\
function ValidateEmailAddress;
var
  DataLen, SepPos, Itt, DomainStrLen, UserStrLen, LastSep, SepCount, PrevSep
 : Integer;
  UserStr, DomainStr, SubDomain : String;
begin
try
  // 取数据长
  DataLen := Length(Email);
  // 保证字符串不空
  if DataLen = 0 then
  begin
    // 设定结果并退出
    FailCode := flToSmall;
    Result := False;
    Exit;
  end;
  // 第一次检查，验证@分隔符
  SepPos := Pos('@', Email);
  if SepPos = 0 then
  begin
    // 设定结果并退出
    FailCode := flNoSeperator;
    Result := False;
    Exit;
  end;
  // 现在只是验证系统中允许的字符
  for Itt := 1 to DataLen do // 循环
  begin allow
    // 确保是有效的字符
    if not (Email[Itt] in AllowedEmailChars) then
    begin
      //　报告无效字符错误和位置
      FailCode := flInvalidChar;
      FailPosition := Itt;
      result := False;
      exit;
    end;
  end;
  //　现在把字符串分成两个元素：用户名和域名
  UserStr := Copy(Email, 1, SepPos -1);
  DomainStr := Copy(Email, SepPos + 1, DataLen);
  //　用户名和域名缺省任一部分就表明有错误
  if (UserStr = '') then
  begin
    // 报告缺少的部分并退出
    FailCode := flMissingUser;
    Result := False;
    exit;
  end;
  if (DomainStr = '') then
  begin
    // 报告缺少的部分并退出
    FailCode := flMissingDomain;
    Result := False;
    exit;
  end;
  // 取得两部分的长度
  DomainStrLen := Length(DomainStr);
  UserStrLen := Length(UserStr);
  // 保证每一部分都不会太长。
  if DomainStrLen > MaxDomainPortion then
  begin
    FailCode := flDomainNameToLong;
    Result := False;
    exit;
  end;
  if UserStrLen > MaxUserNamePortion then
  begin
    FailCode := flUserNameToLong;
    Result := False;
    exit;
  end;
  // 现在检查用户名部分
  // 保证句号不是开头或结尾的字符（或是唯一的字符）
  // 检查第一个字符
  if (UserStr[1] = '.') then
  begin
    // 报告缺少部分并退出
    FailCode := flInvalidChar;
    Result := False;
    FailPosition := 1;
    exit;
  end;
  // 检查结尾字符
  if (UserStr[UserStrLen] = '.') then
  begin
    // 报告缺少部分并退出
    FailCode := flInvalidChar;
    Result := False;
    FailPosition := UserStrLen;
    exit;
  end;
  // 不需要直接检查单一字符，因为前面两个检查已检测到它。
  // 保证后面没有"."
  for Itt := 1 to UserStrLen do // 循环
  begin
    if UserStr[Itt] = '.' then
    begin
      // 检查下一个字符，保证它不是一个"."。
      if UserStr[Itt + 1] = '.' then
      begin
        //　报告错误
        FailCode := flInvalidChar;
        Result := False;
        FailPosition := Itt;
        exit;
      end;
    end;
  end;
  {至此用户名检查完，现将检查域名}
  // 保证句号不是开头或结尾的字符（或是唯一的字符）
  // 检查第一个字符
  if (DomainStr[1] = '.') then
  begin
    // 报告缺少部分并退出
    FailCode := flInvalidChar;
    Result := False;
// 这个位置要加上用户名部分以取得正确的数目，为缺少的@而+ 1
    FailPosition := UserStrLen + 2;
    exit;
  end;
  //　检查结束字符
  if (DomainStr[DomainStrLen] = '.') then
  begin
    //　报告缺少部分并退出
    FailCode := flInvalidChar;
    Result := False;
// 这个位置要加上用户名部分以取得正确的数量，为缺少的@而+ 1
    FailPosition := UserStrLen + 1 + DomainStrLen;
    exit;
  end;
 // 不需要直接检查单一字符，因为前面两个检查已检测到它。
 // 保证后面没有"."，并在循环中计算
 // 句号数，记录最后一个，检查项目时还检查域名和子域名不以-开头或结尾。
  SepCount := 0;
  LastSep := 0;
  PrevSep := 1; // 字符串开头
  for Itt := 1 to DomainStrLen do // 循环
  begin
    if DomainStr[Itt] = '.' then
    begin
      //检查下一个字符，保证它不是"."
      if DomainStr[Itt + 1] = '.' then
      begin
        // 报告错误
        FailCode := flInvalidChar;
        Result := False;
        FailPosition := UserStrLen + 1 + Itt;
        exit;
      end;
      // 增加计数，记录下一个sep
      Inc(SepCount);
      LastSep := Itt;
      // 现检查域名
      SubDomain := Copy(DomainStr, PrevSep, (LastSep) - PrevSep);
      // 保证不是以"-"开头
      if SubDomain[1] = '-' then
      begin
        FailCode := flInvalidChar;
        Result := False;
        FailPosition := UserStrLen + 1 + (PrevSep);
        exit;
      end;
      // 保证不是以 "-" 结尾
      if SubDomain[Length(SubDomain)] = '-' then
      begin
        FailCode := flInvalidChar;
        Result := False;
        FailPosition := (UserStrLen + 1) + LastSep - 1;
        exit;
      end;
      // 更新指针
      PrevSep := LastSep + 1;
    end
    else
    begin
      if DomainStr[Itt] = '@' then
      begin
        // 报告错误
        FailPosition := UserStrLen + 1 + Itt;
        FailCode := flToManyAtSymbols;
        result := False;
        exit;
      end;
    end;
  end;
  // 验证至少有一个"."
  if SepCount < 1 then
  begin
    FailCode := flMissingDomainSeperator;
    Result := False;
    exit;
  end;
　// 对域名的最后一部分，通常为(.com)做一些扩展工作。验证最低一级有至少两个字
符。
  SubDomain := Copy(DomainStr, LastSep, DomainStrLen);
  if Length(SubDomain) < 2 then
  begin
    FailCode := flMissingGeneralDomain;
    Result := False;
    exit;
  end;
　// 最后，我们得到合法地址
  Result := True;
except
  Result := False;
  FailCode := -1;
end;
end;
// ---------------------------ooo------------------------------ \\
// 本函数从常量数组中返回错误字符串，保证错误码是有效的，否则返回非法错误字符
串。
// ---------------------------ooo------------------------------ \\
function ValidationErrorString(Code : Integer) : String;
begin
// 保证传递了有效的错误码
if (Code < Low(ErrorDescriptions)) or (Code > High(ErrorDescriptions)) then
begin
  Result := 'Invalid error code!';
  exit;
end;
// 从常量数组取得错误说明
Result := ErrorDescriptions[Code];
end;
end.
投稿人：grhunter　投稿日期：2001-8-22 21:18:00
本文共有评论1篇︱已被阅读过281次︱查看评论
　　　评论内容：
　　
【关闭窗口】

--
°★．☆° ．★·°∴°★．°·∴°☆ ·°∴° ☆．．·°∴°．☆°★°∴°

※ 来源:·哈工大紫丁香 bbs.hit.edu.cn·[FROM: 202.118.230.122]