<% font = "Verdana, Arial, Helvetia, sans-serif " fileName = Mid(request.servervariables("SCRIPT_NAME"), InstrRev(request.servervariables("SCRIPT_NAME"), "/") + 1) if isnumeric(request("m")) then subMessageID = clng(request("m")) else subMessageID = 0 if cstr(request("a")) = "u" then if isnumeric(request("i")) then subID = clng(request("i")) else subID = 0 if isnumeric(request("c")) then subSC = clng(request("c")) else subSC = 0 set subRecord = Server.CreateObject("ADODB.Recordset") subRecord.ActiveConnection = mlConn subRecord.Source = "SELECT * FROM ML_Pending WHERE PendingType = 2 AND SubscriberID = " & subID subRecord.CursorType = 1 subRecord.LockType = 3 subRecord.Open() pending = true if subRecord.eof then subRecord.Close() subRecord.Source = "SELECT * FROM ML_Subscribers WHERE subRemoved = 0 AND SubscriberID = " & subID subRecord.Open() pending = false end if if subRecord.eof then %> <%=AAF%>

<% elseif request("confirmed") = "" then set lstRecord = Server.CreateObject("ADODB.Recordset") lstRecord.ActiveConnection = mlConn lstRecord.Source = "SELECT * FROM ML_Lists WHERE ListID = " & subRecord("ListID") lstRecord.CursorType = 1 lstRecord.LockType = 3 lstRecord.Open() if lstRecord.eof then %> <%=AAG%>

<% else code = generateSC(subRecord("Email")) if code = subSC then %> <% varListName = lstRecord("ListName") AAErender = replace(AAE, "#varListName#", varListName) %> <%=AAErender%>

<%=AAA%> <%=subRecord("Name")%>
<%=AAB%> <%=subRecord("Email")%>
<%=AAC%> <%=subRecord("Format")%>

<% else %> <%=AAH%>

<% end if end if elseif request("confirmed") <> "" Then set lstRecord = Server.CreateObject("ADODB.Recordset") lstRecord.ActiveConnection = mlConn lstRecord.Source = "SELECT * FROM ML_Lists WHERE ListID = " & subRecord("ListID") lstRecord.CursorType = 1 lstRecord.LockType = 3 lstRecord.Open() if lstRecord.eof then %> <%=AAI%>

<% else if lcase(lstRecord("DoubleOptout")) = "y" then lstOptout = true else lstOptout = false if lcase(lstRecord("SUE")) = "y" then lstSUE = true else lstSUE = false if lcase(lstRecord("BCCListAdmin")) = "y" then lstBCC = true else lstBCC = false code = generateSC(subRecord("Email")) if not pending and lstOptout and subSC = code then sent = sendEmail(subRecord("SubscriberID"), subRecord("Email"), subRecord("Name"), false, lstRecord("ListAdminEmail"), lstRecord("ListName"), "Text", "Unsubscribe from " & lstRecord("ListName"),lstRecord("OptoutMessage") & vbNewLine & vbNewLine & "To confirm your unsubscription, click or cut and paste the link below:" & vbNewLine & "#unsubscribe#") mlConn.execute("INSERT INTO ML_Pending (PendingType, SubscriberID, ListID, Format, Name, Email, PendingActionDate) VALUES " &_ "(2," & subID & "," & subRecord("ListID") & ", '" & replace(subRecord("Format"), "'", "''") & "', '" & replace(subRecord("Name"), "'", "''") & "', '" & replace(subRecord("Email"), "'", "''") & "'," & getNumFromDate(Now) & ")") %> <% varListName = lstRecord("ListName") AAJrender = replace(AAJ, "#varListName#", varListName) %> <%=AAJrender%>

