title image


Smiley Re: eMail Adresse auf Plausibilität prüfen
Oder du nimmst diesen Sourcecode.. geklaut bei www.vbarchiv.de





Beschreibung

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




-- Wer flucht, kann nix! --

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: