<% ' Email related functions Function EZMail() EZMail = "EasyMail.SMTP.6" End Function Function EZMailSMTPKey() EZMailSMTPKey = "Steuber Web Services (Single Developer)/00506307107913001E20" End Function Function EZMailPOP3Key() EZMailPOP3Key = "Steuber Web Services (Single Developer)/00506307107913001E20" End Function Function EZMailSMTP() EZMailSMTP = "192.168.1.87" End Function Function EZMailExpress() EZMailExpress = "C:\program files\easymail smtp express" End Function Function SWS_td(num) if num < 10 then td = "0" & num else td = num end if End Function Function SWS_DateString(curtime) DayNames = "SunMonTueWedThuFriSat" DayName = mid(DayNames, 3 * Weekday(curtime) - 2, 3) ds = DayName & ", " & Day(curtime) & " " & MonthName(Month(curtime), true) _ & " " & Year(curtime) & " " & SWS_td(Hour(curtime)) & ":" & SWS_td(Minute(curtime)) _ & ":" & SWS_td(Second(curtime)) & " " tz = SWS_timezone() if tz > 0 then ds = ds & "-" else tz = - tz end if tz = tz / 60 ds = ds & SWS_td(tz) & "00" SWS_DateString = ds End Function Sub SWS_Msg(field, name) sp = 1 if maxwidth + 3 > len(name) then sp = maxwidth + 3 - len(name) message = message & name & ":" & space(sp) & session(field) & vbcrlf End Sub Sub SWS_SendMsg(subject, message) Dim smtp set smtp = CreateObject(EZMail()) smtp.Domain = session("domain") smtp.mailserver = EZMailSMTP() smtp.LicenseKey=EZMailSMTPKey() smtp.from = session("MailFromName") smtp.fromAddr = session("MailFrom") smtp.addrecipient session("MailToName"), session("MailTo"), 1 if session("MailTo") <> "info@steuber.com" then smtp.addrecipient "Patton Steuber", "pat@steuber.com", 3 end if smtp.subject = subject smtp.BodyText = message ' smtp.AddCustomHeader "Date", SWS_DateString(now) ret = smtp.send() if ret<>0 Then Error = "Your message was not sent. System returned error code " & ret nErrors = nErrors + 1 end if End Sub Sub SWS_Missing(field, name) if session(field) = "" then Error = Error & " " & name & " is missing" & "
" & vbcrlf nErrors = nErrors + 1 end if End Sub Function SWS_Plural() p = "" if nErrors > 1 then p = "s" end if SWS_Plural = p End Function 'Option Button SelectFieldName = "" Sub SWS_Sel(field) SelectFieldName=field if field = "" then S = "" & vbcrlf else S = " checked <%end if%>> <% End Sub ' RadioButton Sub SWS_RadioButton(name,value)%> checked <%end if%>> <% End Sub %> <% Dim message, error, nErrors, FriendEmail(), nFriends, nTrueFriends Dim oEPI2, sMachineId, EmailID(), ID, subject subject = "Hey check this out ..." 'Change this line to change subject on email message = "" error = "" nErrors = 0 nFriends = 0 nTrueFriends = 0 thanks = 0 ThisFile = request.servervariables("script_name") process = request("process") referer = lcase(trim(request.servervariables("http_referer"))) referershort = referer site = lcase(trim("http://" & request.servervariables("server_name") & "/")) if instr(referer, site) = 1 then referershort = mid(referer, len(site) + 1) end if if process = "send" then session("SenderFirst") = request("SenderFirst") session("SenderLast") = request("SenderLast") session("SenderEmail") = request("SenderEmail") 'session("FriendEmail") = request("FriendEmail") session("YourMessage") = request("YourMessage") referer = request("referer") referershort = request("referershort") nFriends = request("FriendEmail").count REDIM FriendEmail(nFriends - 1) REDIM EmailID(nFriends - 1) for i = 0 to nFriends - 1 FriendEmail(i) = trim(request("FriendEmail")(i+1)) EmailID(i) = 0 if FriendEmail(i) <> "" then nTrueFriends = nTrueFriends + 1 CheckEmail FriendEmail(i) end if next session("FriendEmail") = FriendEmail SWS_Missing "SenderFirst", "Your First Name" SWS_Missing "SenderLast", "Your Last Name" SWS_Missing "SenderEmail", "Your Email Address" CheckEmail session("SenderEmail") if nTrueFriends = 0 then nErrors = nErrors + 1 error = error & "No friends email addresses entered
" & vbcrlf end if if error = "" then session("MailFrom") = session("SenderEmail") session("MailFromName") = session("SenderFirst") & " " & session("SenderLast") sMachineId = trim(Request.Cookies("EndlessPools")("MachineID") & " ") if sMachineId = "" then sMachineId = "no cookie" end if Set oEPI2 = Server.CreateObject("colEndlessPools2.cEndlessPools2") for i = 0 to nFriends -1 if FriendEmail(i) <> "" then if oEPI2.SaveTellAFriend (Application("EPIDSN"), sMachineId, session("SenderFirst"), session("SenderLast"), session("SenderEmail"), FriendEmail(i), referershort, ID) then EmailID(i) = ID session("MailToName") = FriendEmail(i) session("MailTo") = FriendEmail(i) message = "" message = message & session("YourMessage") & vbcrlf & vbcrlf message = message & "http://" & request.servervariables("Server_Name") & "/friend.asp?e=" & ID & vbcrlf & vbcrlf & vbcrlf message = message & "++++++++++++++++++++++++++++++++++++++++++++++++++" & vbcrlf & vbcrlf message = message & "The preceding message was sent to you from a customer of Endless Pools, Inc. " message = message & "The ""Email this Page"" program enables friends and family to notify others about " message = message & "the many benefits of the Endless Pool. We apologize unreservedly if someone " message = message & "unknown to you used our online form to send you this email. If this occurs, " message = message & "although extremely rare, please notify us immediately at swim@endlesspools.com" & vbcrlf & vbcrlf message = message & "Endless Pools does NOT sell, rent or otherwise lend email addresses and names to other companies." & vbcrlf ret = SWS_SendMsg2 (subject, message) if ret = 0 then FriendEmail(i) = "" else EmailID(i) = EmailID(i) & " error " & ret error = error & "Cannot send email to " & FriendEmail(i) & "
" nErrors = nErrors + 1 oEPI2.DeleteTellAFriend Application("EPIDSN"), ID end if else EmailID(i) = "error" error = error & "Cannot send email to " & FriendEmail(i) & "
" nErrors = nErrors + 1 end if end if next Set oEPI2 = nothing session("FriendEmail") = FriendEmail if error = "" then thanks = 1 end if end if end if Sub CheckEmail(email) Dim OK, pos OK = false email = trim(email) if email <> "" then pos = instr(email, "@") if pos > 1 then if instr(pos, email, ".") > pos + 2 then OK = true end if end if if not OK then error = error & email & " is not a valid email address
" nErrors = nErrors + 1 end if end if End Sub Function SWS_SendMsg2(subject, message) Dim smtp set smtp = CreateObject(EZMail()) smtp.Domain = session("domain") smtp.mailserver = EZMailSMTP() smtp.LicenseKey=EZMailSMTPKey() smtp.from = session("MailFromName") smtp.fromAddr = session("MailFrom") smtp.addrecipient session("MailToName"), session("MailTo"), 1 smtp.subject = subject smtp.BodyText = message ' smtp.AddCustomHeader "Date", SWS_DateString(now) ret = smtp.send() if ret<>0 Then Error = "Your message was not sent. System returned error code " & ret nErrors = nErrors + 1 end if SWS_SendMsg2 = ret End Function Function Friend(i) if isArray(session("FriendEmail")) then if i <= ubound(session("FriendEmail")) then Friend = session("FriendEmail")(i) else Friend = "" end if else Friend = "" end if End Function Function FriendID(i) if process = "send" then if i <= ubound(EmailID) then FriendID = EmailID(i) else FriendID = "" end if else FriendID = "" end if End Function %> <% if thanks = 0 then %> Email this Endless Pools page to someone
 

Know someone who might benefit from swimming at home? Enter their email below and we'll send them a personalized message from YOU. Share the endless benefits of Endless Pools today!

<% if process = "send" and error <> "" then%>

Please correct the following:
<%=error%>

<% end if %>
  "> ">
   Your First Name  Your Last Name
  ">
  Your Email (you@youraddress.com)
   
  Email the previous page to a friend:
 
  Friend's Email Another Friend's Email
   
  Message to friend:
 
  Endless Pools, Inc. does NOT sell, rent or lend email addresses to any other company.
<% else %> Thanks from EPI
Thank You
 

Your email has been sent!
 

<% end if %>