<%@ LANGUAGE="VBScript" %>
<%  '***************************************************************************
    ' formmail.asp
    ' Copyright 1999 by Mike Hall.
    ' Web address: http://www.brainjar.com
    ' Last update: October 18, 1999.
    '***************************************************************************
    '- Customize these values -----------
    referers = Array("njonas.com")
    mailComp = "ASPMail"
    smtpServer = "mail.njonas.com"
    fromAddr = "[email protected]"
    '- End customization section. ----------
    Response.Buffer = true
    errorMsgs = Array()
    'Check for form data.
    if Request.ServerVariables("Content_Length") = 0 then
      call AddErrorMsg("No form data submitted.")
    end if
    'Check for valid referer.
    validReferer = false
    referer = Request.ServerVariables("HTTP_REFERER")
    referer = Mid(referer, len("http://") + 1)
    i = InStr(referer, "/")
    if i > 1 then
      referer = Mid(referer, 1, InStr(referer, "/") - 1)
      referer = Mid(referer, InStr(referer, ".") + 1)
      for each domain in referers
        if domain = referer then
          validReferer = true
        end if
      next
    end if
    if not validReferer then
      call AddErrorMsg("Invalid referer.")
    end if
    'Check for recipients field.
    if Request.Form("_recipients") = "" then
      call AddErrorMsg("Missing email recipient.")
    end if
    'Check all recipient email addresses.
    recipients = Split(Request.Form("_recipients"), ",")
    for each name in recipients
      name = Trim(name)
      if not IsValidEmail(name) then
        call AddErrorMsg("Invalid email address in recipient list: " & name & ".")
      end if
    next
    recipients = Join(recipients, ",")
    'Get replyTo email address from specified field if given and check it.
    name = Trim(Request.Form("_replyToField"))
    if name <> "" then
      replyTo = Request.Form(name)
    else
      replyTo = Request.Form("_replyTo")
    end if
    if replyTo <> "" then
      if not IsValidEmail(replyTo) then
        call AddErrorMsg("Invalid email address in reply-to field: " & replyTo & ".")
      end if
    end if
    'Get subject text.
    subject = Request.Form("_subject")
    'If required fields are specified, check for them.
    if Request.Form("_requiredFields") <> "" then
      required = Split(Request.Form("_requiredFields"), ",")
      for each name in required
        name = Trim(name)
        if Left(name, 1) <> "_" and Request.Form(name) = "" then
        call AddErrorMsg("Missing value for " & name)
        end if
      next
    end if
    'If a field order was given, use it. Otherwise use the order the fields were
    'received in.
    if Request.Form("_fieldOrder") <> "" then
      fieldOrder = Split(Request.Form("_fieldOrder"), ",")
      for each name in fieldOrder
        name = Trim(name)
      next
    else
      fieldOrder = FormFieldList()
    end if
    'If there were no errors, build the email note and send it.
    if UBound(errorMsgs) <  0 then
      'Build table of form fields and values.
      body = "<table border=0 cellpadding=2 cellspacing=0>" & vbCrLf
      for each name in fieldOrder
        body = body _
             & "<tr valign=top>" _
             & "<td><font face=""Arial,Helvetica"" size=2><b>" _
             & name _
             & ": </b></font></td>" _
             & "<td><font face=""Arial,Helvetica"" size=2>" _
             & Request.Form(name) _
             & "</font></td>" _
             & "</tr>" & vbCrLf
      next
      body = body & "</table>" & vbCrLf
      'Add a table with any environmental variables.
      if Request.Form("_envars") <> "" then
        body = body _
             & "<p>" _
             & "<table border=0 cellpadding=2 cellspacing=0>" & vbCrLf
        envars = Split(Request.Form("_envars"), ",")
        for each name in envars
          name = Trim(name)
          body = body _
               & "<tr valign=top>" _
               & "<td><font face=""Arial,Helvetica"" size=2><b>" _
               & name _
               & ": </b></font></td>" _
               & "<td><font face=""Arial,Helvetica"" size=2>" _
               & Request.ServerVariables(name) _
               & "</font></td>" _
               & "</tr>" & vbCrLf
        next
        body = body & "</table>" & vbCrLf
      end if
      'Send it.
      str = SendMail()
      if str <> "" then
        AddErrorMsg(str)
      end if
      'Redirect if a URL was given.
      if Request.Form("_redirect") <> "" then
        Response.Redirect(Request.Form("_redirect"))
      end if
    end if %>
<html>
<head>
<title>Mail</title>
</head>
<body bgcolor="#ffffff">
<form method="post" action="mail.asp">
  <div align="center"> 
    <input name="_recipients" type="hidden" value="">
<table width="78%" border="0" cellpadding="0" cellspacing="0" bordercolorlight="#009966" bordercolordark="#009966" bgcolor="#CCCCCC" height="18">
      <tr bgcolor="#CCCCCC"> 
        <td width="8%" height="15"> 
          <div align="center"><font color="#000000" size="4" face="Arial">CONTACT US</font></div>
