vb@rchiv · Tipps & Tricks · EMail-Adresse auf Gültigkeit prüfen

Rubrik: HTML/Internet/Netzwerk · HTML/Email | VB-Versionen: VB6

17.02.01

EMail-Adresse auf Gültigkeit prüfen Dieser Tipp prüft eine EMail-Adresse auf korrekte Syntax (@-Zeichen vorhanden?, gültige TopLevelDomain?)
Autor: Matthias Zirngibl	Bewertung:	Views: 33.941
www.masterbootrecord.de	System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Dieser Tipp prüft eine EMail-Adresse auf Gütligkeit. Zunächst wird geprüft, ob das @-Zeichen und mindestens 1 Punkt vorhanden sind. Dann wird geprüft, ob es sich bei der angegebenen TopLevel-Domain um eine gültige Domain handelt (z.B. de, com, at, org). Ist die Domain in der Liste vorhanden, handelt es sich zumindest der Syntax nach um eine gültige EMail-Adresse.

' Prüft eine EMail-Adresse auf Gültigkeit
Public Function Check_Email_Adress(sEMailAdr As String) _
  As Boolean
 
  Dim bGoodAdress As Boolean
  Dim sTopLevelDomainsArray() As String, sTopLevelDomains As String
  Dim sValidChars As String
  Dim eMailSplices() As String
  Dim i As Integer
 
  bGoodAdress = False
  sEMailAdr = LCase(sEMailAdr)
 
  sTopLevelDomains = "com,net,edu,arpa,org,gov,museum," + _
    "biz,info,pro,name,aero,coop,mil,ac,ad,ae,af,ag,ai,al," + _
    "am,an,ao,aq,ar,as,at,au,aw,az,ba,bb,bd,be,bf,bg," + _
    "bh,bi,bj,bm,bn,bo,br,bs,bt,bv,bw,by,bz,ca,cc,cd," + _
    "cf,cg,ch,ci,ck,cl,cm,cn,co,cr,cu,cv,cx,cy,cz,de," + _
    "dj,dk,dm,do,dz,ec,ee,eg,eh,er,es,et,fi,fj,fk,fm," + _
    "fo,fr,ga,gd,ge,gf,gg,gh,gi,gl,gm,gn,gp,gq,gr,gs," + _
    "gt,gu,gw,gy,hk,hm,hn,hr,ht,hu,id,ie,il,im,in,io," + _
    "iq,ir,is,it,je,jm,jo,jp,ke,kg,kh,ki,km,kn,kp,kr," + _
    "kw,ky,kz,la,lb,lc,li,lk,lr,ls,lt,lu,lv,ly,ma,mc," + _
    "md,mg,mh,mk,ml,mm,mn,mo,mp,mq,mr,ms,mt,mu,mv,mw," + _
    "mx,my,mz,na,nc,ne,nf,ng,ni,nl,no,np,nr,nu,nz,om," + _
    "pa,pe,pf,pg,ph,pk,pl,pm,pn,pr,ps,pt,pw,py,qa,re," + _
    "ro,ru,rw,sa,sb,sc,sd,se,sg,sh,si,sj,sk,sl,sm,sn," + _
    "so,sr,st,sv,sy,sz,tc,td,tf,tg,th,tj,tk,tm,tn,to," + _
    "tp,tr,tt,tv,tw,tz,ua,ug,uk,um,us,uy,uz,va,vc,ve," + _
    "vg,vi,vn,vu,wf,ws,ye,yt,yu,za,zm,zr,zw"
 
  sValidChars = "abcdefghijklmnopqrstuvwxyz0123456789.-_@"
 
  sTopLevelDomainsArray = Split(sTopLevelDomains, ",")
 
  ' @-Zeichen prüfen
  eMailSplices = Split(sEMailAdr, "@")
  If UBound(eMailSplices) <> 1 Then
    Check_Email_Adress = False
    Exit Function
  End If
 
  ' . prüfen
  eMailSplices = Split(eMailSplices(1), ".")
  If UBound(eMailSplices) < 1 Then
    Check_Email_Adress = False
    Exit Function
  End If
 
  ' TopLevel-Domain prüfen
  For i = 0 To UBound(sTopLevelDomainsArray)
    If eMailSplices(UBound(eMailSplices)) = _
     sTopLevelDomainsArray(i) Then
      bGoodAdress = True
      Exit For
    End If
  Next
 
  ' Auf gültige Zeichen prüfen
  For i = 1 To Len(sEMailAdr)
    If InStr(1, sValidChars, LCase$(Mid$(sEMailAdr, i, 1))) = 0 Then
        bGoodAdress = False
        Exit For
    End If
  Next
 
  Check_Email_Adress = bGoodAdress
End Function