RE: Historical Question

I asked about email validation a few weeks ago. And it can become a very deep
subject in a hurry.  Everybody has their own way of doing it.  The best way to
do it is to use something called Regular Expression.  Which RPGIV does not
currently support.  I did eventually find some Delphi code that was very
promising.  I took that and converted it to RPG IV.  Below are the results.  Now
this just does "syntax" checking. It will not check if the email address is
really valid.  I have not thoroughly checked this code to make sure it works in
ALL cases, but it has work for me so far.  So if you find any bugs or such,
please let me know.

-- Scott J.


      //===============================================================*
      //  Validate Email                                               *
      //---------------------------------------------------------------*
     P $VldEmail       B                   EXPORT

     D $VldEmail       PI              N
     D VE#Email                     129A   Const

      // State Code Constants
     D S_BEGIN         C                   'A'
     D S_ATOM          C                   'B'
     D S_QTEXT         C                   'C'
     D S_QCHAR         C                   'D'
     D S_QUOTE         C                   'E'
     D S_LOCAL_PERIOD  C                   'F'
     D S_EXP_SUBDOM    C                   'G'
     D S_SUBDOMAIN     C                   'H'
     D S_HYPHEN        C                   'I'

      // Valid Character Constants
     D atom_chars      C                   '!#$%&''*+-=?^_`{|}~-
     D                                     ABCDEFGHIJKLMNOPQRSTUVWXYZ-
     D                                     abcdefghijklmnopqrstuvwxyz-
     D                                     0123456789'
     D quoted_chars    C                   ' !#$%&''()*+,-./:;<=>?@[]^_`{|}~-
     D                                     ABCDEFGHIJKLMNOPQRSTUVWXYZ-
     D                                     abcdefghijklmnopqrstuvwxyz-
     D                                     0123456789'
     D letter_chars    C                   'ABCDEFGHIJKLMNOPQRSTUVWXYZ-
     D                                     abcdefghijklmnopqrstuvwxyz'
     D letnbr_chars    C                   'ABCDEFGHIJKLMNOPQRSTUVWXYZ-
     D                                     abcdefghijklmnopqrstuvwxyz-
     D                                     0123456789'
     D subdom_chars    C                   'ABCDEFGHIJKLMNOPQRSTUVWXYZ-
     D                                     abcdefghijklmnopqrstuvwxyz-
     D                                     0123456789-'

     D State           S              1A
     D c               S              1A
     D i               S              5U 0
     D n               S              5U 0
     D subdomains      S              5U 0

      /FREE

        State = S_BEGIN;
        n = %Len(%TrimR(VE#Email));
        i = 1;
        subdomains = 1;
        DoW (i <= n);
          c = %SubSt(VE#Email:i:1);
          Select;
          When State = S_BEGIN;
            if %scan(c:atom_chars) > 0;
              State = S_ATOM;
            elseif c = '"';
              State = S_QTEXT;
            else;
              i = n + 1;
            EndIf;
          When State = S_ATOM;
            if c = '@';
              State = S_EXP_SUBDOM;
            elseif c = '.';
              State = S_LOCAL_PERIOD;
            elseif %scan(c:atom_chars) = 0;
              i = n + 1;
            EndIf;
          When State = S_QTEXT;
            if c = '\';
              State = S_QCHAR;
            elseif c = '"';
              State = S_QUOTE;
            elseif %scan(c:quoted_chars) = 0;
              i = n + 1;
            EndIf;
          When State = S_QCHAR;
            State = S_QTEXT;
          When State = S_QUOTE;
            if c = '@';
              State = S_EXP_SUBDOM;
            elseif c = '.';
              State = S_LOCAL_PERIOD;
            else;
              i = n + 1;
            EndIf;
          When State = S_LOCAL_PERIOD;
            if %scan(c:atom_chars) > 0;
              State = S_ATOM;
            elseif c = '"';
              State = S_QTEXT;
            else;
              i = n + 1;
            EndIf;
          When State = S_EXP_SUBDOM;
            if %scan(c:letter_chars) > 0;
              State = S_SUBDOMAIN;
            else;
              i = n + 1;
            EndIf;
          When State = S_SUBDOMAIN;
            if c = '.';
              subdomains = subdomains + 1;
              State = S_EXP_SUBDOM;
            elseif c = '-';
              State = S_HYPHEN;
            elseif %scan(c:letnbr_chars) = 0;
              i = n + 1;
            EndIf;
          When State = S_HYPHEN;
            if %scan(c:letnbr_chars) > 0;
              State = S_SUBDOMAIN;
            elseif c <> '-';
              i = n + 1;
            EndIf;
          EndSl;
          i = i + 1;
        EndDo;
        if i <= n;
          Return  *Off;
        else;
          If State = S_SUBDOMAIN and subdomains >= 2;
            Return *On;
          Else;
            Return *Off;
          EndIf;
        EndIf;

      /END-FREE

     P $VldEmail       E







> -----Original Message-----
> From: rpg400-l-bounces@xxxxxxxxxxxx
> [mailto:rpg400-l-bounces@xxxxxxxxxxxx]On Behalf Of Martin, Steve
> (MAN-Golden)
> Sent: Friday, November 21, 2003 12:21 PM
> To: 'RPG400-L@xxxxxxxxxxxx'
> Subject: Historical Question
>
>
> Hello, I'm new to the list and I'm sure my question has been
> answered in the
> past. I went to the Midrange[dot]com site and searched for an
> RPG[LE] email
> validation routine, but I didn't quickly find an answer.
>
> Can someone direct me at a past article or code sample?
>
> Thank you
>
> Steve