midrange.com code scratchpad
Name:
Email Format Validation
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
10/26/2009 03:43:30 pm
IP:
Logged
Description:
Base on ^[A-Z0-9._%-]+@[A-Z0-9.-]+.[A-Z]{2,4}$
Code:
  1.      D UPPER_CASE      c                   const('ABCDEFGHIJKLMNOPQRSTUVWXYZ')
  2.      D LOWER_CASE      c                   const('abcdefghijklmnopqrstuvwxyz')
  3.      D SUCCESSFUL      c                   const('1')  
  4.  
  5.      P emlIsValid      b                   Export
  6.      D emlIsValid      pi             1n
  7.      D  piEml                              like($EML) const
  8.  
  9.      D @pos            s              5i 0
  10.      D dotPos          s              5i 0
  11.      D myEmailAdr      s            255    varying
  12.      D myRecipient     s            255    varying
  13.      D myDomainName    s            255    varying
  14.      D myDomainType    s            255    varying
  15.      D myValidRecipientChar...
  16.      D                 c                   const('ABCDEFGHIJKLMNOPQRSTUVWXYZ012-
  17.      D                                     3456789._%-')
  18.      D myValidDomainNameChar...
  19.      D                 c                   const('ABCDEFGHIJKLMNOPQRSTUVWXYZ012-
  20.      D                                     3456789.-')
  21.      D myValidDomainTypeChar...
  22.      D                 c                   const('ABCDEFGHIJKLMNOPQRSTUVWXYZ')
  23.  
  24.       /free
  25.  
  26.        // check for format of email base on this regular expression
  27.        //^[A-Z0-9._%-]+@[A-Z0-9.-]+\.[A-Z]{2,4}$'
  28.        //http://systeminetwork.com/article/validate-e-mail-address-regular-expression
  29.  
  30.        exsr parseEmail;
  31.  
  32.        // make sure the recipient portion is correct
  33.        if %len(myRecipient) = 0 or
  34.           %check(myValidRecipientChar :myRecipient) > 0;
  35.          return not SUCCESSFUL;
  36.        endif;
  37.  
  38.        // make sure the domain portion is correct
  39.        if %len(myDomainName) = 0 or
  40.           %check(myValidDomainNameChar :myDomainName) > 0;
  41.          return not SUCCESSFUL;
  42.        endif;
  43.  
  44.        // make sure the domain type portion is correct
  45.        if not (%len(myDomainType) >=2 and
  46.                %len(myDomainType) <=4) or
  47.           %check(myValidDomainTypeChar :myDomainType) > 0;
  48.          return not SUCCESSFUL;
  49.        endif;
  50.  
  51.        return SUCCESSFUL;
  52.  
  53.  
  54.        //*******************************************************
  55.        // parse the email into recipient/domain/dimainType
  56.        //*******************************************************
  57.        begsr parseEmail;
  58.  
  59.          myEmailAdr = %trim(piEml);
  60.          myEmailAdr = %xlate(LOWER_CASE :UPPER_CASE :myEmailAdr);
  61.  
  62.          // parse out the recipient
  63.          @pos = %scan('@' :myEmailAdr);
  64.          if @pos > 1;
  65.            myRecipient = %subst(myEmailAdr :1 :@pos-1);
  66.          endif;
  67.  
  68.          // parse out the Domain
  69.          if %len(myRecipient) > 0;
  70.            for dotPos = %len(myEmailAdr) downto @pos+1;
  71.              if %subst(myEmailAdr :dotPos :1) = '.';
  72.                leave;
  73.              endif;
  74.            endfor;
  75.  
  76.            if dotPos > @pos+1;
  77.              myDomainName = %subst(myEmailAdr :@pos+1 :dotPos-@pos-1);
  78.            endif;
  79.          endif;
  80.  
  81.          // parse out the Domain type
  82.          if %len(myDomainName) > 0;
  83.            if %len(myEmailAdr) > dotPos;
  84.              myDomainType = %subst(myEmailAdr :dotPos+1);
  85.            endif;
  86.          endif;
  87.  
  88.        endsr;
  89.  
  90.       /end-free
  91.  
  92.      p emlIsValid      e   
© 2004-2019 by midrange.com generated in 0.007s valid xhtml & css