<%@LANGUAGE="VBSCRIPT"%> <% '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Spd E-Letter v4.0 ' © 2001, 2002 PensaWorks ' For help with this program, please visit http://www.pensaworks.com '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim Access : Access = "Broadcast" %> <% if request("showError") = "Y" then on error goto 0 else on error resume next end if if lcase(strTop) = "n" then strDoTop = false else strDoTop = true end if thisPage = "broadcast_main.asp" response.buffer = true server.scripttimeout = 5000 response.expiresabsolute = now() - 1 response.expires = 0 response.cachecontrol = "no-cache" if (request("Mailer") <> "") then useMailer = request("Mailer") else useMailer = MailerProgram if (request("Mailer") <> "") then sendMailer = request("Mailer") else sendMailer = MailerProgram if (request("msgID") <> "" AND IsNumeric(request("msgID"))) then msgID = cint(request("msgID")) else msgID = 0 prfUnsubscribe = ActionURL & "?a=u" if (isNumeric(BroadcastNum)) then sendPerPage = cint(BroadcastNum) else sendPerPage = 100 onNum = 0 : msgTextHeader = "" : msgTextFooter = "" : msgHTMLHeader = "" : msgHTMLFooter = "" : msgText = "" : msgHTML = "" mlConn.Execute("UPDATE ML_Broadcast SET msgActualRecipients = 0 WHERE msgActualRecipients IS NULL") mlConn.Execute("UPDATE ML_Broadcast SET BroadcastSubscribers = 0 WHERE BroadcastSubscribers IS NULL") set msgRecord = Server.CreateObject("ADODB.Recordset") msgRecord.ActiveConnection = mlConn msgRecord.Source = "SELECT ML_Broadcast.ListID AS msgListID, msgBroadcastBegun, * FROM ML_Broadcast INNER JOIN ML_Lists ON ML_Broadcast.ListID = ML_Lists.ListID WHERE ML_Broadcast.MessageID = " & msgID msgRecord.CursorType = 3 msgRecord.Open() if (msgRecord.EOF) then response.redirect "message.asp?msg=36" if not allowedList(msgRecord("msgListID"), allowedLists) then response.redirect "message.asp?msg=49" msgBroadcastBegun = msgRecord("msgBroadcastBegun") if msgRecord("msgIncludeTemplateText") = 1 then msgTextHeader = msgRecord("HeaderText") : msgTextFooter = msgRecord("FooterText") end if if msgRecord("msgIncludeTemplateHTML") = 1 then msgHTMLHeader = msgRecord("HeaderHTML") : msgHTMLFooter = msgRecord("FooterHTML") end if msgStatus = msgRecord("Status") if (msgStatus = "Broadcasted") then response.redirect "message.asp?msg=" if msgStatus = "Pending" then sqlStr = "UPDATE ML_Broadcast SET Status = 'Broadcasting', msgBroadcastBegun = " & getNumFromDate(now) & " WHERE MessageID = " & msgID mlConn.Execute(sqlStr) end if msgListID = msgRecord("msgListID") msgListName = msgRecord("ListName") msgFormat = msgRecord("msgFormat") msgSubject = msgRecord("Subject") msgFromName = msgRecord("FromName") msgFromEmail = msgRecord("FromEmail") msgReplyTo = msgRecord("ReplyTo") msgPriority = msgRecord("MessagePriority") if lcase(useMailer) = "cdomail" or lcase(SendMailer) = "chilimail" then if msgPriority = 5 then msgPriority = 0 elseif msgPriority = 3 then msgPriority = 1 elseif msgPriority = 1 then msgPriority = 2 end if end if msgBroadcastSubscribers = msgRecord("BroadcastSubscribers") msgSource = msgRecord("msgSource") if msgSource = 1 then msgText = msgRecord("TextMessage") msgHTML = msgRecord("HTMLMessage") elseif msgSource = 2 then msgSourceFileText = msgRecord("msgSourceFileText") msgSourceFileHTML = msgRecord("msgSourceFileHTML") if msgFormat = 1 or msgFormat = 2 then if doesFileExist(msgSourceFileText) then fileData = readFileData(msgSourceFileText, fileResponse) if NOT fileResponse then response.redirect "message.asp?msg=51" else msgText = fileData end if else response.redirect "message.asp?msg=51" end if end if if msgFormat = 1 or msgFormat = 3 then if doesFileExist(msgSourceFileHTML) then fileData = readFileData(msgSourceFileHTML, fileResponse) if NOT fileResponse then response.redirect "message.asp?msg=51" else msgHTML = fileData end if else response.redirect "message.asp?msg=51" end if end if elseif msgSource = 3 then msgSourceURLText = msgRecord("msgSourceURLText") msgSourceURLHTML = msgRecord("msgSourceURLHTML") msgSourceTextTimes = msgRecord("msgSourceTextTimes") msgSourceHTMLTimes = msgRecord("msgSourceHTMLTimes") if msgFormat = 1 or msgFormat = 2 then msgText = getNewsletterData("Text", 0, "email@domain.com", "True", msgSourceURLText, bitResponse) if (NOT bitResponse) then response.redirect "message.asp?msg=52" end if if msgFormat = 1 or msgFormat = 3 then msgHTML = getNewsletterData("HTML", 0, "email@domain.com", "True", msgSourceURLHTML, bitResponse) if (NOT bitResponse) then response.redirect "message.asp?msg=52" end if else response.redirect "message.asp?msg=53" end if msgText = msgTextHeader & msgText & msgTextFooter msgHTML = msgHTMLHeader & msgHTML & msgHTMLFooter msgTextSnippets = parseSnippets(msgText, 0) msgHTMLSnippets = parseSnippets(msgHTML, 0) trackLinks = parseTextURLTracking(msgText, msgHTML, msgID) msgUseSQL = msgRecord("msgUseSQL") msgSQLStr = msgRecord("msgSQLStr") msgOnSubscriberID = msgRecord("msgOnSubscriberID") msgTotalSubscribers = msgRecord("msgTotalSubscribers") msgActualRecipients = msgRecord("msgActualRecipients") if msgUseSQL = 2 then SQL = msgSQLStr else if strDoTop then SQL = "SELECT TOP " & (sendPerPage + 2) & " * FROM ML_Subscribers WHERE subRemoved <> 1" SQL = SQL & " AND numClicks >= " & msgRecord("msgLowClicksF") & " AND numClicks <= " & msgRecord("msgHighClicksF") SQL = SQL & " AND SubscribedDate >= " & msgRecord("msgSinceDateF") & " AND SubscribedDate <= " & msgRecord("msgToDateF") SQL = SQL & " AND numReads >= " & msgRecord("msgLowReadsF") & " AND numReads <= " & msgRecord("msgHighReadsF") SQL = SQL & " AND ListID = " & msgListID SQL = SQL & " AND SubscriberID > " & msgOnSubscriberID SQL = SQL & " ORDER BY ML_Subscribers.SubscriberID ASC" cntSQL = SQL cntSQL = replace(cntSQL, "SELECT TOP " & (sendPerPage + 2) & " *", "SELECT COUNT(*) AS cnt1 ") cntSQL = replace(cntSQL, " AND SubscriberID > " & msgOnSubscriberID, "") cntSQL = replace(cntSQL, " ORDER BY ML_Subscribers.SubscriberID ASC", "") cntSQL2 = SQL cntSQL2 = replace(cntSQL2, "SELECT TOP " & (sendPerPage + 2) & " *", "SELECT COUNT(*) AS cnt1 ") cntSQL2 = replace(cntSQL2, " ORDER BY ML_Subscribers.SubscriberID ASC", "") else SQL = "SELECT * FROM ML_Subscribers WHERE subRemoved <> 1" SQL = SQL & " AND numClicks >= " & msgRecord("msgLowClicksF") & " AND numClicks <= " & msgRecord("msgHighClicksF") SQL = SQL & " AND SubscribedDate >= " & msgRecord("msgSinceDateF") & " AND SubscribedDate <= " & msgRecord("msgToDateF") SQL = SQL & " AND numReads >= " & msgRecord("msgLowReadsF") & " AND numReads <= " & msgRecord("msgHighReadsF") SQL = SQL & " AND ListID = " & msgListID SQL = SQL & " ORDER BY ML_Subscribers.SubscriberID ASC" cntSQL = replace(SQL, "SELECT * FROM ML_Subscribers", "SELECT COUNT(*) AS cnt1 FROM ML_Subscribers") cntSQL = replace(cntSQL, " ORDER BY ML_Subscribers.SubscriberID ASC", "") end if end if set usrRecord = server.createobject("ADODB.Recordset") usrRecord.activeconnection = mlConn usrRecord.source = SQL usrRecord.cursortype = 3 usrRecord.open() if (usrRecord.EOF) then response.redirect "message.asp?msg=39&msgID=" & msgID & "&Mailer=" & server.urlencode(sendMailer) if msgUseSQL = 2 then sendTotal = usrRecord.recordcount else set cntRecords = mlConn.Execute(cntSQL) sendTotal = cntRecords("cnt1") set cntRecords = nothing set cntRecords = mlConn.Execute(cntSQL2) sendTotal2 = cntRecords("cnt1") set cntRecords = nothing sendTotal3 = sendTotal - sendTotal2 end if if msgBroadcastSubscribers = 0 or isnull(msgBroadcastSubscribers) then usrIndex = 1 msgOnSubscriberID = 0 mlConn.execute("UPDATE ML_Broadcast SET msgBroadcastBegun = " & cfgDate & ", Status = 'Broadcasting' WHERE MessageID = " & msgID) else if strDoTop AND msgUseSQL <> 2 then usrIndex = 1 msgOnSubscriberID = msgRecord("msgOnSubscriberID") else usrIndex = msgBroadcastSubscribers msgOnSubscriberID = msgRecord("msgOnSubscriberID") end if end if sendPages = sendTotal \ sendPerPage if sendTotal mod sendPerPage > 0 then sendPages = sendPages + 1 if msgBroadcastBegun <> "" Then startTime = getDateFromNum(msgBroadcastBegun) else startTime = Now end if sendStart = cdate(StartTime) sendStartPos = usrIndex - 1 sendPage = sendStartPos \ sendPerPage sendPagesLeft = sendPages - sendPage sendElapsed = datediff("s", sendStart, Now) if sendElapsed = 0 or (sendStartPos < 1 AND NOT strDoTop) then sendRemaining = 0 sendThroughput = "Unknown" else if strDoTop then sendStartPos2 = sendStartPos + SendTotal3 sendRemaining = round((sendTotal - sendStartPos2) / (sendStartPos2 / sendElapsed)) sendThroughput = round(sendStartPos2 / sendElapsed, 1) & " emails/sec" else sendRemaining = round((sendTotal - sendStartPos) / (sendStartPos / sendElapsed)) sendThroughput = round(sendStartPos / sendElapsed, 1) & " emails/sec" end if end if if sendRemaining = 0 then sendRemaining = "Unknown" elseif sendRemaining < 60 then sendRemaining = sendRemaining & " sec" else sendRemaining = "(" & sendRemaining & ") ~ " & FormatNumber(sendRemaining/60, 1) & " min" end if if sendPerPage > (sendTotal - sendStartPos) then sendPerPage = sendTotal - sendStartPos end if sendTotalPercent = (usrIndex / sendTotal) * 100 sendPagePercent = 0 sendTotalWidth = sendTotalPercent sendPageWidth = 0 if lcase(right(sql, 41)) = " order by ml_subscribers.subscriberid asc" then if strDoTop then else do until (usrRecord("SubscriberID") > msgOnSubscriberID) usrRecord.movenext loop end if else usrRecord.move usrIndex - 1 end if %> Spd E-Letter Broadcast in Progress

