<%'Include Data Connection%>
<%
'open data connection
Call OpenConn()
%>
<%'Include Utility Scripts%>
<%
Dim strUserLanguage : strUserLanguage = "en"
Function CIntNumber(strString, strReturnValueIfNotNumeric)
If strString <> "" And IsNumeric(strString) Then
CIntNumber = CLng(strString)
Else
CIntNumber = strReturnValueIfNotNumeric
End If
End Function
Function IsValidEmail(emailAddress)
'Declare variables
Dim ValidEmail, emailParts, iLoopCounter, emailChar, acceptableChars
ValidEmail = True 'set the default result to True
'acceptableChars are the characters that we will allow in our email
acceptableChars="abcdefghijklmnopqrstuvwxyz.-_'@"
'use the Split function to create an array with the @ as the separator
'so if your email was test@tester.com the email would be split into an array
'with the first array element holding "test" and the second "tester.com"
emailParts = Split(emailAddress, "@")
'check to make sure that there is only 1 @ and that there are 2 parts
'remember arrays are zero based
'Using the UBound function will return the highest element in the array
'So if it's a valid email the UBound function will return 1, i.e. 0 start
If UBound(emailParts) <> 1 Then
ValidEmail = false
Else
'Check the length of each part of the email address
'first part can be just one character, 2nd part must be atleast 4
If Len(emailParts(0))<1 OR Len(emailParts(1))<4 Then
ValidEmail = false
End If
'check first character on the left part isn't a "." using Left function
If Left(emailParts(0), 1)="." Then
ValidEmail = false
End If
'check the last & 2nd character from right part using Right function
If Right(emailParts(1), 1) = "." OR Right(emailParts(1), 2) = "." Then
ValidEmail = false
End If
'check that there is a . in the second part of the email address - .com
If InStr(emailParts(1), ".") <= 0 Then
ValidEmail = false
End If
'check that there shouldn't be a _ in the second part of the email address
If InStr(emailParts(1), "_") >0 Then
ValidEmail = false
End If
End If
'loop through each character of email
For iLoopCounter = 1 to Len(emailAddress)
'Use Lcase & Mid functions, Mid function used to return each individual character
'in the email, and then Lcase converts it into lowercase
emailChar = Lcase(Mid(emailAddress, iLoopCounter, 1))
'Check if the emailAddress characters are acceptable
If InStr(acceptableChars, emailChar) = 0 and Not IsNumeric(emailChar) Then
ValidEmail = false
End if
Next
'check if there is 2 . in a row
If InStr(emailAddress, "..") > 0 Then
ValidEmail=false
End If
'check if there is @. in a row
If InStr(emailAddress, "@.") > 0 Then
ValidEmail=false
End If
IsValidEmail=ValidEmail
End function
Dim arrSubscribers
Dim intStepId : intStepId = CIntNumber(Request.QueryString("s"), 1)
Dim intAction : intAction = CIntNumber(Request.QueryString("a"), 0)
Dim intPostingTypeId
Dim strFileName, intDelType, strIndex
Dim strOther : strOther = ""
If intAction <> 1 Then
strIndex = Request.Form("txtIndex")
intDelType = CIntNumber(Request.Form("txtDelType"), 0)
If intDelType = 0 Then
intDelType = CIntNumber(Request.Form("optDelType"), 1)
End If
If intDelType = 4 Then
strOther = Request.Form("txtOther")
End If
strFileName = Request.Form("txtFileName")
If strFileName = "" Then
strFileName = Request.QueryString("f")
End If
intPostingTypeId = CIntNumber(Request.Form("txtPostingType"), 0)
strGroupList = Request.Form("txtGroupList")
End If
Select Case intAction
Case 1
Dim strDestinationFolder : strDestinationFolder = "/admin/temp"
'END: GET strDestinationFolder VALUE
' Create the FileUploader
Dim intScriptTimeout
Dim objFileSys
Dim strPhysicalPath
Dim objUploader, objFile
Set objUploader = New FileUploader
'start the upload process
objUploader.Upload()
'if no files were uploaded
If objUploader.Files.Count <> 0 Then
'get the current script timeout
intScriptTimeout = Server.ScriptTimeout
'set the script timeout to 3 minutes
Server.ScriptTimeout = 300
'if not unc path then...
If Not(Left(strDestinationFolder, 2) = "//") Then
'get the physical path into the strPhysicalPath variable
strPhysicalPath = Server.MapPath(strDestinationFolder)
Else
'get the physical path into the strPhysicalPath variable
strPhysicalPath = Replace(strDestinationFolder, "/", Chr(92))
End If
'initialize the file system object
Set objFileSys = CreateObject("Scripting.FileSystemObject")
' Loop through the uploaded files
For Each objFile In objUploader.Files.Items
'save the file to the mapped (virtual to physical) path
objFile.SaveToDisk strPhysicalPath
strFileName = objFile.FileName
'move to the next file to upload
Next
'release the file system object from memory
Set objFileSys = Nothing
'reset the script timeout
Server.ScriptTimeout = intScriptTimeout
End If
'release the uploader object from memory
Set objUploader = Nothing
'give the user some feedback as to the success of the file uploading process
If Err.Number = 0 Then
Response.Redirect("/admin/subscriber_import.asp?a=0&s=2&f=" & Server.URLEncode(strFileName))
Else
Response.Redirect("/admin/subscriber_import.asp?a=0&s=1&err=" & Err.Number)
End If
Case 2
intDelType = CIntNumber(Request.Form("optDelType"), 1)
Case 4
Dim strGroupList : strGroupList = ""
dim intItem
dim strCheckBoxName
dim intCheckBoxValue
dim intTempCheckBoxValue
dim arrCheckBoxValues
dim intInsertCounter
Dim intIsAllGroups
'Get all the checkboxes' value
For Each intItem In Request.Form
If inStr(intItem,"AllGroups") > 0 Then
'if allgroups is checked dont do the rest
intCheckBoxValue = 1
intIsAllGroups = 1
elseif Request("AllGroups") <> "1" then
intIsAllGroups = 0
If inStr(intItem,"chk") Then
strCheckBoxName = Right(intItem, Len(intItem)-3)
intTempCheckBoxValue = Request("chk"& CStr(strCheckBoxName)) &","
intCheckBoxValue = intCheckBoxValue & intTempCheckBoxValue
End if
End if
Next
'if no groups are selected, make Other the default value
if intCheckBoxValue = "" then
intCheckBoxValue = 5
intIsAllGroups = 1
end if
if intIsAllGroups = 0 then
'if all groups isnt checked then enter in the new groups for the user
intCheckBoxValue = Left(intCheckBoxValue, Len(intCheckBoxValue)-1)
arrCheckBoxValues = Split(intCheckBoxValue, ",")
For intInsertCounter = Lbound(arrCheckBoxValues) to Ubound(arrCheckBoxValues)
'if there is an array value then...
If arrCheckBoxValues(intInsertCounter) <> "" Then
' Call InsertUserGroups(intSubscriberId, CInt(arrCheckBoxValues(intInsertCounter)))
If strGroupList <> "" Then
strGroupList = strGroupList & "|"
End If
strGroupList = strGroupList & arrCheckBoxValues(intInsertCounter)
End If
Next
else
'If allgroups is checked or Other is the default group...enter in one group
' Call InsertUserGroups(intSubscriberId, CInt(intCheckBoxValue))
strGroupList = intCheckBoxValue
end if
intPostingTypeId = CIntNumber(Request.Form("selPostingType"), 0)
Case 5
arrSubscribers = GetSubscriberArray(strFileName, intDelType, strOther)
Dim intFirstNameIndex, intLastNameIndex, intEmailIndex
Dim arrIndex : arrIndex = Split(strIndex, "|")
Dim arrGroups : arrGroups = Split(strGroupList, "|")
Dim intG, intI, intS, strErrorIndex, strErrorNumber, bolValid, intSubscriberId, strFirstName, strLastName, strEmail
For intI = 0 To UBound(arrIndex)
Select Case arrIndex(intI)
Case 0
intFirstNameIndex = intI
Case 1
intLastNameIndex = intI
Case 2
intEmailIndex = intI
End Select
Next
For intS = 0 To UBound(arrSubscribers,2)
bolValid = True
strFirstName = Trim(arrSubscribers(intFirstNameIndex, intS))
strLastName = Trim(arrSubscribers(intLastNameIndex, intS))
strEmail = Trim(arrSubscribers(intEmailIndex, intS))
If strFirstName = "" Then
strErrorIndex = strErrorIndex & "|" & intS
strErrorNumber = strErrorNumber & "|" & 1
bolValid = False
End If
If strLastName = "" Then
strErrorIndex = strErrorIndex & "|" & intS
strErrorNumber = strErrorNumber & "|" & 2
bolValid = False
End If
If strEmail = "" Then
strErrorIndex = strErrorIndex & "|" & intS
strErrorNumber = strErrorNumber & "|" & 3
bolValid = False
Else
If Not IsValidEmail(strEmail) Then
strErrorIndex = strErrorIndex & "|" & intS
strErrorNumber = strErrorNumber & "|" & 4
bolValid = False
End If
End If
If bolValid Then
If IsNull(GetSubscriberIdFromEmail(strEmail)) Then
'add Subscriber
intSubscriberId = AddSubscriber(strFirstName, strLastName, strEmail, "", 1, "", 0, 5, "", "", "", 1)
For intG = 0 To UBound(arrGroups)
If arrGroups(intG) <> "" Then
Call InsertUserGroups(intSubscriberId, arrGroups(intG))
End If
Next
Call Add_Subscriber_PostingType(intPostingTypeId, intSubscriberId)
Else
strErrorIndex = strErrorIndex & "|" & intS
strErrorNumber = strErrorNumber & "|" & 5
bolValid = False
End If
End If
Next
'give the user feedback with regards to the success of the add/edit database transaction
'Session("FeedbackError") = err.number
'Session("FeedbackModule") = "subscriber_import"
'Response.Write("")
End Select
%>
