Question

CDOMail SMTP Authentication

Asked by: coreybryant

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
%>

                                  
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:
557:
558:
559:
560:
561:
562:
563:
564:
565:
566:
567:
568:
569:
570:
571:
572:
573:
574:
575:
576:
577:
578:
579:
580:
581:
582:
583:
584:
585:
586:
587:
588:
589:
590:
591:
592:
593:
594:
595:
596:
597:
598:
599:
600:
601:
602:
603:
604:
605:
606:
607:
608:
609:
610:
611:
612:
613:
614:
615:
616:
617:
618:
619:
620:
621:
622:
623:
624:
625:
626:
627:
628:
629:
630:
631:
632:
633:
634:
635:
636:
637:
638:
639:
640:
641:
642:
643:
644:
645:
646:
647:
648:
649:
650:
651:
652:
653:
654:
655:
656:
657:
658:
659:
660:
661:
662:
663:
664:
665:
666:
667:
668:
669:
670:
671:
672:
673:
674:
675:
676:
677:
678:
679:
680:
681:
682:
683:
684:
685:
686:
687:
688:
689:
690:
691:
692:
693:
694:
695:
696:
697:
698:
699:
700:
701:
702:
703:
704:
705:
706:
707:
708:
709:
710:
711:
712:
713:
714:
715:
716:
717:
718:
719:
720:
721:
722:
723:
724:
725:
726:
727:
728:
729:
730:
731:
732:
733:
734:

Select allOpen in new window

This Question has been solved and asker verified All Experts Exchange premium technology solutions are available to subscription members.

Subscribe now for full access to Experts Exchange and get

Instant Access to this Solution

  • Plus...
  • 30 Day FREE access, no risk, no obligation
  • Collaborate with the world's top tech experts
  • Unlimited access to our exclusive solution database
  • Never be left without tech help again

Subscribe Now

Asked On
2009-07-17 at 14:43:38ID24580412
Topics

Active Server Pages (ASP)

,

Web Development

,

Web Languages/Standards

Participating Experts
1
Points
500
Comments
4

Trusted by hundreds of thousands everyday for fast, accurate and reliable tech support.

  • "The time we save is the biggest benefit of Experts Exchange to Warner Bros. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange." Mike Kapnisakis, Warner Bros.
  • "Our team likes having a resource that is more secure than just using Google and most experts using this service really know their stuff. It's nice to look here first versus using Google." Dayna Sellner, Lockheed Martin
  • "Anytime that I've been stumped with a problem, 9 out of 10 times Experts Exchange has either the accepted solution or an open discussion of the potential solution to the problem." Kenny Red, eBay Inc.

See what Experts Exchange can do for you.

Got a question?

We've got the answer.

Experts Exchange has been collecting answers to technology questions since 1996…3 million and counting! If you have a question, chances are we already have your answer.

Screenshot of Experts Exchange Knowledgebase

Need individual assistance?

Our experts are ready to help.

If you can't find the exact answer you're looking for, ask our exclusive community of 50,000 experts. You’ll get a personalized answer from a trusted professional.

Screenshot of Experts Exchange Knowledgebase

Want to learn from the best?

Read articles from industry experts.

Thousands of free tech tips, tricks, how-to’s and tutorials are available in our peer reviewed articles section. See for yourself how smart our experts are, no login required.

Screenshot of an Article

Working on a long term project?

Store your work and research.

Save solutions to your questions, answers you’ve discovered through searching plus helpful articles in your personal knowledgebase for easy future access.

Screenshot of Experts Exchange Knowledgebase

Access the answers to your technology questions today.

Subscribe Now

30-day free trial. Register in 60 seconds.

What Makes Experts Exchange Unique?

Members of the expert community talk about why the experience at Experts Exchange is different than what you will find anywhere else.

Trusted by the world's most respected brands.

image of each brand's logo

Faithfully serving IT professionals since 1996.

Experts Exchange Logo

Try it out and discover for yourself.

Subscribe Now

30-day free trial. Register in 60 seconds.

Related Solutions

  1. SMTP Authentication
    I'm currently using winsock to send emails from my client. I'd like to be able to add SMTP authentication since some of the SMTPs I use require it. Looking for the VB code to implement this.
  2. SMTP Authentication
    Hi Im using Winsock control to SendMails by connecting to the SMTP server using visual basic code. The problem is that every SMTP server needs authentication adn i want to know the method of connecting to the SMTP Server using the Authentication details.But i want to use the ...

