<%@ 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
Elseif Request.Cookies("login") = "3" Then
Response.Write("")
End If
If Session("Start") = "" Then
Response.Cookies("a") = "ended"
Response.Write""
End If
%>
<%
'If Request("action") = "import" Then
'** DECLARING VARIABLES
Const fsoForReading = 1
Dim strtotal
Dim strdup
Dim strimported
Dim strinvalid
Dim objFSO
Dim objTextStream
Dim strLine
Dim strsort
Dim strrecordarray
Dim strfieldcount
Dim strlistfieldcount
Dim stri
Dim strvalidate
Dim rs
Dim sql
Dim spfield_1
Dim spfield_2
Dim spfield_3
Dim spfield_4
Dim spfield_5
Dim spfield_6
Dim spfield_7
Dim spfield_8
Dim spfield_9
Dim spfield_10
strtotal = 0
strdup = 0
strimported = 0
strinvalid = 0
Response.Write""
'** SETTING OBJECT TO READ IMPORT FILE FOR ERRORS IN FILE
Set objFSO = Server.CreateObject ("Scripting.FileSystemObject")
If err <> 0 Then
Response.Write""
err.clear
Response.End
End If
If Not (objFSO.FileExists(Session("ScriptPath") & "\import\" & Request("import_file"))) Then
'nothing
Else
Set objTextStream = objFSO.OpenTextFile (Session("ScriptPath") & "\import\" & Request("import_file"), fsoForReading)
If err <> 0 Then
Response.Write""
err.clear
Response.End
End If
strLine = Trim(objTextStream.Readline)
strsort = Len(Trim(strline))
If Right(Trim(strline), 1) = "," Then
strline = Left(Trim(strline), strsort-1)
End If
strline = Replace(strline, ",,", ",")
strrecordarray = split(Trim(strline), ",")
strfieldcount = Ubound(strrecordarray)
Set rs = conn.execute("Select * From " & tbl_prefix & "listnames Where ID = " & Request("ID"))
strlistfieldcount = rs("field_count") + 1
'** IF FIRST LINE IN IMPORT FILE DOES NOT MATCH LIST FIELDS COUNT THEN STOP PROCESS AND SHOW ERROR
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
objTextStream.Close
Set objTextStream = Nothing
Set objFSO = Nothing
'** COUNT TOTAL RECORDS IN IMPORT FILE
Set objFSO = Server.CreateObject ("Scripting.FileSystemObject")
If err <> 0 Then
Response.Write""
err.clear
Response.End
End If
Set objTextStream = objFSO.OpenTextFile (Session("ScriptPath") & "\import\" & Request("import_file"), fsoForReading)
If err <> 0 Then
Response.Write""
err.clear
Response.End
End If
Do While Not objTextStream.AtEndOfStream
strtotal = strtotal +1
strLine = Trim(objTextStream.Readline)
Loop
objTextStream.Close
Set objTextStream = Nothing
Set objFSO = Nothing
End If
'** WRITING TOTAL RECORDS TO BROWSER
Response.Write""
strtotal = 0 'setting variable to 0
'** OPENING IMPORT FILE AND PLACING CONTENTS TO A ARRAY THEN CLOSING TEXT FILE
'** THIS MAKES IMPORT TO DATABASE FASTER
Set objFSO = Server.CreateObject ("Scripting.FileSystemObject")
If err <> 0 Then
Response.Write""
err.clear
Response.End
End If
If Not (objFSO.FileExists(Session("ScriptPath") & "\import\" & Request("import_file"))) Then
'nothing
Else
Set objTextStream = objFSO.OpenTextFile (Session("ScriptPath") & "\import\" & Request("import_file"), fsoForReading)
If err <> 0 Then
Response.Write""
err.clear
Response.End
End If
strtextfile = objTextStream.ReadAll
objTextStream.Close
Set objTextStream = Nothing
Set objFSO = Nothing
strtextfile = Split(strtextfile, chr(13)&chr(10))
strtotalrecords = Ubound(strtextfile)
'** STARTING THE IMPORTING TO DATABASE
For i = 0 To strtotalrecords
strtotal = strtotal + 1
strLine = Trim(strtextfile(i))
strsort = Len(Trim(strline))
If Right(Trim(strline), 1) = "," Then
strline = Left(Trim(strline), strsort-1)
End If
strline = Replace(strline, ",,", ",")
strrecordarray = split(Trim(strline), ",")
strfieldcount = Ubound(strrecordarray)
If Trim(strLine) = "" 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
strrecordarray = split(strLine,",")
strfieldcount = Ubound(strrecordarray)
strvalidate = RegExpTest(strrecordarray(0))
If Not strvalidate = True Then
strinvalid = strinvalid + 1
Response.Write("" & vbCrLf)
Response.Write("" & vbCrLf)
End If
'** OPENING DATABASE FOR SELECTED LIST TABLE
If strvalidate = True Then
Set rs = conn.execute("SELECT * FROM " & tbl_prefix & Request("ID") & " WHERE email = '" & strrecordarray(0) & "'")
If err <> 0 Then
Response.Write""
err.clear
Response.End
End If
If Not rs.EOF Then
strdup = strdup + 1
Response.Write("" & vbCrLf)
Response.Write("" & vbCrLf)
Else
strimported = strimported +1
Response.Write("" & vbCrLf)
'** ADDING IMPORTED RECORDS
sql = "Insert Into " & tbl_prefix & Request("ID")
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,,adCmdText + adExecuteNoRecords
If err <> 0 Then
Response.Write""
err.clear
Response.End
End If
End If
End If
Response.Flush
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
rs.Close
Set rs = nothing
End If
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
%>