CDOMail SMTP Authentication
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
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
%>
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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
bol
ASKER
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.
ASKER
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.