<% elseif subSC = code then if lstSUE then set subRecord = Server.CreateObject("ADODB.Recordset") subRecord.ActiveConnection = mlConn subRecord.Source = "SELECT * FROM ML_Subscribers WHERE SubscriberID = " & subID subRecord.CursorType = 1 subRecord.LockType = 3 subRecord.Open() sent = sendEmail(subRecord("SubscriberID"), subRecord("Email"), subRecord("Name"), lstBCC, lstRecord("ListAdminEmail"), lstRecord("ListName"), subRecord("Format"), lstRecord("UnsubscribeSubject"),lstRecord("Unsubscribe" & subRecord("Format"))) end if if pending then mlConn.execute("DELETE FROM ML_Pending WHERE SubscriberID = " & subID) end if mlConn.execute("UPDATE ML_Subscribers SET subRemoved = 1, subRemovedDate = " & cfgDate & ", subMessageID = " & subMessageID & " WHERE SubscriberID = " & subID) %> <% varListName = lstRecord("ListName") AAKrender = replace(AAK, "#varListName#", varListName) %> <%=AAKrender%>

<% else %> <%AAL%>

<% end if end if end if else if isnumeric(request("c")) then subSC = clng(request("c")) else subSC = 0 if request("confirmed") <> "" then confirmed = true else confirmed = false dim idArray() idCount = 0 if request("l") <> "" then for each subListID in request("l") if isnumeric(subListID) then idCount = idCount + 1 redim preserve idArray(idCount) idArray(idCount - 1) = clng(subListID) end if next useListID = true elseif request("i") <> "" then for each subID in request("i") if isnumeric(subID) then idCount = idCount + 1 redim preserve idArray(idCount) idArray(idCount - 1) = clng(subID) end if next useSubID = true end if if idCount > 0 then for idxID = 0 to idCount - 1 if useSubID then subID = idArray(idxID) else subID = 0 subListID = idArray(idxID) end if set subRecord = Server.CreateObject("ADODB.Recordset") subRecord.ActiveConnection = mlConn subRecord.Source = "SELECT * FROM ML_Pending WHERE PendingID = " & subID subRecord.CursorType = 1 subRecord.LockType = 3 subRecord.Open() if subRecord.eof then subName = cstr(request("name")) subEmail = cstr(request("email")) if not verifyEmail(subEmail) then subEmail = "" if (prefHexEmail = 1) AND (comCheck(8, debugMode)) then validate = hexVerifyEmail(subEmail, hexResponse, hexResponseCode, hexResponseText, hexTimeout, hexLevel, hexMx, hexExtraText, hexDomainDot, hexDomainLiterals, hexVrfy, hexMXRecords, emailTest) if hexResponse = 0 then subEmail = "" subResponse = hexResponseText end if end if subFormat = cstr(request("format")) if lcase(left(subFormat, 1)) = "h" then subFormat = "HTML" else subFormat = "Text" else subName = subRecord("Name") subEmail = subRecord("Email") subFormat = subRecord("Format") subListID = subRecord("ListID") confirmed = true code = generateSC(subEmail) end if if subListID > 0 then set lstRecord = Server.CreateObject("ADODB.Recordset") lstRecord.ActiveConnection = mlConn lstRecord.Source = "SELECT * FROM ML_Lists WHERE ListID = " & subListID lstRecord.CursorType = 1 lstRecord.LockType = 3 lstRecord.Open() if lstRecord.eof then if not subRecord.eof then mlConn.execute("DELETE * FROM ML_Pending WHERE PendingID = " & subID) end if %> <%=AAM%>

<% else if lcase(lstRecord("DoubleOptin")) = "y" then lstOptin = true else lstOptin = false if lcase(lstRecord("SWE")) = "y" then lstSWE = true else lstSWE = false if lcase(lstRecord("BCCListAdmin")) = "y" then lstBCC = true else lstBCC = false if (not subRecord.eof and subSC = code) or (not lstOptin and confirmed) and subEmail <> "" then ' add them ' check for banned domain... domain = split(subEmail, "@") : MLDomain = domain(UBound(domain)) set blockedDomain = mlConn.Execute("SELECT * FROM ML_Blocked WHERE blkType = 0 and blkText = '" & replace(MLDomain, "'", "''") & "'") if NOT blockedDomain.EOF then %> <%=AAN%>

