CDONTS to CDOSYS
I rarely use asp but my employers are changing to Windows 2003 and have asked me to look into converting a validation script from CDONTS to CDOSYS, something I have never attempted, let alone have much idea about! Can anyone help please?
The script is;
<% Option Explicit %>
<%
Dim Item
Dim strTo, strFrom, strSubject, strBody
Dim strRequiredFields, strRequiredField, lRequiredDelimPos
Dim strOrderFields, strOrderField, lOrderDelimPos
Dim strSuccessPage, strErrorPage
Dim bError, strErrorMessage, strMailError
'-- Reset the errors
bError = false
strErrorMessage = ""
'-- Retrieve action variables
strTo = Request.Form("to")
strFrom = Request.Form("from")
strSubject = Request.Form("subject")
strRequiredFields = Request.Form("required-fields")
strOrderFields = Request.Form("field-order")
strSuccessPage = Request.Form("success-page")
strErrorPage = Request.Form("error-page")
'-- Retrieve the email values
If strOrderFields <> "" Then
' split strOrderFields into form fields
Do Until InStr(strOrderFields,",") = 0
'extract the field
lOrderDelimPos = InStr(strOrderFields, ",")
strOrderField = Left(strOrderFields, lOrderDelimPos - 1)
' Add form value to the email
strBody = strBody & strOrderField & ": " & Request.Form(strOrderField) & vbCrLf & vbCrLf
'strip off field text from order fields and reset delimitor position --
strOrderFields = Right(strOrderFields, Len(strOrderFields) - lOrderDelimPos)
lOrderDelimPos = 0
Loop
' Add last form value to the email
If strOrderFields <> "" Then
strBody = strBody & Trim(strOrderFields) & ": " & Request.Form(Trim(strOrderFields)) & vbCrLf & vbCrLf
End if
Else
' Loop through all the form values
For each Item in Request.Form
Select Case Item
Case "to","from","subject","required-fields","ordered-fields","success-page","error-page"
' Do nothing
Case Else
' Add form value to the email
strBody = strBody & Item & ": " & Request.Form(Item) & vbCrLf & vbCrLf
End Select
Next
End If
'-- Validate the success page
If strSuccessPage = "" Then
bError = True
strErrorMessage = strErrorMessage & Server.HTMLEncode("No success page specified.") & "<br />"
End If
'-- Validate the error page
If strErrorPage = "" Then
bError = True
strErrorMessage = strErrorMessage & Server.HTMLEncode("No error page specified.") & "<br />"
End If
'-- Validate the recipient address
If strTo = "" Or Not IsValidEmail(strTo) Then
bError = True
strErrorMessage = strErrorMessage & Server.HTMLEncode("Invalid recipient email address: '" & strTo & "'.") & "<br />"
End If
'-- Validate the sender address
If strFrom = "" Or Not IsValidEmail(strFrom) Then
bError = True
strErrorMessage = strErrorMessage & Server.HTMLEncode("Invalid sender email address: '" & strFrom & "'.") & vbCrLf
End If
'-- Validate required fields
If strRequiredFields <> "" Then
' split strRequiredFields into validation fields
Do Until InStr(strRequiredFields,",") = 0
'extract the validation field
lRequiredDelimPos = InStr(strRequiredFields, ",")
strRequiredField = Left(strRequiredFields, lRequiredDelimPos - 1)
'check the field
If Request.Form(strRequiredField) = "" Then
bError = True
strErrorMessage = strErrorMessage & Server.HTMLEncode("Missing value for required '" & strRequiredField & "' field.") & "<br />"
End if
'strip off validation field text from text row and reset delimitor position --
strRequiredFields = Right(strRequiredFields, Len(strRequiredFields) - lRequiredDelimPos)
lRequiredDelimPos = 0
Loop
'check the last field
If strRequiredFields <> "" Then
If Request.Form(strRequiredFields) = "" Then
bError = True
strErrorMessage = strErrorMessage & Server.HTMLEncode("Missing value for required '" & strRequiredFields & "' field.") & "<br />"
End if
End if
End If
'Response.write "'" & strErrorMessage & "'<br />"
'Response.flush
'Response.write "Error " & Err.Number & ": " & Err.Description
'-- Check for errors
If bError = True Then
'-- Redirect to the error page
If strErrorPage <> "" Then
Response.Redirect strErrorPage & "?ErrorMessage=" & strErrorMessage
Else
Response.Write "<html><head><title>Mail Error</title></head> " _
& "<body> " _
& "<h1>Errors</h1> " _
& "" & strErrorMessage & " " _
& "</body>"
End If
Else
'-- Send the mail
strMailError = SendMail (strTo, strFrom, strFrom, "NORMAL", strSubject, strBody, "", False)
If strMailError <> "" Then
bError = True
strErrorMessage = strErrorMessage & "Mail could not be sent. " & strMailError & vbCrLf
End If
'-- Redirect to the success or error page
If bError = True Then
Response.Redirect strErrorPage & "?ErrorMessage=" & strErrorMessage
Else
Response.Redirect strSuccessPage
End If
End If
Function DoesFileExist(dfeFilePath)
Dim fs
Set fs=Server.CreateObject("Scripting.FileSystemObject ")
DoesFileExist = fs.FileExists( dfeFilePath)
set fs=nothing
End Function
Function IsValidEmail(strEmail)
' Checks that email addresses are of the format
' "user@domain.com"
Dim bIsValid
bIsValid = True
'Check for minimum length of 1 leter, at sign, one letter, dot, one letter
If Len(strEmail) < 5 Then
bIsValid = False
Else
'Check that email address includes no spaces
If Instr(1, strEmail, " ") <> 0 Then
bIsValid = False
Else
'Check that email address include at sign
If InStr(1, strEmail, "@", 1) < 2 Then
bIsValid = False
Else
'Check that email address includes at least one dot after the at sign
If InStrRev(strEmail, ".") < InStr(1, strEmail, "@", 1) + 2 Then
bIsValid = False
End If
End If
End If
End If
IsValidEmail = bIsValid
End Function
Function SendMail(sTo, sFrom, sReplyTo, sPriority, sSubject, sBody, sAttachment, bHTML)
'On Error Resume Next
Const cdoLow = 0 ' Low importance
Const cdoNormal = 1 ' Normal importance (default)
Const cdoHigh = 2 ' High importance
Const cdoBodyFormatHTML = 0
Const cdoBodyFormatText = 1
Const cdoMailFormatMime = 0
Const cdoMailFormatText = 1
Dim oMailMessage
' Create a new mail object
Set oMailMessage = Server.CreateObject("CDONTS.NewMail")
' Set a destination email address
oMailMessage.To = sTo
' Set a From and Reply-TO email address
oMailMessage.From = sFrom
oMailMessage.Value("Reply-To") = sReplyTo
' Set the subject
oMailMessage.Subject = sSubject
' Set the priority
sPriority = ucase(sPriority)
if sPriority = "LOW" then
oMailMessage.importance = cdoLow
elseif sPriority = "HIGH" then
oMailMessage.importance = cdoHigh
else
oMailMessage.importance = cdoNormal
end if
' Set body format for HTML if needed
if bHTML then
oMailMessage.BodyFormat = cdoBodyFormatHTML
oMailMessage.MailFormat = cdoMailFormatMime
else
oMailMessage.BodyFormat = cdoBodyFormatText
oMailMessage.MailFormat = cdoMailFormatText
end if
oMailMessage.Body = sBody
' Set attachment
if sAttachment <> "" then
oMailMessage.Attachfile sAttachment
end if
' Now send it off!
oMailMessage.Send
set oMailMessage = nothing
if Err then
SendMail = "Error " & Err.Number & ": " & Err.Description
else
SendMail = ""
end if
End Function
%>
Many thanks in advance,
Geoff
|
Linear Mode
