CDOMail SMTP Authentication

coreybryant
coreybryant used Ask the Experts™
on
I have a newsletter that I need a little help with the code.  The mail server requires SMTP authentication with no way of bypassing this.

The newsletter code for sending the emails has each of the ASP email components listed but try as I might, I cannot add the correct code at the proper place (to add an email address and password) for the SMTP authentication.  

I don't need the code to process a form - I am looking for help on where to add the correct code in the file below - I think the code below is the file being called when the newsletter is broadcasted.  If not, I have other files as well but this seems like the one (hopefully).  I am pretty sure the component is being called on / about line 377
<%
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
function subscribeNew (MLName, MLEmail, MLFormat, MLListID, MLSubscriberID)
	' adds a subscriber from the passed information, returning a value based upon success or failure
	' 1 = Invalid ListID
	' 2 = Invalid Email Address
	' 3 = Invalid Format
	' 4 = Invalid List (not found)
	' 5 = Email Already subscribed to that list
	' 6 = Successfull, but no SubscriberID found
	' 7 = Successfull, SubscriberID returned as MLSubscriberID
	' 8 = Blocked domain
	if Trim(MLListID) = "" or NOT IsNumeric(MLListID) Then
		subscribeNew = 1 : exit function
	else
		if NOT VerifyEmail(MLEmail) then
			subscribeNew = 2 : exit function
		else
			if LCase(MLFormat) <> "text" and LCase(MLFormat) <> "html" then
				subscribeNew = 3 : exit function
			else
				set lstCheck = mlConn.Execute("SELECT * FROM ML_Lists WHERE ListID = " & MLListID)
				if lstCheck.EOF then
					set lstCheck = nothing : subscribeNew = 4 : exit function
				else
					set lstCheck = nothing
					set dupCheck = mlConn.Execute("SELECT * FROM ML_Subscribers WHERE Email = '" & Replace(MLEmail, "'", "''") & "' AND ListID = " & MLListID)
					if NOT dupCheck.EOF then
						set dupCheck = nothing : subscribeNew = 5 : exit function
					else
						set dupCheck = nothing
						domain = split(MLEmail, "@") : MLDomain = domain(UBound(domain))
						set blockedDomain = mlConn.Execute("SELECT * FROM ML_Blocked WHERE blkType = 0 and blkText = '" & replace(MLDomain, "'", "''") & "'")
						if NOT blockedDomain.EOF then
							set blockedDomain = nothing : subscribeNew = 8 : exit function
						else
							set blockedDomain = nothing
							if (LCase(MLFormat) = "text") then MLFormat = "Text"
							if (LCase(MLFormat) = "html") then MLFormat = "HTML"
							mlConn.Execute("INSERT INTO ML_Subscribers (Name, Email, Format, ListID, SubscribedDate, numClicks, numReads, numBounces, numReplies) VALUES ('" & Replace(MLName, "'", "''") & "','" & Replace(MLEmail, "'", "''") & "','" & UCase(MLFormat) & "'," & MLListID & ",'" & getNumFromDate(Now) & "',0,0,0,0)")
								set getNewSubscriber = mlConn.Execute("SELECT * FROM ML_Subscribers WHERE ListID = " & MLListID & " AND Email = '" & MLEmail & "'")
									if getNewSubscriber.EOF then
										set getNewSubscriber = nothing : subscribeNew = 6 : exit function
									else
										MLSubscriberID = getNewSubscriber("SubscriberID") : set getNewSubscriber = nothing
										subscribeNew = 7 : exit function
									end if
						end if
					end if
				end if
			end if
		end if
	end if
end function
 
'==============================
 
function removeSubscriber (MLSubscriberID, strDBType)
	' removes a subscriber based upon their subscriber ID
	' returns 2 if accepted, 1 otherwise
	removeSubscriber = 1
	if trim(MLSubscriberID) <> "" AND IsNumeric(MLSubscriberID) then
		if lcase(strDBType) = "access" Then
			mlConn.Execute("DELETE * FROM ML_Subscribers WHERE SubscriberID = " & MLSubscriberID)
		else
			mlConn.Execute("DELETE FROM ML_Subscribers WHERE SubscriberID = " & MLSubscriberID)
		end if
		removeSubscriber = 2 : exit function
	end if
end function
 
'==============================
 
