Now the world of the email address is surprisingly treacherous. There are some good standards, but many if not most mail servers do not fully comply with them. So, when your app tests an email address, the test should be to see if your mail server can handle it.
The code below (no regex!) is Windows only because of it's use of RTF in an editor gadget. It assumes that at run time your app will collect an email address, Trim() any spaces, then pass the address on for checking. Modify the permitted chars accordingly to suit your mail server - most will only allow a few 'special' chars.
Code: Select all
;Reference: https://en.wikipedia.org/wiki/Email_address#Internationalization
;The transmission of electronic mail within the Internet uses the Simple Mail Transfer Protocol (SMTP),
;defined in Internet standards RFC 5321/RFC 5322 and extensions like RFC 6531
;The 'rules' below ignore Internationalization. If your mail server is compliant with RFC6530, then UTF8 chars
;are acceptable and email addresses can be in any language. You would then need lists of 'not permitted chars'
;rather than lists of 'permitted chars'. However, not even Google GMail or Microsoft Outlook allow non-ASCII
;email addresses to be registered, to date (2016-09-03).
;RULES !***! = Consider avoiding as not supported universally
;Modify these rules to suit your mail server
;1) must have '@'
;2) must have only 1 '@'
;3) no leading or trailing spaces
;4) Local Part can use:
;4a) Ascii A to Z and a to z
;4b) Digits 0 to 9
;4c) Special chars !#$%&'*+-/=?^_`{|}~ !***!
;4d) Dot '.'
;4e) Comments in brackets (comment) !***!
;4f) Max length 64 chars
;4g) International chars encoded as UTF8, re RFC 6531 !***!
;4h) Quoted string format allowed !***!
;4i) Spaces !***!
;5) Local Part cannot use:
;5a) Dot '.' as first or last char (unless in a quoted string)
;5b) Consecutive dots '..' '...' etc (unless in a quoted string)
;6) Domain Part can use:
;6a) Ascii A to Z and a to z
;6b) Digits 0 to 9
;6c) Hyphen '-'
;6d) Literal IP Address in square brackets e.g. [192.168.2.1] or [IPv6:2001:db8::1] !***!
;6e) Comments in brackets (comment) !***!
;6f) Max total length = (254 - Local Part Length)
;6g) Max length of each dot-seperated part = 63
;7) Domain Part cannot use:
;7a) Hyphen '-' as first or last char
;7b) Consecutive dots '..' '...' etc
#MaxEmailLocalPartLen = 64
#MaxEmailDomainSubLen = 63
#MaxEmailWholeLength = 254
Enumeration
#WinEmailInvalid
#LstEmailInvalid
#EdEmailInvalid
#BtnEmailInvalid
#Font08R
#Font10B
#Font12R
EndEnumeration
Structure CharPos
iStartChar.i
iEndChar.i
iLstItem.i
EndStructure
Global NewList gCharPos.CharPos()
XIncludeFile "..\Editor Rtf Functions.pbi"
Global igDpi.i = GetDeviceCaps_(GetDC_(0),#LOGPIXELSX)
Global igFS08.i = (( 8 * 100) / igDpi)
Global igFS10.i = ((10 * 100) / igDpi)
Global igFS12.i = ((12 * 100) / igDpi)
LoadFont(#Font08R, "Microsoft Sans Serif", igFS08, #PB_Font_HighQuality)
LoadFont(#Font10B, "Microsoft Sans Serif", igFS10, #PB_Font_HighQuality | #PB_Font_Bold)
LoadFont(#Font12R, "Microsoft Sans Serif", igFS12, #PB_Font_HighQuality)
Procedure CheckEmailAddress(sEmail.s)
;#-----------------------------------
;Note, the Email address should ideally be passed 'pre trimmed' of leading/trailing spaces
;You don't really want to bother your customer just for that.....
Protected iLastAtChar.i = CountString(sEmail, Chr(64)) + 1
Protected sLocalPart.s = StringField(sEmail, 1, Chr(64))
Protected sDomainPart.s = StringField(sEmail, iLastAtChar, Chr(64))
Protected sChar.s, sSub.s
Protected sConsecutiveDots.s = Chr(46) + Chr(46)
Protected sPermittedDomChars.s = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789[]:-."
Protected sPermittedLocalChars.s = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!#$%&'*+-/=?^_`{|}~."
Protected iDomStart.i = Len(sLocalPart) + 1
Protected iFaultFound.i = #False
Protected iSqrOpenBrktFound.i = 0
Protected iSqrCloseBrktFound.i = 0
Protected iExcess.i, iFind.i, iPos.i, iStart.i, iCharPos.i, iLen.i
Protected iHiLite.i = RGB(128,255,0)
ClearGadgetItems(#LstEmailInvalid)
ClearList(gCharPos())
;Permitted local chars check
iLen = Len(sLocalPart)
For iCharPos = 1 To iLen
sChar = Mid(sLocalPart, iCharPos, 1)
iPos = FindString(sPermittedLocalChars, sChar, 1, #PB_String_NoCase)
If(iPos = 0)
iFaultFound = #True
AddGadgetItem(#LstEmailInvalid, -1, "disallowed char")
AddElement(gCharPos())
gCharPos()\iStartChar = iCharPos
gCharPos()\iEndChar = iCharPos + 1
gCharPos()\iLstItem = CountGadgetItems(#LstEmailInvalid) - 1
EndIf
Next
;Permitted domain chars check
iLen = Len(sDomainPart)
For iCharPos = 1 To iLen
sChar = Mid(sDomainPart, iCharPos, 1)
iPos = FindString(sPermittedDomChars, sChar, 1, #PB_String_NoCase)
If(iPos = 0)
iFaultFound = #True
AddGadgetItem(#LstEmailInvalid, -1, "disallowed char")
AddElement(gCharPos())
gCharPos()\iStartChar = iCharPos + iDomStart
gCharPos()\iEndChar = iCharPos + iDomStart + 1
gCharPos()\iLstItem = CountGadgetItems(#LstEmailInvalid) - 1
EndIf
If(Asc(sChar) = 91) : iSqrOpenBrktFound = iCharPos + iDomStart : EndIf ;[
If(Asc(sChar) = 93) : iSqrCloseBrktFound = iCharPos + iDomStart : EndIf ;]
Next
If FindString(sPermittedDomChars, Chr(91), 1, #PB_String_NoCase) ;[
If((iSqrOpenBrktFound > 0) And (iSqrCloseBrktFound = 0))
AddGadgetItem(#LstEmailInvalid, -1, "missing bracket ]")
AddElement(gCharPos())
gCharPos()\iStartChar = iSqrOpenBrktFound
gCharPos()\iEndChar = iSqrOpenBrktFound + 1
gCharPos()\iLstItem = CountGadgetItems(#LstEmailInvalid) - 1
EndIf
If((iSqrOpenBrktFound = 0) And (iSqrCloseBrktFound > 0))
AddGadgetItem(#LstEmailInvalid, -1, "missing bracket [")
AddElement(gCharPos())
gCharPos()\iStartChar = iSqrCloseBrktFound
gCharPos()\iEndChar = iSqrCloseBrktFound + 1
gCharPos()\iLstItem = CountGadgetItems(#LstEmailInvalid) - 1
EndIf
EndIf
iFound = CountString(sEmail, Chr(64)) ;@
If(iFound > 1)
iFaultFound = #True
iPos = -1
For iCnt = 1 To iFound
iPos = FindString(sEmail, Chr(64), iPos + 1, #PB_String_NoCase)
AddGadgetItem(#LstEmailInvalid, -1, "too many '@'")
AddElement(gCharPos())
gCharPos()\iStartChar = iPos
gCharPos()\iEndChar = iPos + 1
gCharPos()\iLstItem = CountGadgetItems(#LstEmailInvalid) - 1
Next
ElseIf(iFound = 0) : iFaultFound = #True : AddGadgetItem(#LstEmailInvalid, -1, "missing '@'") : EndIf
iFound = CountString(sEmail, Chr(32)) ;space
If(iFound > 0)
iFaultFound = #True
iPos = -1
For iCnt = 1 To iFound
iPos = FindString(sEmail, Chr(32), iPos + 1, #PB_String_NoCase)
AddGadgetItem(#LstEmailInvalid, -1, "space disallowed")
AddElement(gCharPos())
gCharPos()\iStartChar = iPos
gCharPos()\iEndChar = iPos + 1
gCharPos()\iLstItem = CountGadgetItems(#LstEmailInvalid) - 1
Next
EndIf
iFound = CountString(sEmail, sConsecutiveDots) ;consecutive dots
If(iFound > 0)
iFaultFound = #True
iPos = -1
For iCnt = 1 To iFound
iPos = FindString(sEmail, sConsecutiveDots, iPos + 1, #PB_String_NoCase)
AddGadgetItem(#LstEmailInvalid, -1, "consecutive dots disallowed")
AddElement(gCharPos())
gCharPos()\iStartChar = iPos
gCharPos()\iEndChar = iPos + 2
gCharPos()\iLstItem = CountGadgetItems(#LstEmailInvalid) - 1
Next
EndIf
sChar = Left(sEmail, 1) ;dot prefix?
If(sChar = Chr(46))
iFaultFound = #True
iPos = 1
AddGadgetItem(#LstEmailInvalid, -1, "dot prefix disallowed")
AddElement(gCharPos())
gCharPos()\iStartChar = iPos
gCharPos()\iEndChar = iPos + 1
gCharPos()\iLstItem = CountGadgetItems(#LstEmailInvalid) - 1
EndIf
sChar = Right(sEmail, 1) ;dot postfix?
If(sChar = Chr(46))
iFaultFound = #True
iPos = Len(sEmail)
AddGadgetItem(#LstEmailInvalid, -1, "dot postfix disallowed")
AddElement(gCharPos())
gCharPos()\iStartChar = iPos
gCharPos()\iEndChar = iPos + 1
gCharPos()\iLstItem = CountGadgetItems(#LstEmailInvalid) - 1
EndIf
sChar = Right(sLocalPart, 1) ;dot postfix?
If(sChar = Chr(46))
iFaultFound = #True
iPos = Len(sLocalPart)
AddGadgetItem(#LstEmailInvalid, -1, "dot postfix disallowed")
AddElement(gCharPos())
gCharPos()\iStartChar = iPos
gCharPos()\iEndChar = iPos + 1
gCharPos()\iLstItem = CountGadgetItems(#LstEmailInvalid) - 1
EndIf
If(Len(sLocalPart) > #MaxEmailLocalPartLen)
iFaultFound = #True
iExcess = Len(sLocalPart) - #MaxEmailLocalPartLen
AddGadgetItem(#LstEmailInvalid, -1, sLocalPart + " too long by " + Str(iExcess))
AddElement(gCharPos())
gCharPos()\iStartChar = #MaxEmailLocalPartLen
gCharPos()\iEndChar = #MaxEmailLocalPartLen + iExcess
gCharPos()\iLstItem = CountGadgetItems(#LstEmailInvalid) - 1
EndIf
If(Len(sEmail) > #MaxEmailWholeLength)
iFaultFound = #True
iExcess = Len(sEmail) - #MaxEmailWholeLength
AddGadgetItem(#LstEmailInvalid, -1, "address too long by " + Str(iExcess))
AddElement(gCharPos())
gCharPos()\iStartChar = #MaxEmailWholeLength
gCharPos()\iEndChar = #MaxEmailWholeLength + iExcess
gCharPos()\iLstItem = CountGadgetItems(#LstEmailInvalid) - 1
EndIf
iFound = CountString(sDomainPart, Chr(46)) ;dot
If(iFound > 1)
iSubStart = 0
For iCnt = 1 To iFound
sSub = StringField(sDomainPart, iCnt, Chr(46))
If(Len(sSub) > #MaxEmailDomainSubLen)
iFaultFound = #True
iExcess = Len(sSub) - #MaxEmailDomainSubLen
AddGadgetItem(#LstEmailInvalid, -1, "Domain Sub too long by " + Str(iExcess))
AddElement(gCharPos())
gCharPos()\iStartChar = iSubStart + #MaxEmailDomainSubLen
gCharPos()\iEndChar = iSubStart + #MaxEmailDomainSubLen + iExcess
gCharPos()\iLstItem = CountGadgetItems(#LstEmailInvalid) - 1
EndIf
iSubStart = Len(sSub) + 1
Next
EndIf
sChar = Left(sDomainPart, 1) ;hyphen prefix?
If(sChar = Chr(45))
iFaultFound = #True
AddGadgetItem(#LstEmailInvalid, -1, "hyphen prefix disallowed")
AddElement(gCharPos())
gCharPos()\iStartChar = iDomStart + 1
gCharPos()\iEndChar = iDomStart + 2
gCharPos()\iLstItem = CountGadgetItems(#LstEmailInvalid) - 1
EndIf
sChar = Right(sDomainPart, 1) ;hyphen postfix?
If(sChar = Chr(45))
iFaultFound = #True
iPos = Len(sEmail)
AddGadgetItem(#LstEmailInvalid, -1, "hyphen postfix disallowed")
AddElement(gCharPos())
gCharPos()\iStartChar = iPos
gCharPos()\iEndChar = iPos + 1
gCharPos()\iLstItem = CountGadgetItems(#LstEmailInvalid) - 1
EndIf
;Highlight all faults
If(iFaultFound = #True)
SetGadgetText(#EdEmailInvalid, sEmail)
ForEach gCharPos()
Editor_Select(#EdEmailInvalid, 0, gCharPos()\iStartChar, 0, gCharPos()\iEndChar)
Editor_BackColour(#EdEmailInvalid, iHiLite)
Next
Editor_CursorToEot(#EdEmailInvalid) ;Set cursor at end of text
HideWindow(#WinEmailInvalid, #False)
StickyWindow(#WinEmailInvalid, #True)
EndIf
EndProcedure
Procedure WinEmailInvalid()
;#-------------------------
If OpenWindow(#WinEmailInvalid, 0, 0, 568, 58, "Sorry, email address invalid on our mail server", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_Invisible | #PB_Window_ScreenCentered)
WindowBounds(#WinEmailInvalid, 568, 58, #PB_Ignore, 58)
SetWindowColor(#WinEmailInvalid, 14024661)
ListViewGadget(#LstEmailInvalid, 0, 0, 200, 58)
EditorGadget(#EdEmailInvalid, 204, 4, 360, 25, #PB_Editor_ReadOnly)
ButtonGadget(#BtnEmailInvalid, 204, 32, 360, 25, "OK")
SetGadgetFont(#LstEmailInvalid, FontID(#Font08R))
SetGadgetColor(#LstEmailInvalid, #PB_Gadget_FrontColor, 3224832)
SetGadgetColor(#LstEmailInvalid, #PB_Gadget_BackColor, 14024661)
SetGadgetFont(#EdEmailInvalid, FontID(#Font12R))
SetGadgetColor(#EdEmailInvalid, #PB_Gadget_FrontColor, 3224832)
Editor_JustifyPara(#EdEmailInvalid, #PFA_CENTER)
SetGadgetFont(#BtnEmailInvalid, FontID(#Font10B))
EndIf
EndProcedure
Procedure EmailInvalidWait()
;#--------------------------
Protected iEvent.i = 0, iItem.i = -1
Protected iExit.i = #False
Protected iHiLite.i = RGB(255,55,255)
Repeat
iEvent = WaitWindowEvent(1)
Select iEvent
Case #PB_Event_CloseWindow
If EventWindow() = #WinEmailInvalid
HideWindow(#WinEmailInvalid, #True)
StickyWindow(#WinEmailInvalid, #False)
iExit = #True
EndIf
Case #PB_Event_SizeWindow
If EventWindow() = #WinEmailInvalid
ResizeGadget(#EdEmailInvalid, #PB_Ignore, #PB_Ignore, WindowWidth(#WinEmailInvalid) - 208, #PB_Ignore)
ResizeGadget(#BtnEmailInvalid, #PB_Ignore, #PB_Ignore, WindowWidth(#WinEmailInvalid) - 208, #PB_Ignore)
EndIf
Case #PB_Event_Gadget
Select EventGadget()
Case #BtnEmailInvalid: HideWindow(#WinEmailInvalid, #True) : StickyWindow(#WinEmailInvalid, #False) : iExit = #True
Case #LstEmailInvalid
iItem = GetGadgetState(#LstEmailInvalid)
If(iItem > -1)
ForEach gCharPos()
If gCharPos()\iLstItem = iItem
Editor_Select(#EdEmailInvalid, 0, gCharPos()\iStartChar, 0, gCharPos()\iEndChar)
Break
EndIf
Next
EndIf
EndSelect
EndSelect
Until iExit = #True
EndProcedure
;=== Example ========================================
WinEmailInvalid()
CheckEmailAddress("donald..duck2016@-gmail...co[uk-")
EmailInvalidWait()
Edit:
Added 'iLastAtChar' because the Domain Part of the address would not be extracted if there were two @@ in a row.
Added 'ClearList(gCharPos())' after 'ClearGadgetItems(#LstEmailInvalid)' since CheckEmailAddress() could be re-visited in the same session.