<%@ LANGUAGE = "VBScript" ENABLESESSIONSTATE = True %>
<%Option Explicit%>
<%Response.Buffer = False%>
<%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
Elseif Request.Cookies("login") = "3" Then
Response.Write("")
End If
If Session("Start") = "" Then
Response.Cookies("a") = "ended"
Response.Write""
End If
%>
<%
If Request("list_name") = "" Then
'nothing
Response.End
End If
'** DIM VARIABLES
Dim strinvalid
Dim strdup
Dim stradded
Dim strtotal
Dim strline
Dim strcount
Dim strsort
Dim strrecordarray
Dim strfieldcount
Dim stri
Dim strvalidate
Dim strlistfieldcount
Dim sql
Dim rs
strinvalid = 0
strdup = 0
stradded = 0
strtotal = 0
%>
<%
'**CREATING ARRAY
strline = Split(Request("records"), chr(13)&chr(10))
strcount = Ubound(strline)
strtotal = strcount + 1
strsort = Len(Trim(strline(0)))
If Right(Trim(strline(0)), 1) = "," Then
strline(0) = Left(Trim(strline(0)), strsort-1)
End If
strline(0) = Replace(strline(0), ",,", ",")
strrecordarray = split(Trim(strline(0)), ",")
strfieldcount = Ubound(strrecordarray)
Set rs = conn.execute("Select * From " & tbl_prefix & "listnames Where ID = " & Request("list_name"))
strlistfieldcount = rs("field_count") + 1
If Not strlistfieldcount = strfieldcount + 1 Then
Response.Write"
" &_
"Your first record in the import file does not match the number of fields in the List " & rs("list_name") & ". " &_
"The list " & rs("list_name") & " as " & strlistfieldcount & " and your import file as " & strfieldcount + 1 & ". " &_
"The List " & rs("list_name") & " fields are as follows.
"
Response.Write"Email "
For stri = 1 to rs("field_count")
Response.Write rs("field_" & stri) & " "
Next
Response.Write" Please check your import file for errors or choose a list with the same number of fields. " &_
"If you only correct your first record to fit this list, all other records without the correct number of fields will be ignored. " &_
"Please note that the script can only check for the correct number of fields, it can not check to see if the info your are entering match" &_
" the name of the fields.
"
Response.End
End If
rs.Close
Set rs = nothing
'** JAVASCRIPT PROGRESS COUNTER
Response.Write("" & vbCrLf)
For stri = 0 to strcount
strsort = Len(Trim(strline(stri)))
If Left(Trim(strline(stri)), 1) = "," Then
strline(stri) = Left(Trim(strline(stri)), strsort-1)
End If
strline(stri) = Replace(Trim(strline(stri)), ",,", ",")
strrecordarray = split(Trim(strline(stri)), ",")
strfieldcount = Ubound(strrecordarray)
If Trim(strline(stri)) = "" Then
strinvalid = strinvalid + 1
Response.Write("" & vbCrLf)
Response.Write("" & vbCrLf)
Elseif Not strlistfieldcount = strfieldcount + 1 Then
strinvalid = strinvalid + 1
Response.Write("" & vbCrLf)
Response.Write("" & vbCrLf)
Else
'**CHECKING EMAIL SYNTAX
strvalidate = RegExpTest(Trim(Lcase(strrecordarray(0))))
If Not strvalidate = True Then
strinvalid = strinvalid + 1
'** JAVASCRIPT PROGRESS COUNTER
Response.Write("" & vbCrLf)
Response.Write("" & vbCrLf)
End If
'** CREATING CONNECTION TO DATABASE EMAIL TABLE
If strvalidate = True Then
sql = "SELECT * FROM " & tbl_prefix & Request("list_name") & " WHERE email = '" & Trim(Lcase(strrecordarray(0))) & "'"
Set rs = conn.execute(sql, adOpenForwardOnly, adLockReadOnly)
If err <> 0 Then
Response.Write""
err.clear
Response.End
End If
'** CHECKING FOR DUPLICATE EMAIL
If Not rs.EOF Then
strdup = strdup + 1
'** JAVASCRIPT PROGRESS COUNTER
Response.Write("" & vbCrLf)
Response.Write("" & vbCrLf)
End If
'** ENTERING VALID EMAIL TO DATABASE EMAIL TABLE
If rs.EOF Then
stradded = stradded +1
'** JAVASCRIPT PROGRESS COUNTER
Response.Write("" & vbCrLf)
sql = "Insert Into " & tbl_prefix & Request("list_name")
sql = sql & "(email,field_1,field_2,field_3,field_4,field_5,field_6,field_7,field_8,field_9,field_10,edate,fromip,verified,reminder_sent,admin_entry) "
sql = sql & "Values("
sql = sql & "'" & Trim(Lcase(strrecordarray(0))) & "',"
If strfieldcount >= 1 Then
sql = sql & FormatDatabaseString(Trim(strrecordarray(1)), Len(Trim(strrecordarray(1)))) & ","
Else
sql = sql & "'',"
End If
If strfieldcount >= 2 Then
sql = sql & FormatDatabaseString(Trim(strrecordarray(2)), Len(Trim(strrecordarray(2)))) & ","
Else
sql = sql & "'',"
End If
If strfieldcount >= 3 Then
sql = sql & FormatDatabaseString(Trim(strrecordarray(3)), Len(Trim(strrecordarray(3)))) & ","
Else
sql = sql & "'',"
End If
If strfieldcount >= 4 Then
sql = sql & FormatDatabaseString(Trim(strrecordarray(4)), Len(Trim(strrecordarray(4)))) & ","
Else
sql = sql & "'',"
End If
If strfieldcount >= 5 Then
sql = sql & FormatDatabaseString(Trim(strrecordarray(5)), Len(Trim(strrecordarray(5)))) & ","
Else
sql = sql & "'',"
End If
If strfieldcount >= 6 Then
sql = sql & FormatDatabaseString(Trim(strrecordarray(6)), Len(Trim(strrecordarray(6)))) & ","
Else
sql = sql & "'',"
End If
If strfieldcount >= 7 Then
sql = sql & FormatDatabaseString(Trim(strrecordarray(7)), Len(Trim(strrecordarray(7)))) & ","
Else
sql = sql & "'',"
End If
If strfieldcount >= 8 Then
sql = sql & FormatDatabaseString(Trim(strrecordarray(8)), Len(Trim(strrecordarray(8)))) & ","
Else
sql = sql & "'',"
End If
If strfieldcount >= 9 Then
sql = sql & FormatDatabaseString(Trim(strrecordarray(9)), Len(Trim(strrecordarray(9)))) & ","
Else
sql = sql & "'',"
End If
If strfieldcount >= 10 Then
sql = sql & FormatDatabaseString(Trim(strrecordarray(10)), Len(Trim(strrecordarray(10)))) & ","
Else
sql = sql & "'',"
End If
sql = sql & FormatDatabaseDate(SetDate(Now())) & ","
sql = sql & "'" & getfromip() & "',"
sql = sql & "1,"
sql = sql & "0,"
sql = sql & "1)"
conn.execute sql, ,adExecuteNoRecords
If err <> 0 Then
Response.Write""
err.clear
Response.End
End If
End If
rs.close
Set rs = nothing
End If
End if
'**CLOSING SESSION IF CLEINT NO LONGER CONNECTED
If Not Response.IsClientConnected Then
Dim Shutdownid
On Error Resume Next
rs.close
Set rs = nothing
rsfun.close
Set rsfun = nothing
conn.close
Set conn = nothing
Shutdownid = Session.SessionID
Shutdown(Shutdownid)
on error goto 0
Response.End
End If
Next
'** JAVASCRIPT PROGRESS COUNTER
Response.Write("")
%>
<%
'** 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
%>