Spd E-Letter Broadcast in Progress
Please do not close this window, disconnect from the Internet, nor try to broadcast another message until this current broadcast completes.

Current Run Progress:

Total Progress:

Estimated Time Remaining: <%=sendRemaining%>
 Average Speed: <%=sendThroughput%>

Broadcast Details
To List:
 <%=msgListName%> 
From:
 <%=msgFromName%> <<%=msgFromEmail%>> 
Reply To:
 <%=msgReplyTo%> 
Subject:
 <%=msgSubject%> 
Using Mailer:
 <%=useMailer%> 

<% err.clear select case SendMailer case "ASPEmail" Set Mailer = Server.CreateObject("Persits.MailSender") if err.number <> 0 then showErr = errRedirect() response.end end if Mailer.Host = MailerPath Mailer.From = msgFromEmail Mailer.FromName = msgFromName Mailer.AddReplyTo(msgReplyTo) Mailer.Priority = msgPriority end select while (onNum < sendPerPage) AND (NOT usrRecord.EOF) AND (response.isclientconnected) onNum = onNum + 1 if msgFormat = 3 then emlFormatText = "HTML" emlFormatInt = 0 emlFormatType = "text/html" elseif msgFormat = 2 then emlFormatText = "Text" emlFormatInt = 1 emlFormatType = "text/plain" else if lcase(left(usrRecord("Format"),1)) = "h" then emlFormatText = "HTML" emlFormatInt = 0 emlFormatType = "text/html" else emlFormatText = "Text" emlFormatInt = 1 emlFormatType = "text/plain" end if end if if msgSource = 3 then if emlFormatText = "HTML" then if msgSourceHTMLTimes = 2 then tempMessage = getNewsletterData("HTML", usrRecord("SubscriberID"), usrRecord("Email"), "False", msgSourceURLHTML, bitResponse) if (NOT bitResponse) then emlSend = false else if lcase(tempMessage) = "skip" then emlSend = false else msgTextSnippets = parseSnippets(tempMessage, 0) emlMessageTemp = parseTextURLTracking(tempMessage, "", msgID) emlMessage = msgHTMLHeader & tempMessage & msgHTMLFooter msgTextSnippets = parseSnippets(emlMessage, 0) emlSend = true end if end if else emlMessage = msgHTML emlSend = true end if else if msgSourceTextTimes = 2 then tempMessage = getNewsletterData("Text", usrRecord("SubscriberID"), usrRecord("Email"), "False", msgSourceURLText, bitResponse) if (NOT bitResponse) then emlSend = false else if lcase(tempMessage) = "skip" then emlSend = false else msgTextSnippets = parseSnippets(tempMessage, 0) emlMessageTemp = parseTextURLTracking("", tempMessage, msgID) emlMessage = msgTextHeader & tempMessage & msgTextFooter msgTextSnippets = parseSnippets(emlMessage, 0) emlSend = true end if end if else emlMessage = msgText msgTextSnippets = parseSnippets(emlMessage, 0) emlSend = true end if end if else if emlFormatInt = 0 then emlMessage = msgHTML emlSend = true else emlMessage = msgText emlSend = true end if end if emlSubject = msgSubject if emlSend then emlSubject = customizeIt(emlSubject, usrRecord, readURL, prfUnsubscribe, msgListName, msgID, NumSubscribers) emlMessage = customizeIt(emlMessage, usrRecord, readURL, prfUnsubscribe, msgListName, msgID, NumSubscribers) sendIt = sendEmail() updateSQL = "UPDATE ML_Broadcast SET BroadcastSubscribers = (BroadcastSubscribers + 1), msgBroadcastedDate = " & getNumFromDate(Now) & ", msgOnSubscriberID = " & usrRecord("SubscriberID") & ", msgActualRecipients = (msgActualRecipients + 1) WHERE MessageID = " & msgID else updateSQL = "UPDATE ML_Broadcast SET BroadcastSubscribers = (BroadcastSubscribers + 1), msgBroadcastedDate = " & getNumFromDate(Now) & ", msgOnSubscriberID = " & usrRecord("SubscriberID") & " WHERE MessageID = " & msgID end if mlConn.execute(updateSQL) if strDoTop AND msgUseSQL <> 2 then sendTotalPercent = round(((usrIndex + sendTotal3)* 100) / sendTotal) else sendTotalPercent = round((usrIndex * 100) / sendTotal) end if sendPagePercent = round(((usrIndex - sendStartPos) * 100) / sendPerPage) do while sendTotalWidth <= sendTotalPercent response.write "" sendTotalWidth = sendTotalWidth + 1 loop do while sendPageWidth <= sendPagePercent response.write "" sendPageWidth = sendPageWidth + 1 loop response.flush() usrRecord.movenext usrIndex = usrIndex + 1 msgFormatInt = "" wend if usrRecord.EOF then endOfBroadcast = finished() end if if usrIndex < sendTotal then %> <% else endOfBroadcast = finished() end if function sendEmail() select case SendMailer case "ASPMail", "ASPQMail" set Mailer = Server.CreateObject("SMTPsvg.Mailer") Mailer.RemoteHost = MailerPath Mailer.ContentType = emlFormatType Mailer.FromName = msgFromName Mailer.FromAddress = msgFromEmail Mailer.ReplyTo = msgReplyTo Mailer.AddRecipient usrRecord("Name"), usrRecord("Email") Mailer.Subject = emlSubject Mailer.BodyText = emlMessage Mailer.Priority = msgPriority if SendMailer = "ASPQMail" then Mailer.QMessage = true end if Mailer.SendMail case "ASPEmail" Mailer.Reset Mailer.AddAddress usrRecord("Email"), usrRecord("Name") Mailer.Subject = emlSubject if lcase(emlFormatText) = "text" then Mailer.IsHTML = false else Mailer.IsHTML = true end if Mailer.Body = emlMessage Mailer.Send case "JMail" Set Mailer = Server.CreateObject("JMail.SMTPMail") Mailer.ServerAddress = MailerPath & ":" & PortNum Mailer.ContentType = emlFormatType Mailer.AddRecipient usrRecord("Email") Mailer.Sender = msgFromEmail Mailer.ReplyTo = msgReplyTo Mailer.Subject = emlSubject Mailer.Body = emlMessage Mailer.Execute case "SA-SmtpMail" set Mailer = Server.CreateObject("SoftArtisans.SMTPMail") Mailer.RemoteHost = MailerPath Mailer.contenttype = emlFormatType Mailer.AddRecipient usrRecord("Name"), usrRecord("Email") Mailer.FromName = msgFromName Mailer.FromAddress = msgFromEmail Mailer.ReplyTo = msgReplyTo Mailer.Subject = emlSubject Mailer.BodyText = emlMessage Mailer.SendMail case else set Mailer = Server.CreateObject("CDONTS.NewMail") Mailer.MailFormat = emlFormatInt Mailer.BodyFormat = emlFormatInt Mailer.To = usrRecord("Name") & " <" & usrRecord("Email") & ">" Mailer.From = msgFromName & " <" & msgFromEmail & ">" Mailer.Subject = emlSubject Mailer.Body = emlMessage Mailer.Send end select end function function finished() mlConn.execute("UPDATE ML_URLs SET urlSends = " & usrIndex & " WHERE MessageID = " & msgID) mlConn.execute("UPDATE ML_Broadcast SET Status = 'Broadcasted', msgBroadcastedDate = " & cfgDate & ", BroadcastedBy = '" & replace(session("svUsername"), "'", "''") & "' WHERE MessageID = " & msgID) mlConn.execute("UPDATE ML_Lists SET LastEmailSentDate = " & cfgDate & " WHERE ListID = " & msgListID) response.write "" end function function customizeIt(data, usrRecord, readURL, prfUnsubscribe, msgListName, msgID, NumSubscribers) data = replace(data, "#newsletterid#", "" & msgID, 1, -1, 1) data = replace(data, "#shortdate#", "" & formatdatetime(now, 2), 1, -1, 1) data = replace(data, "#longdate#", "" & formatdatetime(now, 1), 1, -1, 1) data = replace(data, "#listname#", "" & msgListName, 1, -1, 1) data = replace(data, "#name#", "" & usrRecord("Name"), 1, -1, 1) data = replace(data, "#email#", "" & usrRecord("Email"), 1, -1, 1) data = replace(data, "#subscribed#", "" & getDateFromNum(usrRecord("SubscribedDate")), 1, -1, 1) data = replace(data, "#format#", "" & usrRecord("Format"), 1, -1, 1) data = replace(data, "#subscriberid#", "" & usrRecord("SubscriberID"), 1, -1, 1) data = replace(data, "#numbersubscribers#", "" & NumSubscribers, 1, -1, 1) data = replace(data, "#trackreads#", "", 1, -1, 1) nameArr = split(usrRecord("Name"), " ", -1, 1) if (UBound(nameArr) >= 0) then fname = nameArr(0) data = replace(data, "#firstname#", ""& fname, 1, -1, 1) if instr(1, data, "#unsubscribe#", 1) then code = 1 encode = usrRecord("Email") for idxChar = 1 to len(encode) code = code * asc(mid(encode, idxChar, 1)) mod 11111 next code = code mod 10000 data = replace(data, "#unsubscribe#", prfUnsubscribe & "&i=" & usrRecord("SubscriberID") & "&c=" & code & "&m=" & msgID, 1, -1, 1) end if data = replaceData(usrRecord, data) customizeIt = data end function function parseTextURLTracking(msgText, msgHTML, msgID) urlText = 0 do while instr(1, msgText, "[/url]", 1) > instr(1, msgText, "[url]", 1) and instr(1, msgText, "[url]", 1) > 0 urlText = urlText + 1 urlStart = instr(1, msgText, "[url]", 1) + 5 urlEnd = instr(urlStart, msgText, "[/url]", 1) urlRedirect = mid(msgText, urlStart, urlEnd - urlStart) set urlRecord = Server.CreateObject("ADODB.Recordset") urlRecord.ActiveConnection = mlConn urlRecord.Source = "SELECT * FROM ML_URLs WHERE urlInside = 0 AND MessageID = " & msgID & " AND urlIndex = " & urlText & " ORDER BY urlID DESC" urlRecord.CursorType = 3 urlRecord.Open() if urlRecord.eof then mlConn.execute("INSERT INTO ML_URLs (MessageID, urlRedirect, urlIndex, urlInside, urlClicks) VALUES (" & msgID & ", '" & replace(urlRedirect, "'", "''") & "', " & urlText & ", 0, 0)") set urlRecord = Server.CreateObject("ADODB.Recordset") urlRecord.ActiveConnection = mlConn urlRecord.Source = "SELECT * FROM ML_URLs WHERE urlInside = 0 AND MessageID = " & msgID & " AND urlIndex = " & urlText & " ORDER BY urlID DESC" urlRecord.CursorType = 3 urlRecord.Open() end if msgText = replace(msgText, "[url]" & urlRedirect & "[/url]", RedirectURL & "?i=#subscriberid#&l=" & urlRecord("urlID"), 1, -1, 1) loop if instr(1, msgText, "[/url]", 1) > 0 or instr(1, msgText, "[url]", 1) > 0 then response.write "" response.flush() response.end end if urlHTML = 0 do while instr(1, msgHTML, "[/url]", 1) > instr(1, msgHTML, "[url]", 1) and instr(1, msgHTML, "[url]", 1) > 0 urlHTML = urlHTML + 1 urlStart = instr(1, msgHTML, "[url]", 1) + 5 urlEnd = instr(urlStart, msgHTML, "[/url]", 1) urlRedirect = mid(msgHTML, urlStart, urlEnd - urlStart) set urlRecord = Server.CreateObject("ADODB.Recordset") urlRecord.ActiveConnection = mlConn urlRecord.Source = "SELECT * FROM ML_URLs WHERE urlInside = 1 AND MessageID = " & msgID & " AND urlIndex = " & urlHTML & " ORDER BY urlID DESC" urlRecord.CursorType = 3 urlRecord.Open() if urlRecord.eof then mlConn.execute("INSERT INTO ML_URLs (MessageID, urlRedirect, urlIndex, urlInside, urlClicks) VALUES (" & msgID & ", '" & replace(urlRedirect, "'", "''") & "', " & urlHTML & ", 1, 0)") set urlRecord = Server.CreateObject("ADODB.Recordset") urlRecord.ActiveConnection = mlConn urlRecord.Source = "SELECT * FROM ML_URLs WHERE urlInside = 1 AND MessageID = " & msgID & " AND urlIndex = " & urlHTML & " ORDER BY urlID DESC" urlRecord.CursorType = 3 urlRecord.Open() end if msgHTML = replace(msgHTML, "[url]" & urlRedirect & "[/url]", RedirectURL & "?i=#subscriberid#&l=" & urlRecord("urlID"), 1, -1, 1) loop if instr(1, msgHTML, "[/url]", 1) > 0 or instr(1, msgHTML, "[url]", 1) > 0 then response.write "" response.flush() response.end end if urlTotal = urlHTML + urlText mlConn.execute("UPDATE ML_Broadcast SET BroadcastURLs = " & urlTotal & " WHERE MessageID = " & msgID) end function function errRedirect() Response.Write "" end function %>