/************************************************************************
         AUTHOR: Speedy Mercer 
        WEBSITE: http://www.herohog.com
         E-MAIL: code AT herohog.com
          LEGAL: This program is provided for FREE. All I ask is that you give 
                 credit where credit is due if you use it. 
                 There is NO warranty either written or implied.
           DATE: 8/17/2004
          TAKES: An Email address
        RETURNS: True if valid format, False if not
          USAGE: {validateEmail.i}
                 DISP EmailCheck("someone@spamthis.com"). 
          NOTES: This validation DOES NOT 100% adhere to IPv6 and the RFCs
                 as it makes the following assumptions:
                 
                 There will be no more than 1 "@".
                 There must be at least one "!" if there are no "@".
                 If quotes are used, they must be in pairs.
                 If spaces are used they must be within quotes.
                 The following chars are NOT allowed "<>{}~|/\;*".
                 ASCII chars < 32 and > 126 are NOT allowed.
                 The following chars can NOT be 1st OR last "@!.".
******************************************************************************/
FUNCTION EmailCheck RETURNS LOGICAL (INPUT ipcEmail AS CHARACTER).
   DEF VAR i AS INTEGER NO-UNDO.
   
   IF (INDEX(ipcEmail, "@") = 0                 /* Must have at least an AT sign OR ! */
       AND 
       INDEX(ipcEmail, "!") = 0)
   OR INDEX(ipcEmail, "@") = 1                  /* AT sign can not be 1st char */
   OR INDEX(ipcEmail, "@") = LENGTH(ipcEmail)   /* AT sign can not be last char */
   OR (NUM-ENTRIES(ipcEmail, "@") <> 2          /* AT sign can only appear once unless using Bang */
       AND
       INDEX(ipcEmail, "!") = 0)
   OR (INDEX(ipcEmail, ".") = 0                 /* Must have at least one Period OR Bang */
       AND 
       INDEX(ipcEmail, "!") = 0)
   OR INDEX(ipcEmail, ".") = 1                  /* Period can not be 1st char */
   OR INDEX(ipcEmail, ".") = LENGTH(ipcEmail)   /* Period can not be last char */
   OR INDEX(ipcEmail, "!") = 1                  /* Bang can not be 1st char */
   OR INDEX(ipcEmail, "!") = LENGTH(ipcEmail)   /* Bang can not be last char */
   OR INDEX(ipcEmail, "<") <> 0                 /* Must NOT have a Less-Than sign */
   OR INDEX(ipcEmail, ">") <> 0                 /* Must NOT have a Greater-Than sign */
   OR INDEX(ipcEmail, "\") <> 0                 /* Must NOT have a back-slash */
   OR INDEX(ipcEmail, "/") <> 0                 /* Must NOT have a front-slash */
   OR INDEX(ipcEmail, ";") <> 0                 /* Must NOT have a semicolon */
   OR INDEX(ipcEmail, ",") <> 0                 /* Must NOT have a comma */
   OR INDEX(ipcEmail, "*") <> 0                 /* Must NOT have a asterisk */
   OR INDEX(ipcEmail, "~~") <> 0                /* Must NOT have a ~ */
   OR INDEX(ipcEmail, "~}") <> 0                /* Must NOT have a } */
   OR INDEX(ipcEmail, "~{") <> 0                /* Must NOT have a { */
   OR INDEX(ipcEmail, "|") <> 0                 /* Must NOT have a | */
   OR (INDEX(ipcEmail, "'") > 0                 /* NO Quotes OR a pair of Quotes are OK */
       AND 
       NUM-ENTRIES(ipcEmail, "'") <> 3)
   OR (INDEX(ipcEmail, '"') > 0                 /* NO Quotes OR a pair of Quotes are OK */
       AND 
       NUM-ENTRIES(ipcEmail, '"') <> 3)
   OR (INDEX(ipcEmail, " ") > 0                 /* Spaces ONLY allows within quotes */
       AND 
       INDEX(ipcEmail, "'") > 0
       AND 
       NUM-ENTRIES(ipcEmail, "'") <> 3)
   OR (INDEX(ipcEmail, " ") > 0                 /* Spaces ONLY allows within quotes */
       AND 
       INDEX(ipcEmail, '"') > 0
       AND 
       NUM-ENTRIES(ipcEmail, '"') <> 3)
   OR (INDEX(ipcEmail, "@") <> 0                /* Must have a period OR Bang after the AT sign */
       AND INDEX(ENTRY(2, ipcEmail, "@"), ".") = 0  
       AND INDEX(ENTRY(2, ipcEmail, "@"), "!") = 0)
   THEN RETURN FALSE.
   ELSE DO i = 1 TO LENGTH(ipcEmail):           /* Check for invalid ASCII Characters */
      IF ASC(SUBSTRING(ipcEmail, i, 1)) < 32
      OR ASC(SUBSTRING(ipcEmail, i, 1)) > 126
      THEN RETURN FALSE.
   END.

   /* If we made it this far, we are ok */
   RETURN TRUE.
END FUNCTION. /* EmailCheck */