discourse-legacysite-perl/site/slowtwitch.com/www/secure/FormProcessor.asp
2024-06-17 22:30:36 +10:00

286 lines
8.3 KiB
Plaintext

<%@ LANGUAGE="VBSCRIPT" %>
<% Option Explicit %>
<script RUNAT="Server" LANGUAGE="VBScript">
Function MailIt(sFrom,sTo,sSub,sBody)
' response.write "From:" & sFrom & "To:" & sTo & "Sub:" & sSub & "Body:" & sBody
On Error Resume Next 'prevent the code from haltng on an error
dim oMail
MailIt=false
Set oMail = Server.CreateObject("CDONTS.Newmail")
oMail.From = sFrom
oMail.To = sTo
oMail.Subject = sSub
oMail.Body = sBody
oMail.Send
If Err.Number <> 0 then
response.write "Error1 Found:" & Err.Number & " " & Err.Description
end if
Set oMail = nothing
If Err.Number = 0 then
MailIt = true
Else
response.write "Error Found:" & Err.Number & " " & Err.Description
End If
End Function
Function Cr2br(sIn)
Dim sLen
Dim iCount
Dim iPos
Dim sCr
Dim sLf
sCr = chr(13)
sLf = chr(10)
sLen = len(sIn)
Cr2br = ""
for iPos = 1 to sLen
if (mid(sIn,iPos,1) = sCr) then
Cr2br=Cr2br & "<br>"
iPos=iPos+1
else
Cr2br=Cr2br & mid(sIn,iPos,1)
end If
next
End Function
</script>
<%
Dim i, j, br, lf
Dim iByteCount, sData, sTemp, bResponse, sEnd
Dim sTo, sFrom, sSubject, sBody, bDataOK, sWebBody, sMessage
Dim sFromField, bFromField, sRedirect, bRedirect, bRedirectIsSecure
Dim aData, aPermit(), iCount, sLeadIn
br = "<BR>"
lf = Chr(13) & Chr(10)
sLeadIn = "The following information was sent:"
'Grab data from header in byte forma
iByteCount = Request.TotalBytes
sTemp = Request.BinaryRead(iByteCount)
'Convert byte data into string data
For i = 1 to iByteCount
sData = sData & Chr(AscB(MidB(sTemp,i,1)))
Next
'Replace Query String substitution characters
sData = Replace(sData, "+", " ")
sData = Replace(sData, "=", ": ")
'Put each value into individual array element
aData = Split(sData, "&", -1, 1)
'Get count of number of entries
On Error Resume Next
i = 0
iCount = 0
Do
If NOT IsEmpty(aData(i)) then
if Err.Number = 0 then
iCount = iCount+1
Else
Exit Do
End If
end If
i=i+1
Loop
'Replace UUEncoding
For i = 0 to iCount-1
aData(i) = Replace(aData(i), "%21", Chr(33)) '!
aData(i) = Replace(aData(i), "%22", Chr(34)) '"
aData(i) = Replace(aData(i), "%23", Chr(35)) '#
aData(i) = Replace(aData(i), "%24", Chr(36)) '$
aData(i) = Replace(aData(i), "%25", Chr(37)) '%
aData(i) = Replace(aData(i), "%26", Chr(38)) '&
aData(i) = Replace(aData(i), "%27", Chr(39)) ''
aData(i) = Replace(aData(i), "%28", Chr(40)) '(
aData(i) = Replace(aData(i), "%29", Chr(41)) ')
aData(i) = Replace(aData(i), "%2A", Chr(42)) '*
aData(i) = Replace(aData(i), "%2B", Chr(43)) '+
aData(i) = Replace(aData(i), "%2C", Chr(44)) ',
aData(i) = Replace(aData(i), "%2D", Chr(45)) '-
aData(i) = Replace(aData(i), "%2E", Chr(46)) '.
aData(i) = Replace(aData(i), "%2F", Chr(47)) '/
aData(i) = Replace(aData(i), "%3A", Chr(58)) ':
aData(i) = Replace(aData(i), "%3B", Chr(59)) ';
aData(i) = Replace(aData(i), "%3C", Chr(60)) '<
aData(i) = Replace(aData(i), "%3D", Chr(61)) '=
aData(i) = Replace(aData(i), "%3E", Chr(62)) '>
aData(i) = Replace(aData(i), "%3F", Chr(63)) '?
aData(i) = Replace(aData(i), "%40", Chr(64)) '@
aData(i) = Replace(aData(i), "%5B", Chr(91)) '[
aData(i) = Replace(aData(i), "%5C", Chr(92)) '\
aData(i) = Replace(aData(i), "%5D", Chr(93)) ']
aData(i) = Replace(aData(i), "%5E", Chr(94)) '^
aData(i) = Replace(aData(i), "%5F", Chr(95)) '_
aData(i) = Replace(aData(i), "%60", Chr(96)) ''
aData(i) = Replace(aData(i), "%7B", Chr(123)) '{
aData(i) = Replace(aData(i), "%7C", Chr(123)) '|
aData(i) = Replace(aData(i), "%7D", Chr(123)) '}
aData(i) = Replace(aData(i), "%7E", Chr(123)) '~
aData(i) = Replace(aData(i), "%0D", Chr(13)) 'Carriage Return
aData(i) = Replace(aData(i), "%0A", Chr(10)) 'Line Feed
Next
Redim aPermit(iCount)
For i = 0 to iCount-1
aPermit(i) = True
If Left(aData(i),Len("MailTo")) = "MailTo" Then
sTo = Mid(aData(i),Len("MailTo")+3)
' Response.write i & " Found MailTo: " & sTo & "<BR>"
aPermit(i) = False
End If
If Left(aData(i),Len("MailFromDefault")) = "MailFromDefault" Then
sFrom = Mid(aData(i),Len("MailFromDefault")+3)
aPermit(i) = False
' Response.write i & " Found MailFromDefault: " & sFrom & "<BR>"
aPermit(i) = False
End If
If Left(aData(i),Len("MailFromField")) = "MailFromField" Then
sFromField = Mid(aData(i),Len("MailFromField")+3)
' Response.write i & " Found MailFromField: " & sFromField & "<BR>"
bFromField = True
aPermit(i) = False
End If
If Left(aData(i),Len("MailSubject")) = "MailSubject" Then
sSubject = Mid(aData(i),Len("MailSubject")+3)
' Response.write i & " Found MailSubject: " & sSubject & "<BR>"
aPermit(i) = False
End If
If Left(aData(i),Len("MailRedirect")) = "MailRedirect" Then
sRedirect = "http://" & Mid(aData(i),Len("MailRedirect")+3)
' Response.write i & " Found MailRedirect: " & sRedirect & "<BR>"
bRedirect = True
aPermit(i) = False
End If
If Left(aData(i),Len("MailRedirectSecure")) = "MailRedirectSecure" Then
sRedirect = "https://" & Mid(aData(i),Len("MailRedirectSecure")+3)
' Response.write i & " Found MailRedirectSecure: " & sRedirect & "<BR>"
bRedirect = True
aPermit(i) = False
End If
If Left(aData(i),Len("MailLeadIn")) = "MailLeadIn" Then
'Only Assign if NOT blank
If Mid(aData(i),Len("MailLeadIn")+3) <> 0 then
sLeadIn = Mid(aData(i),Len("MailLeadIn")+3)
End If
aPermit(i) = False
' Response.write i & " Found MailLeadIn: " & sLeadIn & "<BR>"
End If
Next
'if MailFromField = true, then find FromField Value
If bFromField = True Then
For i = 0 to iCount-1
If Left(aData(i),Len(sFromField)) = sFromField Then
'Only Assign if NOT blank (3 is necessary to remove filler)
'***This Section could use some work ensuring email is valid - like ...,; etc ***
If Len(Trim(Mid(aData(i),Len(sFromField)+3))) > 0 then
sFrom = Mid(aData(i),Len(sFromField)+3)
End If
End If
Next
End If
'Create Body of Message
sBody = sLeadIn & lf & lf
For i = 0 to iCount-1
If aPermit(i) = True Then
sBody = sBody & aData(i) & lf
End If
Next
'Check that there is enough data to send mail
bDataOK = True
If len(sFrom) = 0 Then
bDataOK = False
sMessage = "No FROM Element.<BR>"
End If
If len(sTo) = 0 Then
bDataOK = False
sMessage = "No TO Element.<BR>"
End If
If len(sSubject) = 0 Then
bDataOK = False
sMessage = "No SUBJECT Element.<BR>"
End If
If len(sBody) = 0 Then
bDataOK = False
sMessage = "No BODY Content.<BR>"
End If
' Response.Write "To: " & sTo & br
' Response.Write "From: " & sFrom & br
' Response.Write "Subject: " & sSubject & br
' Response.Write "Body: <BR>" & sWebBody
If bDataOK = False Then
%>
<html>
<Head>
<META NAME="GENERATOR" Content="Microsoft Visual InterDev 1.0">
<META HTTP-EQUIV="Content-Type" content="text/html; charset=iso-8859-1">
<title>An Error Occurred</title>
</head>
<body bgcolor="FFFFFF">
<h1 align="center"><font color="#FF0000">An Error Occurred:</font></h1>
<p>An Error Occured with this application (Insufficient Data). Please Contact The System
Administrator of this website. The form you filled out was NOT configured correctly.<br>
&nbsp;<br><br>
ERROR:<br>
<%= sMessage%><BR><BR>
If you should see this message, PLEASE click <a href="Mailto:Webmaster@Aawsom.net">HERE</a>
to notify the hostmaster that a problem occurred. Include the name of the website that
this error occurred on. It will keep others from having this problem. We apologise that
you took the time to fill out this form and that it was NOT delivered due to this site's
inability to test their software before implementing it.</p>
<%
Else
'Mail It
sResult = mailIt(sFrom,sTo,sSubject,sBody)
'If redirecting to another page, redirect before anything is written to page
If bRedirect = True then
Response.Redirect sRedirect
End If
%>
<html>
<Head>
<META NAME="GENERATOR" Content="Microsoft Visual InterDev 1.0">
<META HTTP-EQUIV="Content-Type" content="text/html; charset=iso-8859-1">
<title>Form Results</title>
</head>
<%
'Print out the Message
sWebBody = Cr2BR(sBody)
Response.Write sWebBody
End If
%>
</BODY>
</HTML>