Tjek database for dublikeringer !
Hej....Jeg skal bruge en som er istand til at rette nederstående script for mig, da jeg ikke er den hårde programmør....
Det er en nyhedsbrev tilmelding, problemet er bare det er muligt at tilmelde sig 2 gange, derfor skal den først tjekke op på om mail adressen allerede er i databasen, hvis den er skal brugeren få en bedsked med "Du er allerede tilmeldt denne service" og hvis ikke skal han tilføjes til databasen....
<%
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("/mailliste/database.mdb")
If Request.Form("RADIO") = "false" Then
conn.Execute("DELETE * FROM maillingliste WHERE email='" & email & "'")
V_Status = "Du er nu afmeldt fra Chicken Hosting nyhedsbrev"
else
on Error Resume Next
conn.Execute("insert into maillingliste (email) values ('" & email & "')")
On Error GoTo 0
V_Status = "Du er nu tilmeldt Chicken Hostings nyhedsbrev"
end if
conn.Close
set conn = nothing
end if
end if
%>
</SCRIPT>
<html>
<head>
<title>Maillingliste</title>
</head>
<body bgcolor=White>
<table border="0" cellpadding="0" cellspacing="0">
<form method="POST" action=Nyheder_mailliste.asp id=nyhedsbrev name=nyhedsbrev>
<tr>
<td valign="middle" align="left" colspan=2><font color=Red><%=V_Status%></td>
</tr>
<tr>
<td valign="middle" align="left"><div align="right"><B>Indtast din email </B></td>
<td valign="middle" align="left"><font size="3">
<input type="text" name="email" size="20"></font></td>
</tr>
<tr>
<td> </td>
<td valign="middle" align="left"><font size="2"><br>
Tilmeld</font><INPUT TYPE="RADIO" NAME="RADIO" VALUE="true" checked><font size="2"> Afmeld</font><INPUT TYPE="RADIO" NAME="RADIO" VALUE="false"><font size="2"> </font><font size="1"><input type="submit" value="OK" name="OK"></font><font size="2">
</font>
</td>
</form>
</tr>
</table>
</body>
</html>
Databasen heddder Database.mdb....
Hvis i har andre forslag til scriptet eller ændringer så post endelig....
På forhånd tusinde tak :D
Kan som gengæld til den der løser dette tilbyde et gratis webhotel, med ASP, PHP, ASP.NET understøttelse.....
