<%
If Request("l") = "" Then
Set fso = Server.CreateObject ("Scripting.FileSystemObject")
If err <> 0 Then subscribererror() End If
Set ots = fso.OpenTextFile (Session("ScriptPath") & "\templates\no_list_selected.txt", ForReading)
If err <> 0 Then subscribererror() End If
strtemplate = Trim(ots.ReadAll)
ots.Close
Set ots = Nothing
Set fso = Nothing
Response.Write strtemplate
Response.End
strnotfound = 1
End If
Select Case Request("a")
'Subscription popup form
'----------------------------------------------------------------------------------------------------------------------------
Case "s"
If Not strnotfound = 1 Then
%>
<%=getlistname(Request("l"))%>
<%=getfields(Request("l"),"description")%>
* = Required
<%
End If
If err <> 0 Then subscribererror() End If
'Subscription Functions
'--------------------------------------------------------------------------------------------------------------------------------
Case "sh"
If err <> 0 Then subscribererror() End If
strnotfound = 0
stradded = ""
strcount = 0
strerror = ""
strvalidate = RegExpTest(Trim(Lcase(Request("e"))))
If Not strvalidate = True Then
strerror = strerror & "Email:
Field blank or syntax error. "
strnotfound = 1
Elseif Len(Trim(Lcase(Request("e")))) > 255 Then
strerror = strerror & "Email
" & strExceedsthecharacterlimitof255 & " "
strnotfound = 1
End If
If getfields(Request("l"),"field_count") > 0 Then
For i = 1 to getfields(Request("l"),"field_count")
Select Case getfields(Request("l"),"type_" & i)
Case "1"
If Request("field_" & i) = Trim("") Then
strerror = strerror & "" & getfields(Request("l"),"field_" & i) & "
" & strNormalTextBox & " "
strnotfound = 1
Elseif Len(Request("field_" & i)) > 255 Then
strerror = strerror & "" & getfields(Request("l"),"field_" & i) & "
" & strExceedsthecharacterlimitof255 & " "
strnotfound = 1
End If
Case "2"
strrecordarray = getfields(Request("l"),"field_" & i)
strrecordarray = split(strrecordarray,",")
If Request("field_" & i) = Trim("") Then
strerror = strerror & "" & strrecordarray(0) & ":
" & strCustomDropDownError & " "
strnotfound = 1
End If
Case "3"
If Request("field_" & i) = Trim("") Then
strerror = strerror & "" & getfields(Request("l"),"field_" & i) & "
" & strCountryDropDown & " "
strnotfound = 1
End If
Case "4"
If Request("field_" & i) = Trim("") Then
strerror = strerror & "" & getfields(Request("l"),"field_" & i) & "
" & strStateDropDowns & " "
strnotfound = 1
End If
Case "5"
If Request("field_" & i) = Trim("") Then
strerror = strerror & "" & getfields(Request("l"),"field_" & i) & "
" & strStateDropDowns & " "
strnotfound = 1
End If
Case "6"
If Request("field_" & i) = Trim("") Then
strerror = strerror & "" & getfields(Request("l"),"field_" & i) & "
" & strStateDropDowns & " "
strnotfound = 1
End If
Case "7"
If Request("field_" & i) = Trim("") Then
strerror = strerror & "" & getfields(Request("l"),"field_" & i) & "
" & strStateDropDowns & " "
strnotfound = 1
End If
Case "8"
strrecordarray = getfields(Request("l"),"field_" & i)
strrecordarray = split(strrecordarray,",")
If Request("field_" & i) = Trim("") Then
strerror = strerror & "" & strrecordarray(0) & "
" & strRadioButtonSelection & " "
strnotfound = 1
End If
End Select
Next
End If
If strnotfound = 1 Then
Response.Write"" & strStatus & " " & strErrorinForm & " "
Response.Write strerror
If Request("t") = "f" Then
Response.Write"" & strClosewindowandtryagain & " "
Else
Response.Write"" & strClickheretocorrect & " "
End If
End If
If Not strnotfound = 1 Then
Set rs = conn.execute("Select * From " & tbl_prefix & "banned Where banned = '" & Trim(Lcase(Request("e"))) & "' And listID = '" & Request("l") & "' And type = 1", adOpenForwardOnly, adLockReadOnly)
If err <> 0 Then subscribererror() End If
If Not rs.EOF Then
Set fso = Server.CreateObject ("Scripting.FileSystemObject")
If err <> 0 Then subscribererror() End If
Set ots = fso.OpenTextFile (Session("ScriptPath") & "\templates\email_banned.txt", ForReading)
If err <> 0 Then subscribererror() End If
strtemplate = Trim(ots.ReadAll)
ots.Close
Set ots = Nothing
Set fso = Nothing
strtemplate = Replace(strtemplate,"[email]",Trim(Lcase(Request("e"))))
strtemplate = Replace(strtemplate,"[list_name]",getlistname(Request("l")))
strtemplate = Replace(strtemplate,"[admin_email]",Session("AdminEmail"))
strtemplate = Replace(strtemplate,"[site_name]",Session("SiteName"))
Response.Write strtemplate
strnotfound = 1
End If
rs.close
Set rs = nothing
End If
If err <> 0 Then subscribererror() End If
If Not strnotfound = 1 Then
Set rs = conn.execute("Select * From " & tbl_prefix & "banned Where banned = '" & Trim(Lcase(Request("e"))) & "' And listID = 'all_lists' And type = 1", adOpenForwardOnly, adLockReadOnly)
If err <> 0 Then subscribererror() End If
If Not rs.EOF Then
Set fso = Server.CreateObject ("Scripting.FileSystemObject")
If err <> 0 Then subscribererror() End If
Set ots = fso.OpenTextFile (Session("ScriptPath") & "\templates\email_banned.txt", ForReading)
If err <> 0 Then subscribererror() End If
strtemplate = Trim(ots.ReadAll)
ots.Close
Set ots = Nothing
Set fso = Nothing
strtemplate = Replace(strtemplate,"[email]",Trim(Lcase(Request("e"))))
strtemplate = Replace(strtemplate,"[list_name]",getlistname(Request("l")))
strtemplate = Replace(strtemplate,"[admin_email]",Session("AdminEmail"))
strtemplate = Replace(strtemplate,"[site_name]",Session("SiteName"))
Response.Write strtemplate
strnotfound = 1
End If
rs.close
Set rs = nothing
End If
If Not strnotfound = 1 Then
strname = len(Trim(Lcase(Request("e")))) - instrrev(Trim(Lcase(Request("e"))),"@")
strname = Right(Trim(Lcase(Request("e"))), strname)
Set rs = conn.execute("Select * From " & tbl_prefix & "banned Where banned = '" & strname & "' And listID = '" & Request("l") & "' And type = 2", adOpenForwardOnly, adLockReadOnly)
If err <> 0 Then subscribererror() End If
If Not rs.EOF Then
Set fso = Server.CreateObject ("Scripting.FileSystemObject")
If err <> 0 Then subscribererror() End If
Set ots = fso.OpenTextFile (Session("ScriptPath") & "\templates\domain_banned.txt", ForReading)
If err <> 0 Then subscribererror() End If
strtemplate = Trim(ots.ReadAll)
ots.Close
Set ots = Nothing
Set fso = Nothing
strtemplate = Replace(strtemplate,"[domain]",strname)
strtemplate = Replace(strtemplate,"[list_name]",getlistname(Request("l")))
strtemplate = Replace(strtemplate,"[admin_email]",Session("AdminEmail"))
strtemplate = Replace(strtemplate,"[site_name]",Session("SiteName"))
Response.Write strtemplate
strnotfound = 1
End If
rs.close
Set rs = nothing
End If
If err <> 0 Then subscribererror() End If
If Not strnotfound = 1 Then
strname = len(Trim(Lcase(Request("e")))) - instrrev(trim(Request("e")),"@")
strname = Right(Trim(Lcase(Request("e"))), strname)
strnotfound = 0
strcount = 0
Set rs = conn.execute("Select * From " & tbl_prefix & "banned Where banned = '" & strname & "' And listID = 'all_lists' And type = 2", adOpenForwardOnly, adLockReadOnly)
If Not rs.EOF Then
Set fso = Server.CreateObject ("Scripting.FileSystemObject")
Set ots = fso.OpenTextFile (Session("ScriptPath") & "\templates\domain_banned.txt", ForReading)
strtemplate = Trim(ots.ReadAll)
ots.Close
Set ots = Nothing
Set fso = Nothing
strtemplate = Replace(strtemplate,"[domain]",strname)
strtemplate = Replace(strtemplate,"[list_name]",getlistname(Request("l")))
strtemplate = Replace(strtemplate,"[admin_email]",Session("AdminEmail"))
strtemplate = Replace(strtemplate,"[site_name]",Session("SiteName"))
Response.Write strtemplate
strnotfound = 1
End If
rs.close
Set rs = nothing
End If
If err <> 0 Then subscribererror() End If
If Not strnotfound = 1 Then
Set rs = conn.execute("Select * From " & tbl_prefix & Request("l") & " Where email = '" & Trim(Lcase(Request("e"))) & "'", adOpenForwardOnly, adLockReadOnly)
If Not rs.EOF Then
Set fso = Server.CreateObject ("Scripting.FileSystemObject")
Set ots = fso.OpenTextFile (Session("ScriptPath") & "\templates\email_found.txt", ForReading)
strtemplate = Trim(ots.ReadAll)
ots.Close
Set ots = Nothing
Set fso = Nothing
strtemplate = Replace(strtemplate,"[email]",Trim(Lcase(Request("e"))))
strtemplate = Replace(strtemplate,"[list_name]",getlistname(Request("l")))
strtemplate = Replace(strtemplate,"[subscribe_date]",DisplayDate(rs("edate")))
strtemplate = Replace(strtemplate,"[from_ip]",rs("fromip"))
strtemplate = Replace(strtemplate,"[admin_email]",Session("AdminEmail"))
strtemplate = Replace(strtemplate,"[site_name]",Session("SiteName"))
Response.Write strtemplate
strnotfound = 1
End If
rs.close
Set rs = nothing
End If
If err <> 0 Then subscribererror() End If
If Not strnotfound = 1 Then
sql = "Insert Into " & tbl_prefix & Request("l") & " ("
sql = sql & "email,"
For i = 1 to getfields(Request("l"),"field_count")
sql = sql & "field_" & i & ","
Next
sql = sql & "edate,fromip) "
sql = sql & "Values("
sql = sql & FormatDatabaseString(Trim(Lcase(Request("e"))),Len(Trim(Lcase(Request("e"))))) & ","
For i = 1 to getfields(Request("l"),"field_count")
sql = sql & FormatDatabaseString(Trim(Request("field_" & i)),Len(Trim(Request("field_" & i)))) & ","
Next
sql = sql & FormatDatabaseDate(SetDate(Now())) & ","
sql = sql & "'" & getfromip() & "')"
conn.execute sql, , adExecuteNoRecords
Set fso = Server.CreateObject ("Scripting.FileSystemObject")
Set ots = fso.OpenTextFile (Session("ScriptPath") & "\templates\confirmation_email.txt", ForReading)
strtemplate = Trim(ots.ReadAll)
ots.Close
Set ots = Nothing
Set fso = Nothing
strtemplate = Replace(strtemplate,"[date]",SetDate(Now()))
strtemplate = Replace(strtemplate,"[site_url]",Session("SiteUrl"))
strtemplate = Replace(strtemplate,"[email]",Trim(Lcase(Request("e"))))
strtemplate = Replace(strtemplate,"[list_name]",getlistname(Request("l")))
strtemplate = Replace(strtemplate,"[admin_email]",Session("AdminEmail"))
strtemplate = Replace(strtemplate,"[site_name]",Session("SiteName"))
strmessage = ""
If getfields(Request("l"),"field_count") > 0 Then
For i = 1 to getfields(Request("l"),"field_count")
If getfields(Request("l"),"type_" & i) = 2 Then
strrecordarray = getfields(Request("l"),"field_" & i)
strrecordarray = split(strrecordarray,",")
strmessage = strmessage & strrecordarray(0) & ": " & vbNewline & Request("field_" & i) & vbNewLine & vbNewLine
Elseif getfields(Request("l"),"type_" & i) = 8 Then
strrecordarray = getfields(Request("l"),"field_" & i)
strrecordarray = split(strrecordarray,",")
strmessage = strmessage & strrecordarray(0) & ": " & vbNewline & Request("field_" & i) & vbNewLine & vbNewLine
Else
strmessage = strmessage & getfields(Request("l"),"field_" & i) & ": " & vbNewline & Request("field_" & i) & vbNewLine & vbNewLine
End If
Next
strtemplate = Replace(strtemplate,"[get_fields]", strmessage)
Else
strtemplate = Replace(strtemplate,"[get_fields]","")
End If
strtemplate = Replace(strtemplate,"[confirmation_link]",Session("ScriptUrl") & "/r.asp?l=" & Request("l") & "&a=c&e=" & Trim(Lcase(Request("e"))))
funsubject = strConfirmEmailSubject
funemail = Trim(Lcase(Request("e")))
funmessage = strtemplate
sendemail strConfirmEmailSubject,Trim(Lcase(Request("e"))),strtemplate
If err <> 0 Then
Response.Write err.description
response.end
End If
Set fso = Server.CreateObject ("Scripting.FileSystemObject")
Set ots = fso.OpenTextFile (Session("ScriptPath") & "\templates\confirmation.txt", ForReading)
strtemplate = Trim(ots.ReadAll)
ots.Close
Set ots = Nothing
Set fso = Nothing
strtemplate = Replace(strtemplate,"[email]",Trim(Lcase(Request("e"))))
strtemplate = Replace(strtemplate,"[list_name]",getlistname(Request("l")))
strtemplate = Replace(strtemplate,"[admin_email]",Session("AdminEmail"))
strtemplate = Replace(strtemplate,"[site_name]",Session("SiteName"))
strmessage = ""
If getfields(Request("l"),"field_count") > 0 Then
For i = 1 to getfields(Request("l"),"field_count")
If getfields(Request("l"),"type_" & i) = 2 Then
strrecordarray = getfields(Request("l"),"field_" & i)
strrecordarray = split(strrecordarray,",")
strmessage = strmessage & "
" & strrecordarray(0) & ":
" & Request("field_" & i) & "
"
Elseif getfields(Request("l"),"type_" & i) = 8 Then
strrecordarray = getfields(Request("l"),"field_" & i)
strrecordarray = split(strrecordarray,",")
strmessage = strmessage & "
" & strrecordarray(0) & ":
" & Request("field_" & i) & "
"
Else
strmessage = strmessage & "
" & getfields(Request("l"),"field_" & i) & ":
" & Request("field_" & i) & "
"
End If
Next
strtemplate = Replace(strtemplate,"[get_fields]",strmessage)
Else
strtemplate = Replace(strtemplate,"[get_fields]","")
End If
Response.Write strtemplate
End If
'Subscription Confirmation Functions
'--------------------------------------------------------------------------------------------------------------------------------
Case "c"
strnotfound = 0
Set rs = conn.execute("Select * From " & tbl_prefix & Request("l") & " Where email = '" & Trim(Lcase(Request("e"))) & "' And verified = 1", adOpenForwardOnly, adLockReadOnly)
If Not rs.EOF Then
Set fso = Server.CreateObject ("Scripting.FileSystemObject")
Set ots = fso.OpenTextFile (Session("ScriptPath") & "\templates\already_confirmed.txt", ForReading)
strtemplate = Trim(ots.ReadAll)
ots.Close
Set ots = Nothing
Set fso = Nothing
strtemplate = Replace(strtemplate,"[email]",Trim(Lcase(Request("e"))))
strtemplate = Replace(strtemplate,"[list_name]",getlistname(Request("l")))
strtemplate = Replace(strtemplate,"[subscribe_date]",DisplayDate(rs("edate")))
strtemplate = Replace(strtemplate,"[from_ip]",rs("fromip"))
strtemplate = Replace(strtemplate,"[admin_email]",Session("AdminEmail"))
strtemplate = Replace(strtemplate,"[site_name]",Session("SiteName"))
Response.Write strtemplate
strnotfound = 1
End If
rs.close
Set rs = nothing
If Not strnotfound = 1 Then
sql = "Update " & tbl_prefix & Request("l") & " Set "
sql = sql & "verified = 1,"
sql = sql & "edate = " & FormatDatabaseDate(SetDate(Now())) & ","
sql = sql & "fromip = '" & getfromip() & "'"
sql = sql & " Where email = '" & Trim(Lcase(Request("e"))) & "'"
conn.execute sql, , adExecuteNoRecords
Set rs = conn.execute("Select * From " & tbl_prefix & Request("l") & " Where email = '" & Trim(Lcase(Request("e"))) & "'", adOpenForwardOnly, adLockReadOnly)
Set fso = Server.CreateObject ("Scripting.FileSystemObject")
Set ots = fso.OpenTextFile (Session("ScriptPath") & "\templates\confirmation_received.txt", ForReading)
strtemplate = Trim(ots.ReadAll)
ots.Close
Set ots = Nothing
Set fso = Nothing
strmessage = ""
strtemplate = Replace(strtemplate,"[email]",Trim(Lcase(Request("e"))))
strtemplate = Replace(strtemplate,"[list_name]",getlistname(Request("l")))
strtemplate = Replace(strtemplate,"[site_name]",Session("SiteName"))
If getfields(Request("l"),"field_count") > 0 Then
For i = 1 to getfields(Request("l"),"field_count")
If getfields(Request("l"),"type_" & i) = 2 Then
strrecordarray = getfields(Request("l"),"field_" & i)
strrecordarray = split(strrecordarray,",")
strmessage = strmessage & "
" & strrecordarray(0) & ":
" & rs("field_" & i) & "
"
Elseif getfields(Request("l"),"type_" & i) = 8 Then
strrecordarray = getfields(Request("l"),"field_" & i)
strrecordarray = split(strrecordarray,",")
strmessage = strmessage & "
" & strrecordarray(0) & ":
" & rs("field_" & i) & "
"
Else
strmessage = strmessage & "
" & getfields(Request("l"),"field_" & i) & ":
" & rs("field_" & i) & "
"
End If
Next
strtemplate = Replace(strtemplate,"[get_fields]",strmessage)
Else
strtemplate = Replace(strtemplate,"[get_fields]","")
End If
Response.Write strtemplate
If Session("SubscribeNotification") = True Then
Set fso = Server.CreateObject ("Scripting.FileSystemObject")
If err <> 0 Then subscribererror() End If
Set ots = fso.OpenTextFile (Session("ScriptPath") & "\templates\subscribe_notification.txt", ForReading)
If err <> 0 Then subscribererror() End If
strtemplate = Trim(ots.ReadAll)
ots.Close
Set ots = Nothing
Set fso = Nothing
strtemplate = Replace(strtemplate,"[email]",Trim(Lcase(Request("e"))))
strtemplate = Replace(strtemplate,"[list_name]",getlistname(Request("l")))
strtemplate = Replace(strtemplate,"[date]",SetDate(Now()))
strtemplate = Replace(strtemplate,"[site_name]",Session("SiteName"))
strtemplate = Replace(strtemplate,"[from_ip]",getfromip)
strtemplate = Replace(strtemplate,"[first_name]",Session("FirstName"))
strtemplate = Replace(strtemplate,"[last_name]",Session("LastName"))
strtemplate = Replace(strtemplate,"[script_url]", Session("ScriptUrl"))
strmessage = ""
If getfields(Request("l"),"field_count") > 0 Then
For i = 1 to getfields(Request("l"),"field_count")
If getfields(Request("l"),"type_" & i) = 2 Then
strrecordarray = getfields(Request("l"),"field_" & i)
strrecordarray = split(strrecordarray,",")
strmessage = strmessage & strrecordarray(0) & ": " & vbNewline & rs("field_" & i) & vbNewLine & vbNewLine
Elseif getfields(Request("l"),"type_" & i) = 8 Then
strrecordarray = getfields(Request("l"),"field_" & i)
strrecordarray = split(strrecordarray,",")
strmessage = strmessage & strrecordarray(0) & ": " & vbNewline & rs("field_" & i) & vbNewLine & vbNewLine
Else
strmessage = strmessage & getfields(Request("l"),"field_" & i) & ": " & vbNewline & rs("field_" & i) & vbNewLine & vbNewLine
End If
Next
strtemplate = Replace(strtemplate,"[get_fields]",strmessage)
Else
strtemplate = Replace(strtemplate,"[get_fields]","")
End If
rs.close
Set rs = nothing
Session("strsubject") = strSubcribeNotification
Session("stremail") = Session("AdminEmail")
Session("strmessage") = strtemplate
sendemail strSubcribeNotification,Session("AdminEmail"),strtemplate
End If
End If
'Subscription Removal Functions
'--------------------------------------------------------------------------------------------------------------------------------
Case "uc"
If Request("l") = "" Then
Set fso = Server.CreateObject ("Scripting.FileSystemObject")
Set ots = fso.OpenTextFile (Session("ScriptPath") & "\templates\no_list_selected.txt", ForReading)
strtemplate = Trim(ots.ReadAll)
ots.Close
Set ots = Nothing
Set fso = Nothing
Response.Write strtemplate
strnotfound = 1
End If
If Not strnotfound = 1 Then
strvalidate = RegExpTest(Trim(Lcase(Request("e"))))
If strvalidate = False Then
Set fso = Server.CreateObject ("Scripting.FileSystemObject")
If err <> 0 Then subscribererror() End If
Set ots = fso.OpenTextFile (Session("ScriptPath") & "\templates\incorrect_email_syntax.txt", ForReading)
If err <> 0 Then subscribererror() End If
strtemplate = Trim(ots.ReadAll)
ots.Close
Set ots = Nothing
Set fso = Nothing
strtemplate = Replace(strtemplate,"[email]",Trim(Lcase(Request("e"))))
strtemplate = Replace(strtemplate,"[list_name]",getlistname(Request("l")))
strtemplate = Replace(strtemplate,"[admin_email]",Session("AdminEmail"))
strtemplate = Replace(strtemplate,"[site_name]",Session("SiteName"))
Response.Write strtemplate
strnotfound = 1
Else
strnotfound = 0
Set rs = conn.execute("Select * From " & tbl_prefix & Request("l") & " Where email = '" & Trim(Lcase(Request("e"))) & "'", adOpenForwardOnly, adLockReadOnly)
If err <> 0 Then subscribererror() End If
If rs.EOF Then
Set fso = Server.CreateObject ("Scripting.FileSystemObject")
If err <> 0 Then errorcode() end if 'ERROR TRAP
Set ots = fso.OpenTextFile (Session("ScriptPath") & "\templates\email_not_found.txt", ForReading)
If err <> 0 Then errorcode() end if 'ERROR TRAP
strtemplate = Trim(ots.ReadAll)
ots.Close
Set ots = Nothing
Set fso = Nothing
strtemplate = Replace(strtemplate,"[email]",Trim(Lcase(Request("e"))))
strtemplate = Replace(strtemplate,"[list_name]",getlistname(Request("l")))
strtemplate = Replace(strtemplate,"[admin_email]",Session("AdminEmail"))
strtemplate = Replace(strtemplate,"[site_name]",Session("SiteName"))
Response.Write strtemplate
strnotfound = 1
End If
End If
If Not strnotfound = 1 Then
Set fso = Server.CreateObject ("Scripting.FileSystemObject")
If err <> 0 Then subscribererror() End If
Set ots = fso.OpenTextFile (Session("ScriptPath") & "\templates\confirm_removal.txt", ForReading)
If err <> 0 Then subscribererror() End If
strtemplate = Trim(ots.ReadAll)
ots.Close
Set ots = Nothing
Set fso = Nothing
strtemplate = Replace(strtemplate,"[email]",Trim(Lcase(Request("e"))))
strtemplate = Replace(strtemplate,"[list_name]",getlistname(Request("l")))
strtemplate = Replace(strtemplate,"[admin_email]",Session("AdminEmail"))
strtemplate = Replace(strtemplate,"[site_name]",Session("SiteName"))
strtemplate = Replace(strtemplate,"[list_id]",Request("l"))
Response.Write strtemplate
rs.Close
Set rs = nothing
End If
End If
'Delete Subscribers Records
'------------------------------------------------------------------------------------------------------------------------------
Case "u"
strnotfound = 0
Set rs = conn.execute("Select * From " & tbl_prefix & Request("l") & " Where email = '" & Trim(Lcase(Request("e"))) & "'", adOpenForwardOnly, adLockReadOnly)
If err <> 0 Then subscribererror() End If
If rs.EOF Then
Set fso = Server.CreateObject ("Scripting.FileSystemObject")
If err <> 0 Then subscribererror() End If
Set ots = fso.OpenTextFile (Session("ScriptPath") & "\templates\email_not_found.txt", ForReading)
If err <> 0 Then subscribererror() End If
strtemplate = Trim(ots.ReadAll)
ots.Close
Set ots = Nothing
Set fso = Nothing
strtemplate = Replace(strtemplate,"[email]",Trim(Lcase(Request("e"))))
strtemplate = Replace(strtemplate,"[list_name]",getlistname(Request("l")))
strtemplate = Replace(strtemplate,"[admin_email]",Session("AdminEmail"))
strtemplate = Replace(strtemplate,"[site_name]",Session("SiteName"))
Response.Write strtemplate
strnotfound = 1
End If
If Not strnotfound = 1 Then
conn.execute "Delete From " & tbl_prefix & Request("l") & " Where email = '" & Trim(Lcase(Request("e"))) & "'", , adExecuteNoRecords
If err <> 0 Then subscribererror() End If
Set fso = Server.CreateObject ("Scripting.FileSystemObject")
If err <> 0 Then subscribererror() End If
Set ots = fso.OpenTextFile (Session("ScriptPath") & "\templates\removal.txt", ForReading)
If err <> 0 Then subscribererror() End If
strtemplate = Trim(ots.ReadAll)
ots.Close
Set ots = Nothing
Set fso = Nothing
strtemplate = Replace(strtemplate,"[email]",Trim(Lcase(Request("e"))))
strtemplate = Replace(strtemplate,"[list_name]",getlistname(Request("l")))
strtemplate = Replace(strtemplate,"[admin_email]",Session("AdminEmail"))
strtemplate = Replace(strtemplate,"[site_name]",Session("SiteName"))
Response.Write strtemplate
End If
If Session("Un-SubscribeNotification") = True Then
Set fso = Server.CreateObject ("Scripting.FileSystemObject")
If err <> 0 Then subscribererror() End If
Set ots = fso.OpenTextFile (Session("ScriptPath") & "\templates\unsubscribe_notification.txt", ForReading)
If err <> 0 Then subscribererror() End If
strtemplate = Trim(ots.ReadAll)
ots.Close
Set ots = Nothing
Set fso = Nothing
strtemplate = Replace(strtemplate,"[email]",Trim(Lcase(Request("e"))))
strtemplate = Replace(strtemplate,"[list_name]",getlistname(Request("l")))
strtemplate = Replace(strtemplate,"[date]",SetDate(Now()))
strtemplate = Replace(strtemplate,"[site_name]",Session("SiteName"))
strtemplate = Replace(strtemplate,"[removal_date]",SetDate(Now()))
strtemplate = Replace(strtemplate,"[from_ip]",getfromip)
strtemplate = Replace(strtemplate,"[first_name]",Session("FirstName"))
strtemplate = Replace(strtemplate,"[last_name]",Session("LastName"))
strtemplate = Replace(strtemplate,"[script_url]", Session("ScriptUrl"))
Session("strsubject") = strUnsubscribeNotification
Session("stremail") = Session("AdminEmail")
Session("strmessage") = strtemplate
sendemail strUnsubscribeNotification,Session("AdminEmail"),strtemplate
If err <> 0 Then subscribererror() End If
End If
rs.Close
Set rs = nothing
End Select
%>
<%
Function sendemail(subject,recipient,message)
Select Case Session("MailComponent")
'** W3JMAIL
'--------------------------------------------------------------------------------------------
Case "w3Jmail"
Dim objJmail
Set objJmail = Server.CreateObject("JMail.SMTPMail")
With objJmail
.ServerAddress = Session("MailServer") & ":" & Session("MailServerPort")
.ISOEncodeHeaders = false
.ReplyTo = Session("ReplytoEmail")
.Sender = Session("AdminEmail")
.SenderName = Session("SiteName")
.Subject = subject
.AddRecipient recipient
.Body = message
.Execute
If err <> 0 Then subscribererror() End If
End With
Set objJmail = nothing
'**CDONTS
'------------------------------------------------------------------------------------------
Case "Cdonts"
Dim objCdonts
Set objCdonts = CreateObject("CDONTS.NewMail")
With objCdonts
.Value("Reply-To")= Session("ReplytoEmail")
.From = Session("SiteName") & " <" & Session("AdminEmail") & ">"
.To = recipient
.Subject = subject
.Body = message
.Send
If err <> 0 Then subscribererror() End If
End With
Set objCdonts = Nothing
'** ASPEMAIL
'-----------------------------------------------------------------------------------------------
Case "ASPemail"
Dim objASPemail
Set objASPemail = Server.CreateObject("Persits.MailSender")
With objASPemail
.Host = Session("MailServer")
.Port = Session("MailServerPort")
.AddReplyTo Session("ReplytoEmail")
.From = Session("AdminEmail")
.FromName = Session("SiteName")
.AddAddress recipient
.Subject = subject
.Body = message
.Send
If err <> 0 Then subscribererror() End If
End With
Set objASPemail = nothing
'** ASPMAIL
'------------------------------------------------------------------------------------------------
Case "ASPMail"
Dim objASPMail
Set objASPMail = Server.CreateObject("SMTPsvg.Mailer")
With objASPMail
.RemoteHost = Session("MailServer") & ":" & Session("MailServerPort")
.ReplyTo = Session("ReplytoEmail")
.FromName = Session("SiteName")
.FromAddress= Session("AdminEmail")
.AddRecipient recipient, recipient
.Subject = subject
.BodyText = message
.SendMail
If err <> 0 Then subscribererror() End If
End With
Set objASPMail = nothing
'** DUNDASMAILER
'-----------------------------------------------------------------------------------------------------
Case "DundasMailer"
Dim objDundasMailer
Set objDundasMailer = Server.CreateObject("Dundas.Mailer")
With objDundasMailer
.ReplyTOs.Add Session("ReplytoEmail")
.TOs.Add recipient
.Subject = subject
.FromAddress = Session("AdminEmail")
.FromName = Session("SiteName")
.SMTPRelayServers.Add Session("MailServer"),Session("MailServerPort")
.Body = message
.SendMail
If err <> 0 Then subscribererror() End If
End With
Set objDundasMailer = nothing
'** CDOSYS
'-------------------------------------------------------------------------------------------------------
Case "CDOSYS"
Dim Flds, iConf, CDOSYS
Set CDOSYS = Server.CreateObject("CDO.Message")
Set iConf = Server.CreateObject ("CDO.Configuration")
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Session("MailServer")
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")= Session("MailServerPort")
.Update
End With
Set CDOSYS.Configuration = iConf
Set Flds = CDOSYS.Fields
With CDOSYS
.From = Session("SiteName") & " <" & Session("AdminEmail") & ">"
.ReplyTo = Session("ReplytoEmail")
.To = recipient
.Subject = subject
.TEXTBody = message
.Send
If err <> 0 Then subscribererror() End If
End With
Set CDOSYS = nothing
'** ASPSMARTMAIL
'-----------------------------------------------------------------------------------------------------
Case "aspSmartMail"
Dim aspSmartMail
Set aspSmartMail = Server.CreateObject("aspSmartMail.SmartMail")
With aspSmartMail
.Server = Session("MailServer")
.ServerPort = Session("MailServerPort")
.SenderName = Session("SiteName")
.SenderAddress = Session("AdminEmail")
.Recipients.Add recipient
.ReplyTos.Add Session("ReplytoEmail")
.Subject = subject
.Body = message
.ContentType = "text/plain"
.SendMail
If err <> 0 Then subscribererror() End If
End With
set aspSmartMail = nothing
'** ACTIVE EMAIL
'---------------------------------------------------------------------------------------------------------------
Case "ActiveEmail"
Dim ActiveEmail
Set ActiveEmail = Server.CreateObject("ActivXperts.SmtpMail")
With ActiveEmail
.HostName = Session("MailServer")
.HostPort = Session("MailServerPort")
.FromAddress = Session("AdminEmail")
.FromName = Session("SiteName")
.ReplyAddress = Session("ReplytoEmail")
.AddTo recipient, ""
.Subject = subject
.Body = message
.Send
If err <> 0 Then subscribererror() End If
End With
Set ActiveEmail = nothing
'** SOFTARTISANS
'--------------------------------------------------------------------------------------------------
Case "SoftArtisans"
Dim SoftArtisans
Set SoftArtisans = Server.CreateObject("SoftArtisans.SMTPMail")
With SoftArtisans
.RemoteHost = Session("MailServer")
.Port = Session("MailServerPort")
.FromName = Session("SiteName")
.FromAddress = Session("AdminEmail")
.AddRecipient "" , recipient
.Subject = subject
.BodyText = message
.ReplyTo = Session("ReplytoEmail")
.SendMail
If err <> 0 Then subscribererror() End If
End With
Set SoftArtisans = nothing
End Select
End Function
'** SUBSCRIBER ERROR FUNCTION
'--------------------------------------------------------------------------------------------
Function subscribererror()
Set fso = Server.CreateObject ("Scripting.FileSystemObject")
Set ots = fso.OpenTextFile (Session("ScriptPath") & "\templates\error.txt", ForReading)
on error goto 0
strtemplate = Trim(ots.ReadAll)
ots.Close
Set ots = Nothing
Set fso = Nothing
strtemplate = Replace(strtemplate,"[err_description]",err.description)
strtemplate = Replace(strtemplate,"[admin_email]",Session("AdminEmail"))
Response.Write strtemplate
err.clear
Response.End
End Function
'** ASSURING THAT ALL DATABASE CONNECTIONS ARE CLOSED
On Error Resume Next
rs.close
Set rs = nothing
rsfun.Close
Set rsfun = nothing
conn.close
Set conn = nothing
on error goto 0
%> |