</td>
      </tr>
    </table>
    <table width="78%" border="0" bgcolor="#CCCCCC">
      <tr> 
        <td width="37%"> 
          <div align="right"><b><font color="#000000" face="Arial, Helvetica, sans-serif">Your 
            Name:</font></b></div>
        </td>
        <td width="63%"> 
          <input type="text" name="Name" size="40">
        </td>
      </tr>
      <tr> 
        <td width="37%"> 
          <div align="right"><b><font color="#000000" face="Arial, Helvetica, sans-serif">Your 
            Email Address:</font></b></div>
        </td>
        <td width="63%"> 
          <input type="text" name="Email" size="40">
        </td>
      </tr>
      <tr> 
        <td height="87" width="37%"> 
          <div align="right"> <font face="Arial, Helvetica, sans-serif" color="#08800"><b><font color="#000000">Comments:</font><br>
            <br>
            <br>
            <br>
            </b></font></div>
        </td>
        <td height="87" width="63%"> 
          <textarea name="Comments" rows="5" cols="34"></textarea>
        </td>
      </tr>
      <tr> 
        <td width="37%">&nbsp; </td>
        <td width="63%"> 
          <input type="reset" name="clear" value="Clear">
          <input type="submit" name="Submit" value="Submit">
        </td>
      </tr>
    </table>
  </div>
</form>
<p align="center"><%  if UBound(errorMsgs) >= 0 then %> <%  else %> 
<table width="100%" border="0">
  <tr> 
    <td height="52"> 
      <div align="center"> 
        <table bgcolor="#FFFFFF" border=0 cellpadding=1 cellspacing=0 width=450 bordercolorlight="#FFFFFF" bordercolordark="#FFFFFF">
          <tr> 
            <td height="59"> 
              <table border=0 cellpadding=4 cellspacing=1 width="100%" bordercolorlight="#FFFFFF" bordercolordark="#FFFFFF" bgcolor="#FFFFFF">
                <tr bgcolor="#000000" valign=bottom> 
                  <th colspan=2 bgcolor="#FFFFFF"><font face="Arial,Helvetica" size="3" color="#000000"> 
                    We have received the following information: </font></th>
                </tr>
                <%    for each name in fieldOrder %> 
                <tr bgcolor="#ffffff" valign=top> 
                  <td height="12"><font face="Arial,Helvetica" size="3"><b><%  = name %> 
                    </b></font></td>
                  <td height="12"><font face="Arial,Helvetica" size="3"><%  = Request.Form(name) %> 
                    </font></td>
                </tr>
                <%    next %> 
              </table>
            </td>
          </tr>
        </table>
      </div>
    </td>
  </tr>
</table>
<%  end if %> 
<p align="center">&nbsp; 
</body>
</html>
<%  sub AddErrorMsg(msg)
      dim n
     'Add an error message to the list.
      n = UBound(errorMsgs)
      Redim Preserve errorMsgs(n + 1)
      errorMsgs(n + 1) = msg
    end sub
    function SendMail()
      dim mailObj
      'Send email based on mail component. Uses global variables for parameters
      'because there are so many.
      SendMail = ""
      'Send email (CDONTS version), doesn't support reply to address and has
      'no error checking.
      if mailComp = "CDONTS" then
        set mailObj = Server.CreateObject("CDONTS.NewMail")
        mailObj.BodyFormat = 0
        mailObj.MailFormat = 0
        mailObj.From = fromAddr
        mailObj.To = recipients
        mailObj.Subject = subject
        mailObj.Body = body
        mailObj.Send
      end if
      'Send email (JMail version).
      if mailComp = "JMail" then
        set mailObj = Server.CreateObject("JMail.SMTPMail")
        mailObj.Silent = true
        mailObj.ServerAddress = smtpServer
        mailObj.Sender = fromAddr
        mailObj.ReplyTo = replyTo
        mailObj.Subject = subject
        addrList = Split(recipients, ",")
        for each addr in addrList
          mailObj.AddRecipient Trim(addr)
        next
        mailObj.ContentType = "text/html"
        mailObj.Body = body
        if not mailObj.Execute then
          SendMail = "Email send failed: " & mailObj.ErrorMessage & "."
        end if
      end if
      'Send email (ASPMail version).
      if mailComp = "ASPMail" then
        set mailObj = Server.CreateObject("SMTPsvg.Mailer")
        mailObj.FromAddress = fromAddr
        mailObj.RemoteHost = smtpServer
        mailObj.ReplyTo = replyTo
        for each addr in Split(recipients, ",")
          mailObj.AddRecipient "", Trim(addr)
        next
        mailObj.Subject = subject
        mailObj.ContentType = "text/html"
        mailObj.BodyText = body
        if mailObj.SendMail then
          SendMail = ""
        else
          SendMail = "Email send failed: " & mailObj.Response & "."
        end if
     end if
    end function

    function IsValidEmail(email)
      dim names, name, i, c
      'Check for valid syntax in an email address.
      IsValidEmail = true
      names = Split(email, "@")
      if UBound(names) <> 1 then
        IsValidEmail = false
        exit function
      end if
      for each name in names
        if Len(name) <= 0 then
          IsValidEmail = false
          exit function
        end if
        for i = 1 to Len(name)
          c = Lcase(Mid(name, i, 1))
          if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
            IsValidEmail = false
            exit function
          end if
        next
        if Left(name, 1) = "." or Right(name, 1) = "." then
          IsValidEmail = false
          exit function
        end if
      next
      if InStr(names(1), ".") <= 0 then
        IsValidEmail = false
        exit function
      end if
      i = Len(names(1)) - InStrRev(names(1), ".")
      if i <> 2 and i <> 3 then
        IsValidEmail = false
        exit function
      end if
      if InStr(email, "..") > 0 then
        IsValidEmail = false
      end if
    end function
    function FormFieldList()
      dim str, i, name
      'Build an array of form field names ordered as they were received.
      str = ""
      for i = 1 to Request.Form.Count
        for each name in Request.Form
          if Left(name, 1) <> "_" and Request.Form(name) is Request.Form(i) then
            if str <> "" then
              str = str & ","
            end if
            str = str & name
            exit for
          end if
        next
      next
      FormFieldList = Split(str, ",")
    end function %>


</BODY>
</HTML>