<%@ Language=VBScript %> <%Option Explicit%> <% Function ExtraTrim(str) dim ExtraTrimCount dim ExtraTrimLen str = Replace(trim(str),Chr(9),"") str = Replace(str,Chr(11),"") str = Replace(str,Chr(13),"") ExtraTrim = str End Function %> <% '--------------------------------------------------------------------------- ' This function created by Michele Wagner 6/21/01 for Baltimore County Public Schools ' USE: Send an e-mail message listing the results of any web-based form. ' ORIGIN: Based on the formmail.pl script found on Matt's Script Archive ' Modified 1/8/2008 by David Phelan: added option for session variables in addition to form fields '--------------------------------------------------------------------------- Public Function Sendmail(Recipient) '------------------------------------------------------------- ' Check to see if recipient is specified '------------------------------------------------------------- If Recipient = "" or InStr(1,Recipient,"@") = 0 or InStr(1,Recipient,".") = 0 or InStr(1,Recipient,",") = len(Recipient) Then Sendmail = "You did not specify a valid recipient for this form." Exit Function End If '-------------------------------------------------------------- ' Check to see if subject for e-mail message is specified. '-------------------------------------------------------------- Dim sSubject If Request.form("Subject") = "" Then Sendmail = "You did not specify a subject for the e-mail message to be sent from this form." Exit Function Else sSubject = ExtraTrim(Request.Form("Subject")) End If '-------------------------------------------------------------- ' Check to see if subject for e-mail message is specified. '-------------------------------------------------------------- If Request.form("Email") = "" or InStr(1,Request.Form("Email"),"@") = 0 or InStr(1,Request.Form("Email"),".") = 0 or InStr(1,Request.Form("Email"),",") = len(Request.Form("Email")) Then Sendmail = "You did not specify a valid e-mail address for the e-mail message to be sent from this form." Exit Function End If '--------------------------------------------------------------- ' Check the URL from which the form is being submitted. '--------------------------------------------------------------- dim isValid dim httpRef isValid = 0 httpRef = Request.ServerVariables("HTTP_REFERER") httpRef = Right(httpRef,(Len(httpRef) - (InStr(1,httpRef,"//") + 1))) httpRef = Left(httpRef,(InStr(1,httpRef,"/") - 1)) If Not Instr(1,httpRef,"10.10.0.10") > 0 AND Not Instr(1,httpRef,"bcps.org") > 0 Then Sendmail = "This form does not have the correct permissions to send an e-mail response.
Server: " & Request.ServerVariables("HTTP_REFERER") Exit Function End If '-------------------------------------------------------------------------- ' Check That Required Fields contain common names '-------------------------------------------------------------------------- dim Required dim maxReq dim countReq dim arrNameAtt dim arrCommLang dim str 'split the required fields form field Required = Split(ExtraTrim(Request.Form("Required")),",") arrCommLang = Required arrNameAtt = Required maxReq = Ubound(Required) countReq = 0 do while countReq <= maxReq ' if a ":" is not present, a common name is not provided str = Required(countReq) if Instr(1,str,":") = 0 Then arrNameAtt(countReq) = str arrCommLang(countReq) = "" else ' a common name is provided, check for extra ":" str = left(str,(inStr(1,str,":") - 1)) if inStr(1,str,":") > 0 Then sendmail = "Your common name for this field may not contain a "":"". Required Field: " & str exit function else arrCommLang(countReq) = str end if end if str = Required(countReq) ' a common name is provided, check for extra ":" str = right(str,(len(str) - inStr(1,str,":"))) if inStr(1,str,":") > 0 Then sendmail = "Your field name may not contain a "":"". Required Field: " & str exit function else arrNameAtt(countReq) = str end if countReq = countReq + 1 loop '-------------------------------------------------------------------------- ' Check That Required Fields contain information ' Specifically designed to handle multiple selection, checkbox and radio fields '-------------------------------------------------------------------------- dim isRequired isRequired = Required countReq = 0 Do Until countReq > maxReq For each item in Request.Form ' Since forms containing their own collections don't show in the regular form collection ' set flag to see if this required field is found isRequired(countReq) = False If arrNameAtt(countReq) = item Then isRequired(countReq) = True Exit For End If Next ' If the required field is found, check it for a value If isRequired(countReq) Then If Request.Form(item) = "" Then if arrCommLang(countReq) <> "" then Sendmail = sendmail & "
  • " & arrCommLang(countReq) & "
    " else sendmail = sendmail & "
  • " & arrNameAtt(countReq) & "
    " end if End If End If countReq = countReq + 1 Loop maxReq = Ubound(isRequired) countReq = 0 ' If the required field is not found, it is empty. Throw error. Do Until countReq > maxReq If Not isRequired(countReq) Then if arrCommLang(countReq) <> "" Then Sendmail = sendmail & "
  • " & arrCommLang(countReq) & "
    " else sendmail = sendmail & "
  • " & arrNameAtt(countReq) & "
    " end if End If countReq = countReq + 1 Loop If Sendmail <> "" Then Sendmail = "You did not complete all of the required form fields. Please fill in the fields listed below and re-submit the form.
    Required: