Validering af en formel

Den her skulle gerne indeholde det hele:

<%
Dim V_ValiderEmail, V_Snabler, V_UgyldigeDomaener, V_Domaene, V_GyldigeEndelser, V_GyldigEndelse, V_Endelse, V_Ekskluder, V_i, V_Status

Function Valider(V_ValiderEmail)

    Valider            = True
    V_ValiderEmail    = LCase(V_ValiderEmail)
   
    ' (1) Check laengde '-----------------------------------------------------------------------
   
    If Len(V_ValiderEmail) < 5 Then
        Valider    = False
        V_Status    = "E-mail adressen er for kort."
        Exit Function
    End If

    ' (2) Skal indeholde @ '--------------------------------------------------------------------
   
    If InStr(V_ValiderEmail,"@") = 0 Then
        Valider    = False
        V_Status    = "Der mangler et ""@"" i e-mail adressen."
        Exit Function
    End If

    ' (3) Undgaa "@." og ".@" '-----------------------------------------------------------------
   
    If ((InStr(V_ValiderEmail,"@.") <> 0) OR (InStr(V_ValiderEmail,".@") <> 0)) Then
        Valider    = False
        V_Status    = "Der må ikke være et punktum lige op af et ""@"" i e-mail adressen."
        Exit Function
    End If

    ' (4) Check om der er noget foran @ '-------------------------------------------------------
   
    If Len(Left(V_ValiderEmail,InStr(V_ValiderEmail,"@") - 1)) = 0 Then
        Valider    = False
        V_Status    = "Der mangler noget foran ""@"" i e-mail adressen."
        Exit Function
    End If

    ' (5) Minimum 1 "." '-----------------------------------------------------------------------

    If InStr(V_ValiderEmail,".") = 0 Then
        Valider    = False
        V_Status    = "En e-mail adresse indeholder mindst eet punktum."
        Exit Function
    End If

    ' (6) Max 3 tegn efter sidste "." '---------------------------------------------------------

    If (Len(V_ValiderEmail) - InStrRev(V_ValiderEmail,".") > 3) Then
        Valider    = False
        V_Status    = "Der er for mange tegn efter sidste punktum i e-mail adressen."
        Exit Function
    End If

    ' (7) Undgaa ".." '-------------------------------------------------------------------------

    If InStr(V_ValiderEmail,"..") <> 0 Then
        Valider    = False
        V_Status    = "Der mŒ ikke være to punktummer lige op af hinanden i e-mail adressen."
        Exit Function
    End If

    ' (8) Min 2 tegn efter sidste "." '---------------------------------------------------------

    If (Len(V_ValiderEmail) - InStrRev(V_ValiderEmail,".") < 2) Then
        Valider    = False
        V_Status    = "Der skal være mindst to tegn efter sidste punktum i e-mail adressen."
        Exit Function
    End If

    ' (9) Ingen "_" efter "@" '-----------------------------------------------------------------

    If ((InStr(V_ValiderEmail,"_") <> 0) AND (InStrRev(V_ValiderEmail,"_") > InStrRev(V_ValiderEmail,"@"))) Then
        Valider    = False
        V_Status    = "Der må ikke være en underscore (_) efter ""@""."
        Exit Function
    End If

    ' (10) Tjek for flere "@" '-----------------------------------------------------------------

    V_Snabler = 0

    For V_i = 1 TO Len(V_ValiderEmail)
        If Mid(V_ValiderEmail,V_i,1) = "@" Then
            V_Snabler = V_Snabler + 1
        End If
    Next

    If V_Snabler > 1 Then
        Valider    = False
        V_Status    = "E-mail adressen indeholder for mange ""@""."
        Exit Function
    End If

    ' (11) Check V_Domaene ud fra array '-------------------------------------------------------

    V_UgyldigeDomaener    = Array("hotmai.com","yahho.dk","hotmaile.com","mail1stofanet.dk","ofri.dk","post1.dk","post2.dk","post3.dk","post4.dk","post5.dk","post6.dk","post7.dk","post8.dk","fc.skolekom.dk","post9.dk","hommail.com","jupiipost.dk","forom.dk","furom.dk","frorum.dk","mail.forum.dk","mailforum.dk","forum.mail.dk","sol.ak","guld.dk","hormail.com","wanacoo.dk","sol.mail.dk","mail.tel.dk")
    V_Domaene                = Right(V_ValiderEmail,(Len(V_ValiderEmail) - InStrRev(V_ValiderEmail,"@")))

    For V_i = 0 TO UBound(V_UgyldigeDomaener)
        If V_Domaene = V_UgyldigeDomaener(V_i) Then
            Valider    = False
            V_Status    = "E-mail adressens domæne er ugyldigt."
            Exit Function
        End If
    Next

    ' (12) Tjek om TLD'en er korrekt '----------------------------------------------------------

    V_GyldigEndelse    = False
    V_GyldigeEndelser    = Array("dk","com","edu","gov","int","mil","net","org","af","al","dz","as","ad","ao","ai","aq","ag","ar","am","aw","ac","au","at","az","bs","bh","bd","bb","by","be","bz","bj","bm","bt","bo","ba","bw","bv","br","io","bn","bg","bf","bi","kh","cm","ca","cv","ky","cf","td","cs","cl","cn","cx","cc","co","km","cg","ck","cr","ci","hr","cu","cy","cz","dj","dm","do","tp","ec","eg","sv","gq","er","ee","et","fk","fo","fj","fi","fr","gf","pf","tf","ga","gm","ge","de","gh","gi","gr","gl","gd","gp","gu","gt","gg","gn","gw","gy","ht","hm","va","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","ps","pa","pg","py","pe","ph","pn","pl","pt","pr","qa","re","ro","ru","rw","kn","lc","vc","ws","sm","st","sa","sn","sc","sl","sg","sk","si","sb","so","za","gs","es","lk","sh","pm","sd","sr","sj","sz","se","ch","sy","tw","tj","tz","th","tg","tk","to","tt","tn","tr","tm","tc","tv","ug","ua","ae","gb","uk","us","um","uy","su","uz","vu","ve","vn","vg","vi","wf","eh","ye","yu","cd","zm","zr","zw")
    V_Endelse            = Right(V_ValiderEmail,(Len(V_ValiderEmail) - InStrRev(V_ValiderEmail,".")))

    For V_i = 0 TO UBound(V_GyldigeEndelser)
        If V_Endelse = V_GyldigeEndelser(V_i) Then
            V_GyldigEndelse = True
            Exit For
        End If
    Next
   
    If NOT V_GyldigEndelse Then
        Valider    = False
        V_Status    = "Domæne endelsen (f.eks. "".dk"" el. "".com"") er ikke korrekt."
        Exit Function
    End If

    ' (13) Check hver enkelt tegn '-------------------------------------------------------------

    For V_i = 1 TO Len(V_ValiderEmail)
        If NOT IsNumeric(Mid(V_ValiderEmail,V_i,1)) AND (LCase(Mid(V_ValiderEmail,V_i,1)) < "a" OR LCase(Mid(V_ValiderEmail,V_i,1)) > "z") AND Mid(V_ValiderEmail,V_i,1) <> "_" AND Mid(V_ValiderEmail,V_i,1) <> "." AND Mid(V_ValiderEmail,V_i,1) <> "@" AND Mid(V_ValiderEmail,V_i,1) <> "-" Then
            Valider    = False
            V_Status    = "E-mail adressen indeholder et eller flere ugyldige tegn."
            Exit Function
        End If
    Next

    ' (14) Adresser der skal ekskluderes (grundet SPAM el. lign.) '-----------------------------

    V_Ekskluder    = Array("rune@medions.dk", "daniel@server02.dk", "anders@and.dk", "test@test.dk", "test@test.com")

    For V_i = 0 TO UBound(V_Ekskluder)
        If V_ValiderEmail = V_Ekskluder(V_i) Then
            Valider    = False
            V_Status    = "Der kan ikke sendes til den valgte adresse da den er ekskluderet pga. misbrug."
            Exit Function
        End If
    Next

End Function

//>Rune

Den dækker jo kun e-mail delen, hvad med de andre felter?
Domæne delen er totalt ligegyldig eftersom du langt fra har alle domæner ikke hele verden med!

Det er da ellers et meget nice script medions har posted der...

/Skjold

Heheh yepz, der når man om alle hjørner :)

//>Rune

retunere point til mig selv efter intet ordentligt svar

Hvorfor syntes du ikke du har fået noget ordentlig svar, du kan jo blot tilføje de domæner der mangler?

//>Rune