<% else set dupRecord = Server.CreateObject("ADODB.Recordset") dupRecord.ActiveConnection = mlConn dupRecord.Source = "SELECT * FROM ML_Subscribers WHERE Email LIKE '" & replace(subEmail, "'", "''") & "' AND ListID = " & subListID dupRecord.CursorType = 1 dupRecord.LockType = 3 dupRecord.Open() if dupRecord.eof then mlConn.execute("INSERT INTO ML_Subscribers (Name, Email, Format, ListID, SubscribedDate, numClicks, numReads, numBounces, numReplies, subRemoved) VALUES " &_ "('" & replace(subName, "'", "''") & "', '" & replace(subEmail, "'", "''") & "', '" & subFormat & "', " & subListID & "," & getNumFromDate(Now) & ",0,0,0,0,0)") if lstSWE then set subRecord = Server.CreateObject("ADODB.Recordset") subRecord.ActiveConnection = mlConn subRecord.Source = "SELECT * FROM ML_Subscribers WHERE Email LIKE '" & replace(subEmail, "'", "''") & "' AND ListID = " & subListID subRecord.CursorType = 1 subRecord.LockType = 3 subRecord.Open() if lcase(subRecord("Format")) = "html" then usrMessage = lstRecord("HeaderHTML") & lstRecord("SubscribeHTML") & lstRecord("FooterHTML") else usrMessage = lstRecord("HeaderText") & lstRecord("SubscribeText") & lstRecord("FooterText") end if sent = sendEmail(subRecord("SubscriberID"), subRecord("Email"), subRecord("Name"), lstBCC, lstRecord("ListAdminEmail"), lstRecord("ListName"), subRecord("Format"), lstRecord("SubscribeSubject"), usrMessage) end if if subID > 0 then mlConn.execute("DELETE FROM ML_Pending WHERE PendingID = " & subID) end if cookieName = "spd_" & lstRecord("ListID") response.cookies(cookieName) = DateAdd("m", 24, Now) response.cookies(cookieName).expires = DateAdd("m", 24, Now) %> <% varListName = lstRecord("ListName") AAOrender = replace(AAO, "#varListName#", varListName) %> <%=AAOrender%>

<% else %> <% varListName = lstRecord("ListName") AAPrender = replace(AAP, "#varListName#", varListName) %> <%=AAPrender%>

<% end if end if elseif lstOptin and confirmed and subSC = 0 and subEmail <> "" then ' check for banned domain... domain = split(subEmail, "@") : MLDomain = domain(UBound(domain)) set blockedDomain = mlConn.Execute("SELECT * FROM ML_Blocked WHERE blkType = 0 and blkText = '" & replace(MLDomain, "'", "''") & "'") if NOT blockedDomain.EOF then %> <%=AAQ%>

<% else set dupRecord = Server.CreateObject("ADODB.Recordset") dupRecord.ActiveConnection = mlConn dupRecord.Source = "SELECT * FROM ML_Subscribers WHERE Email LIKE '" & replace(subEmail, "'", "''") & "' AND ListID = " & subListID dupRecord.CursorType = 1 dupRecord.LockType = 3 dupRecord.Open() if dupRecord.eof then set subRecord = Server.CreateObject("ADODB.Recordset") subRecord.ActiveConnection = mlConn subRecord.Source = "SELECT * FROM ML_Pending WHERE Email LIKE '" & replace(subEmail, "'", "''") & "' AND ListID = " & subListID subRecord.CursorType = 1 subRecord.LockType = 3 subRecord.Open() if subRecord.eof then mlConn.execute("INSERT INTO ML_Pending (PendingType, Name, Email, Format, ListID, PendingActionDate) VALUES " &_ "(1, '" & replace(subName, "'", "''") & "', '" & replace(subEmail, "'", "''") & "', '" & subFormat & "', " & subListID & "," & getNumFromDate(Now) & ")") subRecord.Close() subRecord.Source = "SELECT * FROM ML_Pending WHERE Email LIKE '" & replace(subEmail, "'", "''") & "' AND ListID = " & subListID subRecord.Open() end if setn = sendEmail(subRecord("PendingID"), subRecord("Email"), subRecord("Name"), false, lstRecord("ListAdminEmail"), lstRecord("ListName"), "Text", "Confirm Subscription to " & lstRecord("ListName"),lstRecord("OptinMessage") & vbNewLine & "Please cut and paste the link below into your browser or click to confirm your subscription:" & vbNewLine & vbNewLine & "#subconfirm#") %> <% varEmail = subRecord("Email") AARrender = replace(AAR, "#varEmail#", varEmail) %> <%=AARrender%>

