<% Response.Buffer = true 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("JanEmil@.hotmail.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 %> <% if Request.Form("email") <> "" then email = Request.Form("email") If Valider(email) Then set conn = Server.CreateObject("ADODB.Connection") conn.Open "Driver={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("database.mdb") If Request.Form("RADIO") = "false" Then conn.Execute("DELETE * FROM maillingliste WHERE email='" & email & "'") V_Status = "E-mail adressen er nu slettet fra databasen" else on Error Resume Next conn.Execute("insert into maillingliste (email) values ('" & email & "')") On Error GoTo 0 V_Status = "E-mail adressen er nu tilføjet fra databasen" end if conn.Close set conn = nothing end if end if %> Velkommen til ABLO
ABLO.dk officielle e-portal. Alle rettigheder forbeholdes ©2005