"Rasmus Nielsen" <postmaster@rasmusn.dk> wrote in message
news:bjvm3d$nq7v2$1@ID-176586.news.uni-berlin.de...
> Hej,
>
> Har nogen et simpelt valideringsscript, der tjekke om en tekststreng er en
> email adresse (altså om der er et @ osv.). Det behøver ikke tjekke for
alle
> mulige ting, som dem jeg kan finde på netcoders.dk gør...
Function Valider(Email)
'
' Kaldes med Valider("email@adresse.dk")
' Returnerer True hvis adressen er gyldig, False hvis den er ugyldig
' Yderligere kendte domeane fejl kan tilfoejes i array (pkt. 11)
' Yderligere kendte domeane endelses fejl kan tilfoejes i array (pkt. 12)
'
' Scriptet maa benyttes frit, men ikke til videresalg
Dim Snabler, i, UgyldigeDomaener, Domaene, UgyldigeEndelser, Endelse
Valider = True
' (1) Check laengde
'---------------------------------------------------------------------------
---------------
If (Len(Email) < 5) Then
Valider = False
' (2) Skal indeholde @
'---------------------------------------------------------------------------
------------
Elseif (InStr(Email,"@") = 0) Then
Valider = False
' (3) Undgaa "@." og ".@"
'---------------------------------------------------------------------------
---------
Elseif ((InStr(Email,"@.") <> 0) OR (InStr(Email,".@") <> 0)) Then
Valider = False
' (4) Check om der er noget foran @
'--------------------------------------------------------------------------
Elseif (Len(Left(Email,InStr(Email,"@") - 1)) = 0) Then
Valider = False
' (5) Minimum 1 "."
'---------------------------------------------------------------------------
---------------
Elseif (InStr(Email,".") = 0) Then
Valider = False
' (6) Max 3 tegn efter sidste "."
'---------------------------------------------------------------------------
-
Elseif (Len(Email) - InStrRev(Email,".") > 3) Then
Valider = False
' (7) Undgaa ".."
'---------------------------------------------------------------------------
-----------------
Elseif (InStr(Email,"..") <> 0) Then
Valider = False
' (8) Min 2 tegn efter sidste "."
'---------------------------------------------------------------------------
-
Elseif (Len(Email) - InStrRev(Email,".") < 2) Then
Valider = False
' (9) Ingen "_" efter "@"
'---------------------------------------------------------------------------
---------
Elseif ((InStr(Email,"_") <> 0) AND (InStrRev(Email,"_") >
InStrRev(Email,"@"))) Then
Valider = False
Else
' (10) Tjek for flere "@"
'---------------------------------------------------------------------------
----------
Snabler = 0
FOR i = 1 TO Len(Email)
If Mid(Email,i,1) = "@" Then
Snabler = Snabler + 1
End If
NEXT
If Snabler > 1 Then
Valider = False
End If
' (11) Check domaene ud fra array
'---------------------------------------------------------------------------
-
UgyldigeDomaener =
Array("xxhotmail.com","xxjupiipost.dk","xxforom.dk","xxfurom.dk")
Domaene = Right(Email,(Len(Email) - InStrRev(Email,"@")))
FOR i = 0 TO UBound(UgyldigeDomaener)
If Domaene = UgyldigeDomaener(i) Then
Valider = False
End If
NEXT
' (12) Ret de taaber der skriver forkerte endelser
'-----------------------------------------------------------
UgyldigeEndelser = Array("om","ocm","kd","et","co")
Endelse = Right(Email,(Len(Email) - InStrRev(Email,".")))
FOR i = 0 TO UBound(UgyldigeEndelser)
If Endelse = UgyldigeEndelser(i) Then
Valider = False
End If
NEXT
' (13) Check hver enkelt tegn
'---------------------------------------------------------------------------
-----
FOR i = 1 TO Len(Email)
If NOT IsNumeric(Mid(Email,i,1)) AND _
(LCase(Mid(Email,i,1)) < "a" OR _
LCase(Mid(Email,i,1)) > "z") AND _
Mid(Email,i,1) <> "_" AND _
Mid(Email,i,1) <> "." AND _
Mid(Email,i,1) <> "@" AND _
Mid(Email,i,1) <> "-" Then
Valider = False
End If
NEXT
End If
End Function
hilsen kayl
www.adderweb.com