function getSubscriber(MLSubscriberID, MLListID, MLListName, MLName, MLEmail, MLFormat, MLSubscribed, MLClicks, MLReads)
	' gets a subscribers information from an ID number
	' 1 = Invalid ID Number
	' 2 = Subscriber not found
	' 3 = Subscriber found
	getSubscriber = 1
	if trim(MLSubscriberID) <> "" AND IsNumeric(MLSubscriberID) then
		set getSub = mlConn.execute("SELECT ML_Subscribers.ListID, ML_Lists.Listname, ML_Subscribers.Email, ML_Subscribers.Name, ML_Subscribers.Format, ML_Subscribers.SubscribedDate, ML_Subscribers.NumClicks, ML_Subscribers.NumReads, ML_Subscribers.SubscriberID FROM ML_Subscribers INNER JOIN ML_Lists ON ML_Subscribers.ListID = ML_Lists.ListID WHERE ML_Subscribers.SubscriberID = " & MLSubscriberID)
		if getSub.EOF then
			getSub.Close() : set getSub = nothing
			getSubscriber = 2 : exit function
		else
			MLListID = getSub("ListID")
			MLListName = getSub("ListName")
			MLEmail = getSub("Email")
			MLName = getSub("Name")
			MLFormat = getSub("Format")
			MLSubscribed = getDateFromNum(getSub("SubscribedDate"))
			MLClicks = getSub("numClicks")
			MLReads = getSub("numReads")
			MLSubscriberID = getSub("SubscriberID")
			getSub.Close() : set getSub = nothing
			getSubscriber = 3 : exit function
		end if
	end if
end function
 
'==============================
 
function getSubscriber2(MLSubscriberID, MLListID, MLListName, MLName, MLEmail, MLFormat, MLSubscribed, MLClicks)
	' gets a subscribers information from an email address and ListID
	' 1 = Invalid Data
	' 2 = Subscriber not found
	' 3 = Subscriber found
	getSubscriber2 = 1
	if trim(MLListID) <> "" AND IsNumeric(MLListID) AND verifyEmail(MLEmail) then
		set getSub = mlConn.execute("SELECT ML_Subscribers.ListID, ML_Lists.Listname, ML_Subscribers.Email, ML_Subscribers.Name, ML_Subscribers.Format, ML_Subscribers.SubscribedDate, ML_Subscribers.NumClicks, ML_Subscribers.NumReads, ML_Subscribers.SubscriberID FROM ML_Subscribers INNER JOIN ML_Lists ON ML_Subscribers.ListID = ML_Lists.ListID WHERE ML_Subscribers.ListID = " & MLListID & " AND ML_Subscribers.Email = '" & trim(MLEmail) & "'")
		if getSub.EOF then
			getSub.Close() : set getSub = nothing
			getSubscriber2 = 2 : exit function
		else
			MLListID = getSub("ListID")
			MLListName = getSub("ListName")
			MLEmail = getSub("Email")
			MLName = getSub("Name")
			MLFormat = getSub("Format")
			MLSubscribed = getDateFromNum(getSub("SubscribedDate"))
			MLClicks = getSub("numClicks")
			MLReads = getSub("numReads")
			MLSubscriberID = getSub("SubscriberID")
			getSub.Close() : set getSub = nothing
			getSubscriber2 = 3 : exit function
		end if
	end if
end function
 
'==============================
 
function editSubscriber(MLSubscriberID, MLListID, MLName, MLEmail, MLFormat)
	' adds a subscriber from the passed information, returning a value based upon success or failure
	' 1 = Invalid List or Subscriber ID
	' 2 = Invalid Email Address
	' 3 = Invalid Format
	' 4 = Invalid List (not found)
	' 5 = Subscriber not found
	' 6 = Succsessful
	if Trim(MLListID) = "" or NOT IsNumeric(MLListID) or trim(MLSubscriberID) = "" or NOT IsNumeric(MLSubscriberID) then
		editSubscriber = 1 : exit function
	else
		if NOT VerifyEmail(MLEmail) then
			editSubscriber = 2 : exit function
		else
			if LCase(MLFormat) <> "text" and LCase(MLFormat) <> "html" then
				editSubscriber = 3 : exit function
			else
				set lstCheck = mlConn.Execute("SELECT * FROM ML_Lists WHERE ListID = " & MLList)
				if lstCheck.EOF then
					editSubscriber = 4 : exit function
				else
					set subCheck = mlConn.Execute("SELECT * FROM ML_Subscribers WHERE SubscriberID = " & MLSubscriberID)
					if NOT subCheck.EOF then
						editSubscriber = 5 : exit function
					else
						if (LCase(MLFormat) = "text") then MLFormat = "Text"
						if (LCase(MLFormat) = "html") then MLFormat = "HTML"
						mlConn.Execute("UPDATE ML_Subscribers SET MLName = '" & MLName & "', MLEmail = '" & MLEmail & "', MLFormat = '" & MLFormat & "' WHERE SubscriberID = " & MLSubscriberID)
						editSubscriber = 6 : exit function
					end if
				end if
			end if
		end if
	end if
