Browse discussions in Windows Installer Xml Group
Click here to read .Net and WiX articles
Dalun Software
What do you need today?
sendmail.asp
<%
' This file is provided as part of ASP Power Widgets Samples
'
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT
' WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED,
' INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES
' OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR
' PURPOSE.
' Copyright 1998-2002. All rights reserved.
' Dalun Software Inc. ASP Power Widgets
' http://dalun.com
' mail: sales@dalun.com
' mail: techsupport@dalun.com
' if you have any suggestions or requirements, please write to us.
' Revisions:
' 2.0.0 Initial release
%>
<%
Const APP_VDIR = "/Smtp"
Dim oSourceXMLDOM
Dim strFormXML
Dim oXSLDOM
Dim oSmtp
Dim strXML
Dim sErr
'Validation User Input
strFormXML = "<Mail>"
strFormXML = strFormXML + "<Server>" + Request.Form("Server") + "</Server>"
strFormXML = strFormXML + "<Port>" + Request.Form("Port") + "</Port>"
strFormXML = strFormXML + "<Priority>" + Request.Form("Priority") + "</Priority>"
strFormXML = strFormXML + getFrom()
strFormXML = strFormXML + getTo()
strFormXML = strFormXML + getCc()
strFormXML = strFormXML + getBcc()
strFormXML = strFormXML + "<Subject>" + Server.HTMLEncode(Request.Form("Subject")) + "</Subject>"
strFormXML = strFormXML + "<MailBody>" + Server.HTMLEncode(Request.Form("MailBody")) + "</MailBody>"
strFormXML = strFormXML + getAttUrl()
strFormXML = strFormXML + getAttFile()
strFormXML = strFormXML + "</Mail>"
'Response.write Server.HTMLEncode(strFormXML)
'Response.end
Set oSourceXMLDOM = Server.CreateObject("Msxml2.FreeThreadedDOMDocument")
oSourceXMLDOM.async = false
oSourceXMLDOM.loadxml strFormXML
'Load style sheet.
Set oXSLDOM = GetCachedXMLDOM(Server.Mappath(APP_VDIR) + "\" + "SendMail.xsl")
strXML = oSourceXMLDOM.transformNode(oXSLDOM)
'Response.write strXML
'Response.end
On Error Resume Next
Set oSmtp = CreateObject("ASPPW.Smtp.1")
oSmtp.SendMail strXML
If Err <> 0 Then
sErr = GetErrorMessage(Err)
Response.Write "<TABLE width='100%' height='10%'><TR><TD align='center' valign='center' style='border: 1px solid #93BEE2; padding-bottom:3px;'>Error: <FONT COLOR='red'>" & sErr & "</FONT> <A href='javascript: history.go(-1);'>Click here to go back</A>.</TD></TR></TABLE>"
Else
Response.Write "<TABLE width='100%' height='10%'><TR><TD align='center' valign='center' style='border: 1px solid #93BEE2; padding-bottom:3px;'>The mail has been successfully submitted.</TD></TR></TABLE>"
End if
EndPage()
'---------------------------------------------------------------------------------------
' Functions
'---------------------------------------------------------------------------------------
Function GetErrorMessage(ErrObj)
Dim sDes
sDes = ErrObj.Description
Select case ErrObj.number
case ERR_TIMEOUT
GetErrorMessage = "The host(your POP3 server) is not responding timely. " & sDes
case ERR_NOSESSION
GetErrorMessage = "There is no connection in cache for this ticket, please <A href=""logon.asp"">logon</A> again. " & sDes
case ERR_INVALIDTICKET
GetErrorMessage = "Invalid ticket, please <A href=""logon.asp"">logon</A> again. " & sDes
case ERR_TOOMANYCONNECTIONS
GetErrorMessage = "Service is unavailable now due to too many connections, please wait for a while to try again. " & sDes
case ERR_INVALIDRESPONSE
GetErrorMessage = "Unexpected response from the host(your POP3 server). " & sDes
case ERR_ERRRETURNEDFROMHOST
GetErrorMessage = "The host(your POP3 server) returns an error for your request. " & sDes
case ERR_UNKNOW_HOST
GetErrorMessage = "The host(your POP3 server) is an unknown host. " & sDes
case ERR_LOGONFAILURE
GetErrorMessage = "Invalid account credential. " & sDes
case ERR_WSAETIMEDOUT
GetErrorMessage = "The connected host(your POP3 server) has failed to respond. " & sDes
case else
GetErrorMessage = "0x" & Hex(ErrObj.number) & ". " & sDes
End Select
End function
Function GetCachedXMLDOM(strFile)
Dim strSig
strSig = Application(strFile & "XMLSIG")
If strSig = "" Then
Dim oDOM
Set oDOM = Server.CreateObject("MSXML2.FreeThreadedDOMDocument")
oDOM.async = false
oDOM.load(strFile)
Application.Lock
Set Application(strFile) = oDOM
Application(strFile & "XMLSIG") = "COOL"
Application.Unlock
Set GetCachedXMLDOM = oDOM
Else
Set GetCachedXMLDOM = Application(strFile)
End if
End Function
Function getFrom()
strFrom = Request.Form("From")
getFrom = "<From>" + GetNameEmailPair(strFrom) + "</From>"
End function
Function getTo()
strTo = Request.Form("To")
arrTo = split(strTo, ";")
getTo = "<To>"
For i = lbound(arrTo) to ubound(arrTo)
getTo = getTo + GetNameEmailPair(arrTo(i))
Next
getTo = getTo + "</To>"
End function
Function getCc()
strCc = Request.Form("Cc")
arrCc = split(strCc, ";")
getCc = "<Cc>"
For i = lbound(arrCc) to ubound(arrCc)
getCc = getCc + GetNameEmailPair(arrCc(i))
Next
getCc = getCc + "</Cc>"
End function
Function getBcc()
strBcc = Request.Form("Bcc")
arrBcc = split(strBcc, ";")
getBcc = "<Bcc>"
For i = lbound(arrBcc) to ubound(arrBcc)
getBcc = getBcc + GetNameEmailPair(arrBcc(i))
Next
getBcc = getBcc + "</Bcc>"
End function
Function getAttUrl()
getAttUrl = ""
Dim item
Dim strBase, strPage
item = Request.Form("atturl1")
If Len(item)> 0 Then
strBase = ""
CrackUrl item, strBase, strPage
If Len(strBase) > 0 Then
getAttUrl = getAttUrl & "<AttUrl><base>" & strBase & "</base><page>" & strPage & "</page></AttUrl>"
End if
End if
item = Request.Form("atturl2")
If Len(item)> 0 Then
strBase = ""
strPage = ""
CrackUrl item, strBase, strPage
If Len(strBase) > 0 Then
getAttUrl = getAttUrl & "<AttUrl><base>" & strBase & "</base><page>" & strPage & "</page></AttUrl>"
End if
End if
End function
Function getAttFile()
Dim arrList
getAttFile = ""
strBase = Server.MapPath(APP_VDIR) & "\temp\"
arrList = split(Request.Form("attfile"), "|")
For each item in arrList
If Len(item) > 0 Then
getAttFile = getAttFile & "<AttFile><base>" & strBase & "</base><page>" & item & "</page></AttFile>"
End if
Next
End function
Function GetNameEmailPair(strItem)
Dim i
Dim name, email
If Len(strItem) > 0 Then
Call RegExpTest(strItem, name, email)
If Len(email) > 0 Then
GetNameEmailPair = "<Person><Name>" + Server.HtmlEncode(name) + "</Name>" + "<Email>" + email + "</Email></Person>"
End if
End if
End function
Function RegExpTest(strng, byref name, byref email)
Dim regEx, Match, Matches
Set regEx = CreateObject("VBScript.RegExp")
regEx.Pattern = "(.*)(<)(.+)(>)"
regEx.IgnoreCase = True
regEx.Global = True
Set Matches = regEx.Execute(strng)
For Each Match in Matches
name = Matches(0).SubMatches(0)
email = Matches(0).SubMatches(2)
Next
If Len(email) = 0 then
email = Trim(strng)
End if
End Function
Function CrackUrl(strUrl, ByRef strBase, ByRef strPage)
Dim i, j
If len(strUrl) = 0 Then
Exit function
End if
If Left(strUrl, 4) <> "http" Then
Exit function
End if
i = Instr(strUrl, "://")
If i = -1 Then
Exit function
End if
j = InstrRev(strUrl, "/", -1, 1)
If j = i + 2 Then
If Len(strUrl) = j Then
Exit function
Else
strBase = strUrl
End if
Else
strBase = Left(strUrl, j)
strPage = Right(strUrl, Len(strUrl)-j)
i = Instr(strPage, "?")
If i > 0 Then
strPage = Left(strPage, i-1)
End if
End if
End Function
%>
|
Click here to go back.