Checking e-mail address syntax in PlayBASIC

[Adaz]

I'm very productive today :)
Here is an e-mail address syntax checking function I wrote today.

It returns -1 if the syntax is correct, otherwise various positive numbers so you can determine the cause of the syntax error.

Please feel free to post comments / suggestions.

PlayBASIC Code: [Select]

Function EmailSyntaxOK(email$)
  l=Len(email$): If l<6 Or l>50: Exitfunction 1: EndIf

  Local index                  ; Position in email$
  Local CountAt               ; Number of "@"
  Local LastDotPos         ; Position of the previous dot in the string
  Local CurrentChar$      ; Buffer that holds the contents of the string one char at a time.

   allowedcharacters$="qwertzuiopasdfghjklyxcvbnmQWERTZUIOPASDFGHJKLYXCVBNM._-@1234567890"
   valid4extensions$=".aero.info.coop.name"
   valid3extensions$=".pro.biz.int.com.net.org.edu.gov.mil"
   valid2extensions$=".af.al.dz.as.ad.ao.ai.aq.ag.ar.am.aw.ac.au.at.az.bh.bd.bb.by.be.bz.bj.bm.bt.bo.ba.bw.bv.br.io.bn.bg.bf.bi.kh.cm.ca.cv.cf.td.cl.cn.cx.cc.co.km.cg.cd.ck.cr.ci.hr.cu.cy.cz.dk.dj.dm.do.tp.ec.eg.sv.gq.er.ee.et.fk.fo.fj.fi.fr.gf.pf.tf.fx.ga.gm.ge.de.gh.gi.gr.gl.gd.gp.gu.gt.gg.gn.gw.gy.ht.hm.hn.hk.hu.is.in.id.ir.iq.ie.im.il.it.jm.jp.je.jo.kz.ke.ki.kp.kr.kw.kg.la.lv.lb.ls.lr.ly.li.lt.lu.mo.mk.mg.mw.my.mv.ml.mt.mh.mq.mr.mu.yt.mx.fm.md.mc.mn.ms.ma.mz.mm.na.nr.np.nl.an.nc.nz.ni.ne.ng.nu.nf.mp.no.om.pk.pw.pa.pg.py.pe.ph.pn.pl.pt.pr.qa.re.ro.ru.rw.sh.kn.lc.pm.vc.ws.sm.st.sa.sn.sc.sl.sg.sk.si.sb.so.za.gs.es.lk.sd.sr.sj.sz.se.ch.sy.tw.tj.tz.th.bs.ky.tg.tk.to.tt.tn.tr.tm.tc.tv.ug.ua.ae.uk.us.um.uy.uz.vu.va.ve.vn.vg.vi.wf.eh.ye.yu.zm.zw"

   ;check for disallowed characters
   For i=1 To Len(email$)
      If InString(allowedcharacters$,Mid$(email$,i,1),1,True)=0: Exitfunction 2: EndIf
  Next i

  LastDotPos = 0
  CountAt = 0

  ; Check for certain generably allowable characters in the beginning of address
  Select Left$(email$, 1)
     Case ".","@","_","-","0","1","2","3","4","5","6","7","8","9"
       Exitfunction 3
  EndSelect

  ; Check for the disallowed "." in the end of address
  If Right$(email$, 1)=".": Exitfunction 4: EndIf

  ; Check the string for non-allowable characters.
  For index = 1 To Len(email$)
     CurrentChar$ = Mid$(email$, index, 1)
    ; Count the number of "@".
    If CurrentChar$ = "@": Inc CountAt: EndIf
    ; If there are two consecutive dots, it's not a valid address.
    If CurrentChar$ = "."
       If index = LastDotPos + 1
         Exitfunction 5
      Else
        LastDotPos = index
      EndIf
    EndIf
  Next index

  If CountAt<>1: Exitfunction 6: EndIf

   If InString(email$,".@",1,True) Or InString(email$,"@.",1,True): Exitfunction 7: EndIf

  ; If the extension isn't a known one, it's not a valid address.
  ext=False
  If InString(valid4extensions$,Right$(email$, 5),1,True): ext=True: EndIf
  If InString(valid3extensions$,Right$(email$, 4),1,True): ext=True: EndIf
  If InString(valid2extensions$,Right$(email$, 3),1,True): ext=True: EndIf
  If ext=False: Exitfunction 8: EndIf
EndFunction -1