<%@ LANGUAGE = "VBScript" ENABLESESSIONSTATE = True %>
<%Option Explicit%>
<%Response.Buffer = True%>
<%Server.ScriptTimeout = 100000000%>
<%
'***********************************************************
'** Copyright Notice **
'** Tassietek - MailerPro **
'** Copyright 2001-2004 Tassietek All Rights Reserved. **
'***********************************************************
'** PREVENT PAGE FROM BEING CACHED
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 2
Response.AddHeader "pragma","no-cache"
Response.AddHeader "cache-control","private"
Response.CacheControl = "No-Store"
'** CHECKING TO SEE IF LOGGED IN IF NOT TAKE YOU TO THE LOGIN PAGE
If Request.Cookies("login") = "" Then
Response.Cookies("action") = "error"
Response.Write""
Response.End
End If
If Session("Start") = "" Then
Response.Cookies("a") = "ended"
Response.Write""
End If
'** VARIABLES
Dim stremail
Dim strdate
Dim strlistname
Dim strformat
Dim strsubject
Dim strattachment
Dim strmessage
Dim strtotal
Dim strcount
Dim strsentmessage
Dim strsentsubject
Dim strFooterhtml
Dim strFootertxt
Dim strpausecount
Dim strfieldcount
Dim stri
Dim strreplace
Dim strtrack
Dim strsendname
Dim strctotal
Dim rs
Dim sql
Dim strtrackname
Dim strattach
Dim strrecordarray
Dim i
Dim strFile
strctotal = Request("t")
If Not Request("action") = "continue" Then
'** IF FIELDS ARE EMPTY END SEND
If Request("fld_list_name") = "no" or Request("fld_format") = "" or Request("fld_subject") = "" or Request("fld_message") = "" Then
Response.End
End If
End If
If Request("action") = "continue" And Not Request("c") = "y" Then
%>
<%
End If
%>
Sending Email
<%
If Not Request("action") = "continue" Then
If instr(trim(Request("fld_message")),"[removal_link]") = 0 then
Response.Write"
Message does not contain the removal link variable [removal_link], must include this in any email you send!
"
Response.End
End If
End If
%>
Preparing to send please wait...
Total
Email
<%
Response.Write(vbCrLf & "")
Response.Flush
'** CHECK TO SEE IF TEST EMAIL
If Request("fld_test") = 1 Then
stremail = Session("TestEmail")
End If
If Not Request("action") = "continue" Then
%>
<%
If Request("fld_save_message") = 1 Then
If Not Request("fld_test") = 1 Then
sql = "Insert Into " & tbl_prefix & "saved_messages (save_name,format,subject,message) "
sql = sql & "Values( "
sql = sql & FormatDatabaseString(Request("fld_save_name"), Len(Request("fld_save_name"))) & ","
sql = sql & "'" & Request("fld_format") & "',"
sql = sql & FormatDatabaseString(Request("fld_subject"), Len(Request("fld_subject"))) & ","
sql = sql & FormatDatabaseString(Request("fld_message"), Len(Request("fld_message"))) & ")"
conn.execute sql, , adExecuteNoRecords
If err <> 0 Then
Response.Write""
err.clear
Response.End
End If
End If
End If
conn.execute("Delete From " & tbl_prefix & "save_details")
If err <> 0 Then
Response.Write""
err.clear
Response.End
End If
'** ADD MESSAGE EMAIL DETAILS TO SAVE TABLE
sql = "Insert Into " & tbl_prefix & "save_details (listname,format,subject,attachment,message,tracking_name,track) "
sql = sql & "Values("
sql = sql & "'" & Request("fld_list") & "',"
sql = sql & "'" & Request("fld_format") & "',"
sql = sql & FormatDatabaseString(Request("fld_subject"), Len(Request("fld_subject"))) & ","
If Request("fld_attachment") = "no" Then
sql = sql & "'',"
Else
sql = sql & "'" & Replace(Request("fld_attachment")," ","") & "',"
End If
sql = sql & FormatDatabaseString(Request("fld_message"), Len(Request("fld_message"))) & ","
If Request("fld_track") = 1 Then
sql = sql & FormatDatabaseString(Request("fld_tracking_name"), Len(Request("fld_tracking_name"))) & ","
sql = sql & "1)"
Else
sql = sql & "'',"
sql = sql & "0)"
End If
conn.execute sql, , adExecuteNoRecords
If err <> 0 Then
Response.Write""
err.clear
Response.End
End If
'** CREATING TEMP EMAIL TABLE
If Trim(Request("fld_where")) <> "" Then
sql = "INSERT INTO " & tbl_prefix & "temp_send SELECT email,field_1,field_2,field_3,field_4,field_5,field_6,field_7,field_8,field_9,field_10,edate,fromip FROM " & tbl_prefix & Request("fld_list") & " Where verified = 1 And " & Request("fld_field_select") & " " & Request("fld_equal") & " '%" & Request("fld_where") & "%'"
conn.Execute sql, , adExecuteNoRecords
If err <> 0 Then
Response.Write""
err.clear
Response.End
End If
Else
sql = "INSERT INTO " & tbl_prefix & "temp_send SELECT email,field_1,field_2,field_3,field_4,field_5,field_6,field_7,field_8,field_9,field_10,edate,fromip FROM " & tbl_prefix & Request("fld_list") & " Where verified = 1 "
conn.Execute sql, , adExecuteNoRecords
If err <> 0 Then
Response.Write""
err.clear
Response.End
End If
End If
End If
Set rs = conn.execute("Select * From " & tbl_prefix & "save_details", adOpenForwardOnly, adLockReadOnly)
If err <> 0 Then
Response.Write""
err.clear
Response.End
End If
strlistname = rs("listname")
strformat = rs("format")
strsubject = rs("subject")
If rs("attachment") <> "" Then
strattach = 1
strattachment = rs("attachment")
Else
strattachment = ""
End If
strmessage = rs("message")
If rs("track") = 1 Then
strtrackname = rs("tracking_name")
strtrack = rs("track")
End If
rs.close
Set rs = nothing
If Not Request("action") = "continue" And strtrack = 1 Then
sql = "Insert Into " & tbl_prefix & "tracking_lists (listID,sent_date,tracking_name) Values(" & strlistname & ",'" & SetDate(Now()) & "'," & FormatDatabaseString(strtrackname, Len(strtrackname)) & ")"
conn.execute sql, , adExecuteNoRecords
If err <> 0 Then
Response.Write""
err.clear
Response.End
End If
End If
Response.Write(vbCrLf & "")
Response.Flush
Set rs = conn.execute("Select Count(email) As total From " & tbl_prefix & "temp_send", adOpenForwardOnly, adLockReadOnly)
If err <> 0 Then
Response.Write""
err.clear
Response.End
End If
strtotal = rs("total")
strcount = Cint(strtotal)
rs.Close
Set rs = nothing
Set rs = conn.execute("Select * From " & tbl_prefix & "temp_send", adOpenForwardOnly, adLockReadOnly)
If err <> 0 Then
Response.Write""
err.clear
Response.End
End If
strfieldcount = getfields(strlistname,"field_count")
'** JAVASCIPT PROGRESS COUNTERS
If Request("fld_test") = 1 Then
Response.Write(vbCrLf & "")
Else
If Request("c") = "y" Then
Response.Write(vbCrLf & "")
Else
Response.Write(vbCrLf & "")
End If
End If
'** JAVASCIPT PROGRESS COUNTERS
If Request("fld_test") = 1 Then
Response.Write(vbCrLf & "")
Else
Response.Write(vbCrLf & "")
End If
'** START OF DATBASE EMAIL TABLE LOOP
Do While Not rs.EOF
If strtrack = 1 Then
sentemails(FormatDatabaseString(strtrackname, Len(strtrackname)))
End If
strpausecount = strpausecount + 1
'** REPLACE VARIABLES
strsentmessage = Replace(strmessage, "[email]", rs("email"))
strsentmessage = Replace(strsentmessage, "[list_name]", getlistname(strlistname))
strsentmessage = Replace(strsentmessage, "[subscribe_date]", DisplayDate(rs("edate")))
strsentmessage = Replace(strsentmessage, "[from_ip]", rs("fromip"))
For stri = 1 to strfieldcount
If getfields(strlistname,"type_" & stri) = 2 Or getfields(strlistname,"type_" & stri) = 8 Then
strrecordarray = getfields(strlistname,"field_" & stri)
strrecordarray = split(strrecordarray,",")
strreplace = Replace(strrecordarray(0), " ", "_")
strsentmessage = Replace(strsentmessage, "[" & strreplace & "]", rs("field_" & stri))
Else
strreplace = Replace(getfields(strlistname,"field_" & stri), " ", "_")
strsentmessage = Replace(strsentmessage, "[" & strreplace & "]", rs("field_" & stri))
End If
Next
strsentsubject = Replace(strsubject, "[email]", rs("email"))
strsentsubject = Replace(strsentsubject, "[list_name]", getlistname(strlistname))
strsentsubject = Replace(strsentsubject, "[subscribe_date]", DisplayDate(rs("edate")))
strsentsubject = Replace(strsentsubject, "[from_ip]", rs("fromip"))
For stri = 1 to strfieldcount
strreplace = Replace(getfields(strlistname,"field_" & stri), " ", "_")
strsentsubject = Replace(strsentsubject, "[" & strreplace & "]", rs("field_" & stri))
Next
'** JAVASCIPT PROGRESS COUNTERS
If Request("fld_test") = 1 Then
Response.Write(vbCrLf & "")
Else
Response.Write(vbCrLf & "")
End If
'**INITIALIZING strcount
If Request("fld_test") = 1 Then
strcount = 1
Else
strcount = strcount - 1
End If
'** JAVASCIPT PROGRESS COUNTERS
Response.Write(vbCrLf & "")
'** TEXT HTML REMOVAL LINKS
'** IF CUSTOMIZING CHANGE ONLY THE TEXT STRINGS
strFooterhtml = ""
If Request("fld_test") = 1 Then
strFooterhtml = strFooterhtml & " " & strhtmlRemovalLink & ""
Else
If strtrack = 1 Then
strFooterhtml = strFooterhtml & " " & strhtmlRemovalLink & ""
Else
strFooterhtml = strFooterhtml & " " & strhtmlRemovalLink & ""
End If
End If
strFootertxt = ""
If Request("fld_test") = 1 Then
strFootertxt = strFootertxt & Session("ScriptUrl") & "/r.asp?l=" & strlistname & "&a=uc&e="& Session("AdminEmail")
Else
strFootertxt = strFootertxt & Session("ScriptUrl") & "/r.asp?l=" & strlistname & "&a=uc&e="& rs("email")
End If
If strformat = "html" Then
strsentmessage = Replace(strsentmessage,"[removal_link]",strFooterhtml)
Else
strsentmessage = Replace(strsentmessage,"[removal_link]",strFootertxt)
End If
%>
<%
'** WRITING JAVASCIPT PROGRESS COUNTERS TO BROWSER
Response.Flush
'** IF TEST MESSAGE EXIT LOOP
If Request("fld_test") = 1 Then
Exit Do
End If
'** DELETING SENT EMAIL AND MOVE TO NEXT RECORD IN TEMP_SEND
conn.execute"Delete From " & tbl_prefix & "temp_send Where email = '" & rs("email") & "'", , adExecuteNoRecords
If err <> 0 Then
Response.Write""
err.clear
Response.End
End If
If strpausecount = 2000 Then
If Request("c") = "y" Then
%>
<%
Else
%>
<%
End If
strpausecount = 0
End If
'** IF BROWSER STOPS RESPONDING END SESSION AND SHUTDOWN
If Not Response.IsClientConnected Then
Dim Shutdownid
On Error Resume Next
rs.close
Set rs = nothing
conn.close
Set conn = nothing
Shutdownid = Session.SessionID
Shutdown(Shutdownid)
on error goto 0
Response.End
End If
rs.MoveNext
'** LOOP FUNCTION
Loop
'** CLOSING DATABASE CONNECTIONS
rs.Close
Set rs = nothing
%>
<%
If Request("fld_test") = 1 Then
conn.execute("Delete From " & tbl_prefix & "temp_send")
If err <> 0 Then
Response.Write""
err.clear
Response.End
End If
End If
'** JAVASCIPT PROGRESS COUNTERS
If Not Request("fld_test") = 1 Then
Response.Write(vbCrLf & "")
Response.Write""
End If
%>
<%
'** 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
%>