<% If Request.form("submit") = "" Then call form Else call send End If Sub form dim conn,rs,thisid,subject thisid = Request.QueryString("id") If thisid="" OR IsNumeric(thisid) = 0 then response.write("Invalid ID") Exit Sub End If Set conn = server.CreateObject("Adodb.connection") conn.open(application("connstring")) set rs = conn.execute("select subject from NewsletterArchives where newsid = " & thisid) If rs.eof Then Response.Write("Invalid Request") Exit Sub Else subject = rs("Subject") End If Set rs = nothing conn.close set conn = nothing %>

To forward this issue of the Wellness Update to your friends, simply enter their address(es) in the boxes below and click the send message button.
You are not subscribing your friend(s) to the Wellness Update by entering their email address.
Subject:
Your Email:
" size="30" readonly="true">
Friend 1:
Friend 2:
Friend 3:
">
Privacy Guaranteed.

We take your privacy seriously! Information entered here will not be used for any purpose other than delivering this one email. You are not subscribing your friend(s) to the Wellness Update by entering their email address. Your friends’ email addresses will not be saved or shared with other companies.


<% End sub 'form Sub send If isNumeric(Request.form("newsid")) = false Then Response.write("Invalid Request - ID") Exit Sub End If If chkEmail(Request.form("sender")) = 1 Then Response.write("Invalid Request - Email") Exit Sub End If 'update stats dim conn,rs,sql,body,newbody, sentto Set conn = server.CreateObject("Adodb.connection") conn.open(application("connstring")) sql = "UPDATE NewsletterArchives Set forwards = forwards + 1 Where newsid = " & Request.form("newsid") conn.execute(sql) 'get the newsletter specifics sql = "Select body from NewsletterArchives Where newsid = " & Request.form("newsid") Set rs = conn.execute(sql) If not rs.eof Then body = rs("body") End If conn.close Set conn = nothing 'send emails If body = "" Then Response.write("Invalid Request - EOF") Exit Sub End If sentto = "
" If chkEmail(Request.form("friend1")) = 0 Then sentto = sentto & Request.form("friend1") & "
" newbody = Replace(body,"{email}",Request.form("friend1")) sendemail request.form("friend1"), Request.form("sender"), Request.form("subject"), newbody End If If chkEmail(Request.form("friend2")) = 0 Then sentto = sentto & Request.form("friend2") & "
" newbody = Replace(body,"{email}",Request.form("friend2")) sendemail Request.form("friend2"), Request.form("sender"), Request.form("subject"), newbody End If If chkEmail(Request.form("friend3")) = 0 Then sentto = sentto & Request.form("friend3") & "
" newbody = Replace(body,"{email}",Request.form("friend3")) sendemail Request.form("friend3"), Request.form("sender"), Request.form("subject"), newbody End If %>

Your message has been sent to the following addresses:

<%= sentto %>

Thank you for sharing our valuable information!

<% End Sub Sub sendemail(toemail,fromemail,subject,body) Dim myMail Set myMail = CreateObject("CDONTS.NewMail") myMail.From = fromemail myMail.To = toemail myMail.Subject = subject 'use 1 for plain text, 0 for html myMail.BodyFormat = 0 myMail.MailFormat = 0 myMail.Body = body myMail.Send Set myMail = Nothing End Sub function chkEmail(theAddress) ' checks for a vaild email ' returns 1 for invalid addresses ' returns 1 for invalid addresses dim atCnt,i chkEmail = 0 ' chk length if len(trim(theAddress)) < 5 then ' a@b.c should be the shortest an ' address could be chkEmail = 1 ' chk format ' has at least one "@" elseif instr(theAddress,"@") = 0 then chkEmail = 1 ' has at least one "." elseif instr(theAddress,".") = 0 then chkEmail = 1 ' has no more than 4 chars after last "." elseif len(theAddress) - instrrev(theAddress,".") > 4 then chkEmail = 1 ' has no "_" after the "@" elseif instr(theAddress,"_") <> 0 and _ instrrev(theAddress,"_") > instrrev(theAddress,"@") then chkEmail = 1 else ' has only one "@" atCnt = 0 for i = 1 to len(theAddress) if mid(theAddress,i,1) = "@" then atCnt = atCnt + 1 end if next if atCnt > 1 then chkEmail = 1 end if ' chk each char for validity for i = 1 to len(theAddress) if not isnumeric(mid(theAddress,i,1)) and _ (lcase(mid(theAddress,i,1)) < "a" or _ lcase(mid(theAddress,i,1)) > "z") and _ mid(theAddress,i,1) <> "_" and _ mid(theAddress,i,1) <> "." and _ mid(theAddress,i,1) <> "@" and _ mid(theAddress,i,1) <> "-" then chkEmail = 1 end if next end if end function %>