Free Tech Articles

  1. WARNING: 5 Reasons why you should NEVER fix a computer for free.
    It is in our nature to love the puzzle. We are obsessed. The lot of us. We love puzzles. We love the challenge. We thrive on finding the answer. We hate disarray. It bothers us deep in our soul. W...
  2. SCCM OSD Basic troubleshooting
    SCCM 2007 OSD is a fantastic way to deploy operating systems, however, like most things SCCM issues can sometimes be difficult to resolve due to the sheer volume of logs to sift through and the dispe...
  3. Migrate Small Business Server 2003 to Exchange 2010 and Windows 2008 R2
    This guide is intended to provide step by step instructions on how to migrate from Small Business Server 2003 to Windows 2008 R2 with Exchange 2010. For this migration to work you will need the fo...
  4. Create a Win7 Gadget
    This article shows you how to create a simple "Gadget" -- a sort of mini-application supported by Windows 7 and Vista. Gadgets can be dropped anywhere on the desktop to provide instant information, ...
  5. Outlook continually prompting for username and password
    There have been a lot of questions recently regarding Outlook prompting for a username and password whilst using Exchange 2007. There are a few reasons why this would happen and I will try to cover t...
  6. Backup Exchange 2010 Information Store using Windows Backup
    There seems to be quite a lot of confusion around the ability to backup Exchange 2010 using the built in Windows Backup feature. This stems from the omission of this feature prior to Exchange 2007 s...

Cloud Class Webinars

  1. Avoiding Bugs in Microsoft Access
    Alison Balter takes and in-depth look at avoiding bugs in Access. In this webinar you will learn about using the immediate window to debug your applications, invoking the debugger, using breakpoints to troubleshoot, stepping through code, setting the next statement to execute, ...
  2. Top 10 Best New Features in Visio 2010
    Scott Helmers gives live demonstrations of the top 10 new features in Visio 2010. This webinar will teach you how to create compelling diagrams by adding shapes to the page with a single click, linking the shapes in a diagram to data in Excel (or SQL Server, or SharePoint), ...
  3. IT Consultant Business Secrets Revealed
    Michael Munger, Experts Exchange tech pro and IT consultant, pulls back the curtain on his very successful businesses and answers question on every IT consultant and business owner should know about. He shares secrets on what he did to solve the 5 most common problems in IT, ...
  4. Disaster Recovery and Business Continuity
    Quest CTO, Mike Billon, gives an overview of the steps involved in building a dunamic disaster recovery plan. Through case studies and an examination of software/hardware tooles for monitoring and testing, you'll gain a better understandin of where you are, where you want ...
  5. Organize Your Visio Diagrams with Containers and Lists
    Scott Helmers uses cross functional flowcharts, wireframe diagrams, data graphic legends and seating charts to teach you: how to ustilize all three new structured diagram components in Visio 2010, the best practices for organizeing shapes in previous version of Visio, how to organize ...
  6. How to Us Objects, Properties, Events and Methods in Microsoft Access
    Alison Dalter gives an in-depbth look at objects, properties, events and methods in Microsoft Access. In this webinar you will learn about using the object browser, referring to objects, working with properties and methods, working with object variables, understanding the ...

Join the Community

Give a Little. Get a Lot.

Join the community of experts here and help other tech pros by answering question in your area of expertise. You can earn FREE access to all Experts Exchange's premium features and resources.

Join the Community

Answers

 

by: b0lsc0ttPosted on 2009-07-17 at 16:25:41ID: 24883771

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>

                                              
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:

Select allOpen in new window

 

by: coreybryantPosted on 2009-07-18 at 13:15:12ID: 24887128

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.

 

by: b0lsc0ttPosted on 2009-07-23 at 16:59:27ID: 24931321

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

 

by: coreybryantPosted on 2009-08-07 at 14:34:13ID: 25047136

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.

20120131-EE-VQP-002

3 Ways to Join

30-Day Free Trial

The Experts

98% positive feedback on 31,087 answers since March 2000. angeliii is a Microsoft Most Valuable Professional for his work with MS SQL Server & Develoment.

He has also proven his knowledge of Visual Basic Programming, PHP Scripting and Oracle Databases.

The Experts

97% positive feedback on 10,752 answers since July 2000. lrmoore has more than 18 years experience in the networking industry.

The six-time Mircosoft MVPs specialties include firewalls, virtual private networking, and network management.

Testimonials

"...and excellent source for support... Kind of like having your very own IT dept." Electriciansnet

Testimonials

"I was apprehensive at signing up at first. However... it has already made my life as an IT administrator much easier." JaCrews

Testimonials

"WOW! You guys have great, active, and knowledgeable people on here." moore50

Business Clients

Business Clients

In the Press

"If you’ve got a question... Experts Exchange can supply an answer.”

In the Press

"...an invaluable aid for both IT professionals and those who require tech support."

In the Press

"where IT professionals provide quick answers on just about any topic"

Business Account Plans

Loading Advertisement...