<% else %> <% varListName = lstRecord("ListName") AASrender = replace(AAS, "#varListName#", varListName) %> <%=AASrender%>

<% end if end if elseif not confirmed or subEmail = "" then %> <%=AAT%>
<% if subEmail = "" then %> <%=AAU%> <% if subResponse <> "" then %> <%=AAV%><%=subResponse%> <%end if %> <% end if %>

<%=AAA%>
<%=AAB%>
<% for each formListID in request("l") %> <% next %>
<% exit for else %> <%=AAX%>
<% end if end if else %> <%=AAY%>
<% end if next else set lstRecord = Server.CreateObject("ADODB.Recordset") lstRecord.ActiveConnection = mlConn lstRecord.Source = "SELECT * FROM ML_Lists WHERE PublicList = 'Public'" lstRecord.CursorType = 1 lstRecord.LockType = 3 lstRecord.Open() if lstRecord.eof then response.redirect RootURL %> <%=AAZ%>
<%=AAA%>
<%=AAB%>
<%=AAC%> CHECKED<% end if %> checked> <%=ABA%> CHECKED<% end if %>> <%=ABB%>
<%=ABC%>
<% end if end if function sendEmail(emlToID, emlTo, emlToName, emlBCC, emlFrom, emlFromName, emlFormat, usrSubject, usrMessage) if lcase(emlFormat) = "text" then usrFormat = "text" usrFormatInt = 1 else usrFormat = "text/html" usrFormatInt = 0 end if if subRecord("SubscriberID") > 0 then subSubscribed = getDateFromNum(subRecord("SubscribedDate")) else subSubscribed = Now end if usrSubject1 = parseSnippets(usrSubject, 1) usrSubject = replace(usrSubject, "#name#", subRecord("Name"), 1, -1, 1) usrSubject = replace(usrSubject, "#email#", subRecord("Email"), 1, -1, 1) usrSubject = replace(usrSubject, "#subscribed#", subSubscribed, 1, -1, 1) usrSubject = replace(usrSubject, "#format#", subRecord("Format"), 1, -1, 1) usrSubject = replace(usrSubject, "#subscriberid#", emlToID, 1, -1, 1) usrSubject = replace(usrSubject, "#shortdate#", formatdatetime(now, 2), 1, -1, 1) usrSubject = replace(usrSubject, "#longdate#", formatdatetime(now, 1), 1, -1, 1) usrSubject = replace(usrSubject, "#listname#", lstRecord("ListName"), 1, -1, 1) usrSubject = replace(usrSubject, "#newsletterid#", 0, 1, -1, 1) nameArr = split(subRecord("Name"), " ", -1, 1) if (UBound(nameArr) >= 0) then fname = nameArr(0) usrSubject = replace(usrSubject, "#firstname#", fname, 1, -1, 1) if instr(1, usrSubject, "#unsubscribe#", 1) then code = 1 encode = emlTo for idxChar = 1 to len(encode) code = code * asc(mid(encode, idxChar, 1)) mod 11111 next code = code mod 10000 usrSubject = replace(usrSubject, "#unsubscribe#", ActionURL & "?a=u&l=" & lstRecord("ListID") & "&i=" & emlToID & "&c=" & code, 1, -1, 1) end if usrMessage1 = parseSnippets(usrMessage, 1) usrMessage = replace(usrMessage, "#name#", "" & subRecord("Name"), 1, -1, 1) usrMessage = replace(usrMessage, "#email#", "" & subRecord("Email"), 1, -1, 1) usrMessage = replace(usrMessage, "#subscribed#", "" & subSubscribed, 1, -1, 1) usrMessage = replace(usrMessage, "#format#", "" & subRecord("Format"), 1, -1, 1) usrMessage = replace(usrMessage, "#subscriberid#", "" & emlToID, 1, -1, 1) usrMessage = replace(usrMessage, "#shortdate#", formatdatetime(now, 2), 1, -1, 1) usrMessage = replace(usrMessage, "#longdate#", formatdatetime(now, 1), 1, -1, 1) usrMessage = replace(usrMessage, "#listname#", "" & lstRecord("ListName"), 1, -1, 1) usrMessage = replace(usrMessage, "#newsletterid#", 0, 1, -1, 1) nameArr = split(subRecord("Name"), " ", -1, 1) if (UBound(nameArr) >= 0) then fname = nameArr(0) usrMessage = replace(usrMessage, "#firstname#", fname, 1, -1, 1) if instr(1, usrMessage, "#unsubscribe#", 1) or instr(1, usrMessage, "#subconfirm#", 1) then code = 1 encode = emlTo for idxChar = 1 to len(encode) code = code * asc(mid(encode, idxChar, 1)) mod 11111 next code = code mod 10000 usrMessage = replace(usrMessage, "#unsubscribe#", ActionURL & "?a=u&i=" & emlToID & "&c=" & code, 1, -1, 1) usrMessage = replace(usrMessage, "#subconfirm#", ActionURL & "?a=s&i=" & emlToID & "&c=" & code, 1, -1, 1) end if select case MailerProgram case "ASPMail", "ASPQMail" Set Mailer = Server.CreateObject("SMTPsvg.Mailer") Mailer.ContentType = usrFormat Mailer.RemoteHost = MailerPath Mailer.FromName = emlFromName Mailer.FromAddress = emlFrom Mailer.ReplyTo = emlFrom Mailer.AddRecipient emlToName, emlTo if emlBCC then Mailer.AddBCC lstRecord("ListName"), emlFrom end if Mailer.Subject = usrSubject Mailer.BodyText = usrMessage if MailerProgram = "ASPQMail" then Mailer.QMessage = true end if Mailer.SendMail case "ASPEmail" Set Mailer = Server.CreateObject("Persits.MailSender") Mailer.Host = MailerPath Mailer.From = emlFrom Mailer.FromName = emlFromName Mailer.AddReplyTo(emlFrom) Mailer.AddAddress(emlTo) if emlBCC then Mailer.AddBCC(emlFrom) end if Mailer.Subject = usrSubject If usrFormat = "text/html" then Mailer.IsHTML = true Else Mailer.IsHTML = false End if Mailer.Body = usrMessage Mailer.Send case "JMail" Set Mailer = Server.CreateObject("JMail.SMTPMail") Mailer.ServerAddress = MailerPath & ":" & PortNum Mailer.ContentType = usrFormat Mailer.AddRecipient emlTo if emlBCC then Mailer.AddRecipientBCC emlFrom end if Mailer.Sender = emlFrom Mailer.ReplyTo = emlFrom Mailer.Subject = usrSubject Mailer.Body = usrMessage Mailer.Execute case "SA-SmtpMail" Set Mailer = Server.CreateObject("SoftArtisans.SMTPMail") Mailer.RemoteHost = MailerPath Mailer.contenttype = usrFormat Mailer.AddRecipient emlToName, emlTo Mailer.FromName = emlFromName Mailer.FromAddress = emlFrom Mailer.ReplyTo = emlFrom if emlBCC then Mailer.AddBCC emlFrom end if Mailer.Subject = usrSubject Mailer.BodyText = usrMessage Mailer.SendMail case else Set Mailer = Server.CreateObject("CDONTS.NewMail") Mailer.MailFormat = usrFormatInt Mailer.BodyFormat = usrFormatInt Mailer.To = emlTo Mailer.From = emlFromName & " <" & emlFrom & ">" if emlBCC then Mailer.Bcc = emlFrom end if Mailer.Subject = usrSubject Mailer.Body = usrMessage Mailer.Send end select if err.number <> 0 then %> <%=ABE%> <% sendEmail = false else sendEmail = true end if end function function generateSC (encode) code = 1 for idxChar = 1 to len(encode) code = code * asc(mid(encode, idxChar, 1)) mod 11111 next generateSC = code mod 10000 end function %>