end function
 
 
function getDateFromNum(val)
on error resume next
if len(val) = 0 or len(val) = 1 then
getDateFromNum = Now
else
newDate = dateadd("s", val, "1/1/1980")
newDate = CDate(newDate)
getDateFromNum = newDate
end if
end function
function getNumFromDate(val)
if NOT IsDate(val) then
getNumFromDate = 0
else
getNumFromDate = datediff("s", CDate("1/1/1980"), val)
end if
end function
function replaceData(objName, data)
on error resume next
for each tblField in objName.fields
if (trim(tblField) = "") then newData = " " else newData = tblField
data = replace(data, "#" & tblField.name & "#", newData, 1, -1, 1)
next
replaceData = data
end function
function getNewsletterData(Format, SubscriberID, Email, TestMode, URL, bitResponse)
if (instr(1, URL, "?") <> 0) then
strURL = URL & "&SubscriberID=" & SubscriberID & "&Email=" & server.urlencode(Email) & "&Format=" & Format & "&Test=" & Testmode
else
strURL = URL & "?SubscriberID=" & SubscriberID & "&Email=" & server.urlencode(Email) & "&Format=" & Format & "&Test=" & Testmode
end if
msgBody = getHTML(strURL, bitResponse)
if bitResponse then
getNewsletterData = msgBody
else
getNewsletterData = ""
end if
end function
function countOccurances(strData, strSearch)
dim count, curPos, maxPos, incPos
count = 0
curPos = 1
maxPos = len(strData)
incPos = len(strSearch)
if maxPos > 0 and incPos > 0 then
do until curPos = 0 or curPos >= maxPos
curPos = instr(curPos, strData, strSearch, 1)
if curPos > 0 then
count = count + 1
curPos = curPos + incPos
end if
loop
countOccurances = count
else
countOccurances = 0
end if
end function
function delCommand(strSQL, ELetter_String)
mlConn.Execute(strSQL)
end function
function snippetCount(data)
totalSnippets = 0
do while instr(1, data, "[/snip]", 1) > instr(1, data, "[snip]", 1) and instr(1, data, "[snip]", 1) > 0
totalSnippets = totalSnippets + 1
loop
end function
function snippetCheck(data)
badSnippets = 0
do while instr(1, data, "[/snip]", 1) > instr(1, data, "[snip]", 1) and instr(1, data, "[snip]", 1) > 0
snipStart = instr(1, data, "[snip]", 1) + 6
snipEnd = instr(snipStart, data, "[/snip]", 1)
snipCode = mid(data, snipStart, snipEnd - snipStart)
snipDate = " "
set snipRecord = mlConn.Execute("SELECT snipID, snipData FROM ML_Snippets WHERE snipCode = '" & replace(snipCode, "'", "''") & "'")
if snipRecord.EOF then badSnippets = badSnippets + 1
set snipRecord = nothing
data = replace(data, "[snip]" & snipCode & "[/snip]", snipData, 1, -1, 1)
loop
snippetCheck = badSnippets
end function
function parseSnippets(data, displayError)
do while instr(1, data, "[/snip]", 1) > instr(1, data, "[snip]", 1) and instr(1, data, "[snip]", 1) > 0
snipStart = instr(1, data, "[snip]", 1) + 6
snipEnd = instr(snipStart, data, "[/snip]", 1)
snipCode = mid(data, snipStart, snipEnd - snipStart)
set snipRecord = mlConn.Execute("SELECT snipID, snipData FROM ML_Snippets WHERE snipCode = '" & replace(snipCode, "'", "''") & "'")
if snipRecord.EOF then
if (displayError <> 1) then snipData = "" else snipData = "[b][font size=4]ERROR: Snippet Code NOT found. Please review your newsletter data.[/font][/b]"
else
snipData = snipRecord("snipData")
end if
set snipRecord = nothing
data = replace(data, "[snip]" & snipCode & "[/snip]", snipData, 1, -1, 1)
loop
end function
function listsDropDown(defaultValue, allowedLists, noLists)
loopNum = 0
thisDefaultValue = defaultValue
set getLists = mlConn.Execute("SELECT ListID, ListName FROM ML_Lists ORDER BY ListName ASC")
if getLists.EOF then
noLists = true : exit function
else
noLists = false
while (NOT getLists.EOF)
loopNum = loopNum + 1 : funcListID = getLists("ListID") : funcListName = getLists("ListName")
showOutput = formOutput(thisDefaultValue, funcListID, funcListName, quit)
funcListID = "" : funcListName = ""
getLists.MoveNext()
wend
set getLists = nothing
end if
end function
function allowedList(listID, allowedLists)
allowedList = true
end function
function listWhere(allowedLists, tblPrefix)
listWhere = ""
end function
function whichFormat(format)
if (cstr(lcase(left(Format, 1))) = "h" or cstr(left(Format, 1)) = "0") then whichFormat = "HTML" else whichFormat = "Text"
end function
function sendEmail(Mailer, Message, FromEmail, ToEmail, FromName, ToName, Subject, MailerPath, MailerPort, Format, BCCEmail, CCEmail, ReplyTo)
if NOT verifyEmail(FromEmail) then
sendEmail = 1 : exit function
elseif NOT verifyEmail(ToEmail) then
sendEmail = 2 : exit function
elseif ReplyTo <> "" and NOT verifyEmail(ReplyTo) then
sendEmail = 5 : exit function
elseif trim(Message) = "" then
sendEmail = 6 : exit function
elseif trim(subject) = "" then
sendEmail = 7 : exit function
elseif Mailer = "" then
sendEmail = 8 : exit function
end if
if BCCEmail <> "" then
bccList = split(BCCEmail, ",")
for i = 0 to ubound(bccList)
if NOT verifyEmail(trim(bccList(i))) then
sendEmail = 3 : exit function
end if
next				
end if
if CCEmail <> "" then
ccList = split(CCEmail, ",")
for i = 0 to ubound(ccList)
if NOT verifyEmail(trim(ccList(i))) then
sendEmail = 3 : exit function
end if
next				
end if
if lcase(trim(Left(format, 1))) = "h" then
format = "text/html"
else
format = "text/plain"
end if
MailerProgram = lcase(cstr(mailer))
select case MailerProgram
case "1", "cdonts", "cdomail"
sendIt = CDONTS_Mailer(Message, FromEmail, ToEmail, FromName, ToName, Subject, MailerPath, MailerPort, Format, BCCEmail, CCEmail, ReplyTo)
case "2", "aspmail"
sendIt = ASPMail_Mailer(Message, FromEmail, ToEmail, FromName, ToName, Subject, MailerPath, MailerPort, Format, BCCEmail, CCEmail, ReplyTo)
case "3", "aspqmail"
sendIt = ASPQMail_Mailer(Message, FromEmail, ToEmail, FromName, ToName, Subject, MailerPath, MailerPort, Format, BCCEmail, CCEmail, ReplyTo)
case "4", "jmail"
sendIt = JMail_Mailer(Message, FromEmail, ToEmail, FromName, ToName, Subject, MailerPath, MailerPort, Format, BCCEmail, CCEmail, ReplyTo)
case "5", "sasmtpmail", "sa-smtpmail"
sendIt = SASmtpMail_Mailer(Message, FromEmail, ToEmail, FromName, ToName, Subject, MailerPath, MailerPort, Format, BCCEmail, CCEmail, ReplyTo)
case "6", "aspemail"
sendIt = ASPEMail_Mailer(Message, FromEmail, ToEmail, FromName, ToName, Subject, MailerPath, MailerPort, Format, BCCEmail, CCEmail, ReplyTo)
case else
sendEmail = 8 : exit function
end select
if NOT sendIt then
sendEmail = 9 : exit function
else
sendEmail = 10 : exit function
end if
end function
function getResponse(val)
if val = 1 then
resp = "1 = Invalid From email"
elseif val = 2 then
resp = "2 = Invalid To email"
elseif val = 3 then
resp = "3 = Invalid BCC email"
elseif val = 4 then
resp = "4 = Invalid CC email"
elseif val = 5 then
resp = "5 = Invalid ReplyTo email"
elseif val = 6 then
resp = "6 = No message"
elseif val = 7 then
resp = "7 = No subject"
elseif val = 8 then
resp = "8 = No mailer selected"
elseif val = 9 then
resp = "9 = Error sending email"
elseif val = 10 then
resp = "10 = Email sent successfully!"
else
resp = "No value returned"
end if
getResponse = resp
end function
function CDONTS_Mailer(Message, FromEmail, ToEmail, FromName, ToName, Subject, MailerPath, MailerPort, Format, BCCEmail, CCEmail, ReplyTo)
if LCase(Right(Format, 1)) = "l" then Format = 0 else Format = 1
set Mailer = Server.CreateObject("CDONTS.NewMail") 
if NOT isObject(Mailer) Then
CDONTS_Mailer = false
else
Mailer.MailFormat = Format
Mailer.BodyFormat = Format
Mailer.To = ToName & " <" & ToEmail & ">"
Mailer.From = FromName & " <" & FromEmail & ">"
if (ReplyTo <> "") then Mailer.Value("Reply-To") = ReplyTo
if (BCCEmail <> "") then
Mailer.Bcc = trim(bccEmail)
end if
if (CCEmail <> "") then
Mailer.Cc = trim(ccEmail)
end if
Mailer.Subject = Subject
Mailer.Body = Message
Mailer.Send
if (err.Number <> 0) then CDONTS_Mailer = false else CDONTS_Mailer = true
end if
set Mailer = nothing
end function
function ASPMail_Mailer(Message, FromEmail, ToEmail, FromName, ToName, Subject, MailerPath, MailerPort, Format, BCCEmail, CCEmail, ReplyTo)
set Mailer = Server.CreateObject("SMTPsvg.Mailer")
if NOT isObject(Mailer) Then
ASPMail_Mailer = false
else
Mailer.ContentType = Format
Mailer.RemoteHost = MailerPath
Mailer.FromName = FromName
Mailer.FromAddress = FromEmail
Mailer.ReplyTo = ReplyTo
Mailer.AddRecipient ToName, ToEmail
if (ReplyTo <> "") then Mailer.ReplyTo = ReplyTo
if (BCCEmail <> "") then
bccList = split(BCCEmail, ",")
for i = 0 to ubound(bccList)
Mailer.AddBcc trim(bccList(i)), trim(bccList(i))
next
end if
if (CCEmail <> "") then
ccList = split(CCEmail, ",")
for i = 0 to ubound(ccList)
Mailer.AddCc trim(ccList(i)), trim(ccList(i))
next
end if
Mailer.Subject = Subject
Mailer.BodyText = Message
Mailer.SendMail
if (err.Number <> 0) then ASPMail_Mailer = false else ASPMail_Mailer = true
end if
set Mailer = nothing
end function
function ASPQMail_Mailer(Message, FromEmail, ToEmail, FromName, ToName, Subject, MailerPath, MailerPort, Format, BCCEmail, CCEmail, ReplyTo)
set Mailer = Server.CreateObject("SMTPsvg.Mailer")
if NOT isObject(Mailer) Then
ASPMail_Mailer = false
else
Mailer.ContentType = Format
Mailer.RemoteHost = MailerPath
Mailer.FromName = FromName
Mailer.FromAddress = FromEmail
Mailer.ReplyTo = ReplyTo
Mailer.AddRecipient ToName, ToEmail
if (ReplyTo <> "") then Mailer.ReplyTo = ReplyTo
if (BCCEmail <> "") then
bccList = split(BCCEmail, ",")
for i = 0 to ubound(bccList)
Mailer.AddBCC trim(bccList(i)), trim(bccList(i))
next
end if
if (CCEmail <> "") then
ccList = split(CCEmail, ",")
for i = 0 to ubound(ccList)
Mailer.AddCC trim(ccList(i)), trim(ccList(i))
next
end if
Mailer.Subject = Subject
Mailer.BodyText = Message
Mailer.QMessage = true
Mailer.SendMail
if (err.Number <> 0) then ASPQMail_Mailer = false else ASPQMail_Mailer = true
end if
set Mailer = nothing
end function
function SASmtpMail_Mailer(Message, FromEmail, ToEmail, FromName, ToName, Subject, MailerPath, MailerPort, Format, BCCEmail, CCEmail, ReplyTo)
Set Mailer = Server.CreateObject("SoftArtisans.SMTPMail")
if NOT isObject(Mailer) Then
SASmtpMail_Mailer = false
else
Mailer.RemoteHost = MailerPath
Mailer.contenttype = Format
Mailer.AddRecipient ToName, ToEmail
Mailer.FromName = FromName
Mailer.FromAddress = FromEmail
if (ReplyTo <> "") then Mailer.ReplyTo = ReplyTo
if (BCCEmail <> "") then
bccList = split(BCCEmail, ",")
for i = 0 to ubound(bccList)
Mailer.AddBCC trim(bccList(i)), trim(bccList(i))
next
end if
if (CCEmail <> "") then
ccList = split(CCEmail, ",")
for i = 0 to ubound(ccList)
Mailer.AddCC trim(ccList(i)), trim(ccList(i))
next
end if
Mailer.Subject = Subject
Mailer.BodyText = Message
Mailer.SendMail
if (err.Number <> 0) then SASmtpMail_Mailer = false else SASmtpMail_Mailer = true
end if
 
set Mailer = nothing
end function
function JMail_Mailer(Message, FromEmail, ToEmail, FromName, ToName, Subject, MailerPath, MailerPort, Format, BCCEmail, CCEmail, ReplyTo)
set Mailer = Server.CreateObject("JMail.SMTPMail") 
if NOT isObject(Mailer) Then
JMail_Mailer = false
else
Mailer.ServerAddress = MailerPath & ":" & MailerPort
Mailer.ContentType = Format
Mailer.AddRecipient ToEmail
Mailer.Sender = FromEmail
if (ReplyTo <> "") then Mailer.ReplyTo = ReplyTo
if (BCCEmail <> "") then
bccList = split(BCCEmail, ",")
for i = 0 to ubound(bccList)
Mailer.AddRecipientBCC trim(bccList(i))
next
end if
if (CCEmail <> "") then
ccList = split(CCEmail, ",")
for i = 0 to ubound(ccList)
Mailer.AddRecipientCC trim(ccList(i))
next
end if
Mailer.Subject = Subject
Mailer.Body = Message
Mailer.Execute
if (err.Number <> 0) then JMail_Mailer = false else JMail_Mailer = true
end if	
set Mailer = nothing
end function
function ASPEmail_Mailer(Message, FromEmail, ToEmail, FromName, ToName, Subject, MailerPath, MailerPort, Format, BCCEmail, CCEmail, ReplyTo)
set Mailer = Server.CreateObject("Persits.MailSender")  
if NOT isObject(Mailer) then
ASPEmail_Mailer = false
else
Mailer.Host = MailerPath
Mailer.Port = MailerPort
Mailer.From = FromEmail
Mailer.FromName = FromName
Mailer.AddAddress ToEmail, ToName
if (ReplyTo <> "") then Mailer.AddReplyTo ReplyTo
if (BCCEmail <> "") then
bccList = split(BCCEmail, ",")
for i = 0 to ubound(bccList)
Mailer.AddBCC trim(bccList(i)), trim(bccList(i))
next
end if
if (CCEmail <> "") then
ccList = split(CCEmail, ",")
for i = 0 to ubound(ccList)
Mailer.AddCC trim(ccList(i)), trim(ccList(i))
next
end if
Mailer.Subject = Subject
Mailer.Body = Message
if (LCase(Left(Format, 1)) = "h") then Mailer.IsHTML = true else Mailer.IsHTML = false
Mailer.Send
if (err.Number <> 0) then ASPEmail_Mailer = false else ASPEmail_Mailer = true
end if
set Mailer = nothing
end function
function verifyEmail(email)
if not isNull(email) then
email = trim(email)
else
verifyEmail = false
exit function
end if
validchars = "abcdefghijklmnopqrstuvwxyz_-.@1234567890"
for i = 1 to len(email)
if instr(validchars, lcase(mid(email, i, 1))) = 0 then
verifyEmail = false
exit function
end if
next
pos1 = instrrev(email, ".")
pos2 = instrrev(email, "@")
if pos1 > pos2 + 1 and pos2 > 1 then
verifyEmail = true
else
verifyEmail = false
end if
end function
function verifyFormat(format)
dim firstChar
format = trim(format)
firstChar = ucase(left(format, 1))
select case firstChar
case "T"
VerifyFormat = "Text"
case "H"
VerifyFormat = "HTML"
case else
VerifyFormat = NULL
end select
end function
function generateSC (encode)
code = 1
for idxChar = 1 to len(encode)
code = code * asc(mid(encode, idxChar, 1)) mod 11111
next
generateSC = code mod 10000
end function
function getHTML(strURL, bitResponse)
dim objXMLHTTP, htmlresponse
set objXMLHTTP = Server.CreateObject("Microsoft.XMLHTTP")
objXMLHTTP.Open "GET", strURL, false
objXMLHTTP.Send
getHTML = trim(objXMLHTTP.responseText)
if (getHTML = "") then bitResponse = false else bitResponse = true
set objXMLHTTP = Nothing
end function
function getDate(num)
if (NOT IsNumeric(num)) then
getDate = "Unknown" : exit function
end if
baseDate = CDate("1/1/1980") : getDate = DateAdd("s", num, baseDate)
end function
function formOutput(defaultValue, formValue, formName, quit)
response.write "<option value =""" & formValue & """"
if (cstr(formValue) = cstr(defaultValue)) then response.write " SELECTED"
response.write ">" & formName & "</option>" & VbCrLf
end function
function writeShortOutput(formValue, formName, defaultValue, quit)
if (cstr(defaultValue) = cstr(formValue)) then
response.write formValue
quit = true
end if
end function
function writeLongOutput(formValue, formName, defaultValue, quit)
if (cstr(defaultValue) = cstr(formValue)) then
response.write formName
quit = true
end if
end function
function doesFileExist(filePath)
set fso = CreateObject("Scripting.FileSystemObject")
if (fso.FileExists(filePath)) then doesFileExist = true else doesFileExist = false
set fso = nothing
end function
function readFileData(filePath, fileResponse)
if NOT doesFileExist(filePath) then
fileResponse = false : exit function
else
set fso = CreateObject("Scripting.FileSystemObject")
set readFileContents = fso.OpenTextFile(filePath, 1)
readFileData = readFileContents.ReadAll
if (err.Number <> 0) then fileResponse = false
fileResponse = true : set readFileContents = nothing : set fso = nothing : exit function
end if
end function
function validFile(fileName, validTypes)
fileName = split(fileName, ".")
lastPart = UBound(filename)
lastPart = fileName(lastPart)
validFile = false
for i = 0 to UBound(validTypes)
if lcase(validTypes(i)) = lcase(lastPart) then
validFile = true
exit function
end if
next
end function
function listFiles(validTypes, returnFile, baseDirectory)
validTypes = split(validTypes, ",")
basePath = server.mappath(baseDirectory)
currentPath = trim(request("currentPath"))
getPath = trim(request("getPath"))
getPathType = left(getPath, 3)
getPathName = mid(getPath, 4, 10000000)
if getPathType = "fo_" then
getFolder = currentPath & "\" & getPathName
elseif getPathType = "fi_" then
getFolder = currentPath
getFile = currentPath & "\" & getPathName
returnFile = getFile
elseif getPathType = "..." then
if currentPath = basePath then
getFolder = basePath
else
removePart = "\" & Mid(currentPath, InstrRev(currentPath, "\") + 1)
getFolder = replace(currentPath, removePart, "")
end if
else
getFolder = basePath
end if
dim objFSO
set objFSO = Server.CreateObject("Scripting.FileSystemObject")
set objFiles = objFSO.GetFolder(getFolder)
set objFolders = objFiles.SubFolders
response.write "  <div align=center><font size=2 face=Verdana, Arial, Helvetica, sans-serif>Current Path <b>[" & getFolder & "]</b></font><br>"
response.write "    <select name=""getPath"" size=15>"
response.write "      <option value=""..."">...</option>"
for each f1 in objFolders
response.write "      <option value=""fo_" & f1.name & """>[ " & f1.name & " ]</option>"
next
for each objFile in objFiles.Files
if validFile(objFile.name, validTypes) then
response.write "      <option value=""fi_" & objFile.name & """>" & objFile.name & "</option>"
end if
next
response.write "    </select><input type=""hidden"" name=""currentPath"" value=""" & getFolder & """></div>"
end function
function comCheck(com, debugMode)
if (com <> "") then useCom = lcase(cstr(com)) else useCom = ""
select case useCom
case "1", "cdomail"									' CDONTS
comResults = isCom("CDONTS.NewMail", debugMode)
case "2", "aspmail", "aspqail"						' ASPMail
comResults = isCom("SMTPsvg.Mailer", debugMode)
case "3", "sa-smtpmail"								' SA-SMTP Mail
comResults = isCom("SoftArtisans.SMTPMail", debugMode)
case "4", "jmail"									' Jmail
comResults = isCom("JMail.SMTPMail", debugMode)
case "5", "aspemail"								' ASPEmail
comResults = isCom("Persits.MailSender", debugMode)
case "6", "fso"										' FSO
comResults = isCom("Scripting.FileSystemObject", debugMode)
case "7", "xmlhttp"									' XML
comResults = isCom("Microsoft.XMLHTTP", debugMode)
case "8", "hex"										' Hex Valid Email
comResults = isCom("HexValidEmail.Connection", debugMode)
case "9", "asppop3"									' ASPPop3
comResults = isCom("POP3svg.Mailer", debugMode)
case else
comResults = false
end select
if (comResults) then comCheck = true else comCheck = false
end function
function isCom(component, debugMode)
on error resume next
set testCom = Server.CreateObject(component)
if err.Number = 0 then isCom = true else isCom = false
set testCom = nothing : err.clear()
if debugmode = 1 then
on error resume next
else
on error goto 0
end if
end function
%>

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Commented:
coreybryant,
I only have a minute or two right now but I was able read your (previous) question closer.  Thanks for the info and details.  Do you have email scripts working on this server using CDO in any other pages?  If not that would be my first suggestion.  Before we try to adapt the complicated newsletter code that, from what you say, supports many email objects it would be best to try a simple script to send a basic email.  Can the web host provide a sample to you?  If so this can be the best way to get ALL the info and settings you need.  If not then no worries because we can assume the set up is typical and start there.
In the snippet below I have provided a basic asp script that will use CDO and authenticate.  You will need to provide your server info, login, etc but try this to see what result you get.  Once we get it working then we can work to get your newsletter using what it needs.
If you already have email working in other scripts using CDO and it is just for this script then don't do the test and just let me know.
bol

<%
Dim mailer, config
Dim sMessage, sUrl
Set mailer = Server.CreateObject("CDO.Message")
Set config = Server.CreateObject("CDO.Configuration")
sUrl = "http://schemas.microsoft.com/cdo/configuration/"
With config
	.Fields.Item(sUrl & "sendusing") = 2
	.Fields.Item(sUrl & "smtpserver") = "smtp.YOURSERVER.com"
	.Fields.Item(sUrl & "smtpserverport") = 25
	.Fields.Item(sUrl & "smtpconnectiontimeout") = 60
'	.Fields.Item(sUrl & "smtpusessl") = False ' use SSL for connection true/false
	.Fields.Item(sUrl & "sendusername") = ""
	.Fields.Item(sUrl & "sendpassword") = ""
		'Type of authentication, NONE, Basic (Base64 encoded), NTLM
	.Fields.Item(sUrl & "smtpauthenticate") = 1
	.Fields.Update
End with
mailer.Configuration = config
mailer.Subject = "Test message w/ CDO"
mailer.To = "yourToEmailAddress"
mailer.From = "yourFromEmailAddress"
mailer.TextBody = "This is the body from server." & vbcrlf & "This is a second line."
mailer.Send
 
If Err <> 0 then
	sMessage = "There was an error"
Else
	sMessage = "Mail was sent"
End if
 
Set config = Nothing
Set mailer = Nothing
%>
 
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
	"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
 
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
<head>
<link href="/style.css" rel="stylesheet" type="text/css" />
<title>Untitled</title>
</head>
 
<body>
<h3>Testing CDO email</h3>
 
<br /><br />
The status is: 
<%= sMessage %>
 
 
</body>
</html>

Open in new window

Author

Commented:
Thanks - yes that did work for me.  I added information in the .Fields.Item(sUrl & "sendusername") and .Fields.Item(sUrl & "sendpassword").  
I added an email address that is associated with the domain name in the mailer.To and mailer.From lines.  Uploaded the page and when I brought up the page, it said: The status is: Mail was sent.
I checked my inbox and the email message was there.

Commented:
Thanks for the response.  I have been out of town and just saw it.  Since the code I provided worked have you been able to use it to get you newsletter script (in the question's code snippet) to work?  Since there are hundreds of lines of code I wanted to find out the status of this and exactly what you are getting now.  Can you just use the email code from my script in your other one?  Let me know how I can help with the next step, if you still need help.
bol

Author

Commented:
Thanks for this - I finally was able to get the hosting company to bypass SMTP authentication if sent from the web server - but the code you provided did help steer me in the right direction.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial