aspmkrfn.asp

AspMaker调用的自定义包

<!--##session aspfunction##-->
<!--##
sDateSeparator = PROJ.DateSeparator
If sDateSeparator = "" Then sDateSeparator = "/"
sSmtpServer = PROJ.SmtpServer
If sSmtpServer = "" Then sSmtpServer = "localhost"
iSmtpServerPort = PROJ.SmtpServerPort
If iSmtpServerPort <= 0 Then iSmtpServerPort = 25
##-->
<%
' ASPMaker functions for ASPMaker 5+
' (C)2006 e.World Technology Ltd.

' Common constants
Const EW_DATE_SEPARATOR = "<!--##=sDateSeparator##-->"
Const EW_SMTPSERVER = "<!--##=sSmtpServer##-->"
Const EW_SMTPSERVER_PORT = <!--##=iSmtpServerPort##-->
Const EW_SMTPSERVER_USERNAME = "<!--##=PROJ.SMTPServerUsername##-->"
Const EW_SMTPSERVER_PASSWORD = "<!--##=PROJ.SMTPServerPassword##-->"

'-------------------------------------------------------------------------------
' Functions for default date format
' ANamedFormat = 0-8, where 0-4 same as VBScript
' 5 = "yyyy<!--##=PROJ.DateSeparator##-->mm<!--##=PROJ.DateSeparator##-->dd"
' 6 = "mm<!--##=PROJ.DateSeparator##-->dd<!--##=PROJ.DateSeparator##-->yyyy"
' 7 = "dd<!--##=PROJ.DateSeparator##-->mm<!--##=PROJ.DateSeparator##-->yyyy"
' 8 = Short Date & " " & Short Time

Function EW_FormatDateTime(ADate, ANamedFormat)
	If IsDate(ADate) Then
		If ANamedFormat >= 0 And ANamedFormat <= 4 Then
			EW_FormatDateTime = FormatDateTime(ADate, ANamedFormat)
		ElseIf ANamedFormat = 5 Then
			EW_FormatDateTime = Year(ADate) & EW_DATE_SEPARATOR & Month(ADate) & EW_DATE_SEPARATOR & Day(ADate)
		ElseIf ANamedFormat = 6 Then
			EW_FormatDateTime = Month(ADate) & EW_DATE_SEPARATOR & Day(ADate) & EW_DATE_SEPARATOR & Year(ADate)
		ElseIf ANamedFormat = 7 Then
			EW_FormatDateTime = Day(ADate) & EW_DATE_SEPARATOR & Month(ADate) & EW_DATE_SEPARATOR & Year(ADate)
		ElseIf ANamedFormat = 8 Then
			EW_FormatDateTime = FormatDateTime(ADate, 2)
			If Hour(ADate) <> 0 Or Minute(ADate) <> 0 Or Second(ADate) <> 0 Then
				EW_FormatDateTime = EW_FormatDateTime & " " & FormatDateTime(ADate, 4) & ":" & ewZeroPad(Second(ADate), 2)
			End If
		Else
			EW_FormatDateTime = ADate
		End If
	Else
		EW_FormatDateTime = ADate
	End If
End Function

Function EW_UnFormatDateTime(ADate, ANamedFormat)
	Dim arDateTime, arDate
	ADate = Trim(ADate & "")
	While Instr(ADate, "  ") > 0
		ADate = Replace(ADate, "  ", " ")
	Wend
	arDateTime = Split(ADate, " ")
	If UBound(arDateTime) < 0 Then
		EW_UnFormatDateTime = ADate
		Exit Function
	End If
	arDate = Split(arDateTime(0), EW_DATE_SEPARATOR)
	If UBound(arDate) = 2 Then
		If ANamedFormat = 6 Then
			EW_UnFormatDateTime = arDate(2) & "/" & arDate(0) & "/" & arDate(1)
		ElseIf ANamedFormat = 7 Then
			EW_UnFormatDateTime = arDate(2) & "/" & arDate(1) & "/" & arDate(0)
		ElseIf ANamedFormat = 5 Then
			EW_UnFormatDateTime = arDate(0) & "/" & arDate(1) & "/" & arDate(2)
		Else
			EW_UnFormatDateTime = arDateTime(0)
		End If
		If UBound(arDateTime) > 0 Then
			If IsDate(arDateTime(1)) Then ' Is time
				EW_UnFormatDateTime = EW_UnFormatDateTime & " " & arDateTime(1)
			End If
		End If
	Else
		EW_UnFormatDateTime = ADate
	End If
End Function

'-------------------------------------------------------------------------------
' Function for format percent

Function EW_FormatPercent(Expression, NumDigitsAfterDecimal, IncludeLeadingDigit, UseParensForNegativeNumbers, GroupDigits)
	On Error Resume Next
	EW_FormatPercent = FormatPercent(Expression, NumDigitsAfterDecimal, IncludeLeadingDigit, UseParensForNegativeNumbers, GroupDigits)
	If Err.Number <> 0 Then
		EW_FormatPercent = FormatNumber(Expression*100, NumDigitsAfterDecimal, IncludeLeadingDigit, UseParensForNegativeNumbers, GroupDigits) & "%"
	End If
End Function

' Note: Object "conn" is required
Function ewExecuteScalar(SQL)
	ewExecuteScalar = Null
	If Trim(SQL&"") = "" Then	Exit Function
	Dim rs
	Set rs = conn.Execute(SQL)
	If Not rs.Eof Then ewExecuteScalar = rs(0)
	rs.Close
	Set rs = Nothing
End Function

'-------------------------------------------------------------------------------
' Function for debug
Sub Trace(aMsg)
	On Error Resume Next

	Dim fso, ts

	Set fso = Server.Createobject("Scripting.FileSystemObject")
	Set ts = fso.OpenTextFile(Server.MapPath("debug.txt"), 8, True)
	ts.writeline(aMsg)
	ts.Close
	Set ts = Nothing
	Set fso = Nothing
End Sub
%>
<%
' Function to Load Email Content from input file name
' - Content Loaded to the following variables
' - Subject: sEmailSubject
' - From: sEmailFrom
' - To: sEmailTo
' - Cc: sEmailCc
' - Bcc: sEmailBcc
' - Format: sEmailFormat
' - Content: sEmailContent
'
<!--## If PROJ.OptionExplicit Then ##-->
Dim sEmailFrom, sEmailTo, sEmailCc, sEmailBcc, sEmailSubject, sEmailFormat, sEmailContent
<!--## Else ##-->
sEmailFrom = "": sEmailTo = "": sEmailCc = "": sEmailBcc = "": sEmailSubject = "": sEmailFormat = "": sEmailContent = ""
<!--## End If ##-->
Sub LoadEmail(fn)

	Dim sWrk, sHeader, arrHeader
	Dim sName, sValue
	Dim i, j

	' Initialize
	sEmailFrom = "": sEmailTo = "": sEmailCc = "": sEmailBcc = "": sEmailSubject = "": sEmailFormat = "": sEmailContent = ""

	sWrk = LoadTxt(fn) ' Load text file content
	sWrk = Replace(sWrk, vbCrLf, vbLf) ' Convert to Lf
	sWrk = Replace(sWrk, vbCr, vbLf) ' Convert to Lf
	If sWrk <> "" Then
		' Locate Header & Mail Content
		i = InStr(sWrk, vbLf&vbLf)
		If i > 0 Then
			sHeader = Mid(sWrk, 1, i)
			sEmailContent = Mid(sWrk, i+2)
			arrHeader = Split(sHeader, vbLf)
			For j = 0 to UBound(arrHeader)
				i = InStr(arrHeader(j), ":")
				If i > 0 Then
					sName = Trim(Mid(arrHeader(j), 1, i-1))
					sValue = Trim(Mid(arrHeader(j), i+1))
					Select Case LCase(sName)
						Case "subject": sEmailSubject = sValue
						Case "from": sEmailFrom = sValue
						Case "to": sEmailTo = sValue
						Case "cc": sEmailCc = sValue
						Case "bcc": sEmailBcc = sValue
						Case "format": sEmailFormat = sValue
					End Select
				End If
			Next
		End If
	End If

End Sub

' Function to Load a Text File
Function LoadTxt(fn)

	Dim fso, fobj

	' Get text file content
	Set fso = Server.CreateObject("Scripting.FileSystemObject")
	Set fobj = fso.OpenTextFile(Server.MapPath(fn))

	LoadTxt = fobj.ReadAll ' Read all Content

	fobj.Close
	Set fobj = Nothing

End Function

' Function to Send out Email
Sub Send_Email(sFrEmail, sToEmail, sCcEmail, sBccEmail, sSubject, sMail, sFormat)

<!--## If PROJ.EmailComponent = "w3JMail" Then ##-->

	Dim objMail
	Dim arrEmail, i, sEmail
	Set objMail = Server.CreateObject("JMail.Message")
	objMail.Logging = True
	objMail.Silent = True
	objMail.From = sFrEmail
	arrEmail = Split(Replace(sToEmail, ",", ";"), ";")
	For i = 0 to UBound(arrEmail)
		sEmail = Trim(arrEmail(i))
		If sEmail <> "" Then
			objMail.AddRecipient sEmail
		End If
	Next
	arrEmail = Split(Replace(sCcEmail, ",", ";"), ";")
	For i = 0 to UBound(arrEmail)
		sEmail = Trim(arrEmail(i))
		If sEmail <> "" Then
			objMail.AddRecipientCC sEmail
		End If
	Next
	arrEmail = Split(Replace(sBccEmail, ",", ";"), ";")
	For i = 0 to UBound(arrEmail)
		sEmail = Trim(arrEmail(i))
		If sEmail <> "" Then
			objMail.AddRecipientBCC sEmail
		End If
	Next
	objMail.Subject = sSubject
	If LCase(sFormat) = "html" Then
		objMail.HTMLBody = sMail
	Else
		objMail.Body = sMail
	end if
	If EW_SMTPSERVER_USERNAME <> "" And EW_SMTPSERVER_PASSWORD <> "" Then
		objMail.MailServerUserName = EW_SMTPSERVER_USERNAME
		objMail.MailServerPassword = EW_SMTPSERVER_PASSWORD
	End If
	If Not objMail.Send(EW_SMTPSERVER) Then
		Response.Write objMail.Log
		Set objMail = nothing
		Response.End
	End If
	Set objMail = nothing

<!--## ElseIf PROJ.EmailComponent = "ASPEmail" Then ##-->

	Dim objMail
	Dim arrEmail, i, sEmail
	Set objMail = Server.CreateObject("Persits.MailSender")
	objMail.From = sFrEmail
	arrEmail = Split(Replace(sToEmail, ",", ";"), ";")
	For i = 0 to UBound(arrEmail)
		sEmail = Trim(arrEmail(i))
		If sEmail <> "" Then
			objMail.AddAddress sEmail
		End If
	Next
	arrEmail = split(Replace(sCcEmail, ",", ";"), ";")
	For i = 0 to UBound(arrEmail)
		sEmail = Trim(arrEmail(i))
		If sEmail <> "" Then
			objMail.AddCC sEmail
		End If
	Next
	arrEmail = split(Replace(sBccEmail, ",", ";"), ";")
	For i = 0 to UBound(arrEmail)
		sEmail = Trim(arrEmail(i))
		If sEmail <> "" Then
			objMail.AddBcc sEmail
		End If
	Next
	If LCase(sFormat) = "html" Then
		objMail.IsHTML = True  ' html
	Else
		objMail.IsHTML = False ' text
	End If
	objMail.Subject = sSubject
	objMail.Body = sMail
	objMail.Host = EW_SMTPSERVER
	If EW_SMTPSERVER_USERNAME <> "" And EW_SMTPSERVER_PASSWORD <> "" Then
		objMail.Username = EW_SMTPSERVER_USERNAME
		objMail.Password = EW_SMTPSERVER_PASSWORD
	End If
	objMail.Send
	Set objMail = Nothing

<!--## Else ##-->

	Dim objMail, objConfig, sServerVersion, i, sIISVer
	Dim sSmtpServer, iSmtpServerPort

	sServerVersion = Request.ServerVariables("SERVER_SOFTWARE")
	If InStr(sServerVersion, "Microsoft-IIS") > 0 Then
		i = InStr(sServerVersion, "/")
		If i > 0 Then
			sIISVer = Trim(Mid(sServerVersion, i+1))
		End If
	End If

	If sIISVer < "5.0" Then
		' NT using CDONTS
		Set objMail = Server.CreateObject("CDONTS.NewMail")
		objMail.From = sFrEmail
		objMail.To = Replace(sToEmail, ",", ";")
		If sCcEmail <> "" Then
			objMail.Cc = Replace(sCcEmail, ",", ";")
		End If
		If sBccEmail <> "" Then
			objMail.Bcc = Replace(sBccEmail, ",", ";")
		End If
		If LCase(sFormat) = "html" Then
			objMail.BodyFormat = 0 ' 0 means HTML format, 1 means text
			objMail.MailFormat = 0 ' 0 means MIME, 1 means text
		End If
		objMail.Subject = sSubject
		objMail.Body = sMail
		objMail.Send
		Set objMail = Nothing
	Else
		' 2000 / XP / 2003 using CDO
		' Set up Configuration
		Set objConfig = Server.CreateObject("CDO.Configuration")
		objConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = EW_SMTPSERVER ' cdoSMTPServer
		objConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = EW_SMTPSERVER_PORT ' cdoSMTPServerPort
		objConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
		If EW_SMTPSERVER_USERNAME <> "" And EW_SMTPSERVER_PASSWORD <> "" Then
			objConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 'cdoBasic (clear text)
			objConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = EW_SMTPSERVER_USERNAME
			objConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = EW_SMTPSERVER_PASSWORD
		End If
		objConfig.Fields.Update
		' Set up Mail
		Set objMail = Server.CreateObject("CDO.Message")
		objMail.From = sFrEmail
		objMail.To = Replace(sToEmail, ",", ";")
		If sCcEmail <> "" Then
			objMail.Cc = Replace(sCcEmail, ",", ";")
		End If
		If sBccEmail <> "" Then
			objMail.Bcc = Replace(sBccEmail, ",", ";")
		End If
		If LCase(sFormat) = "html" Then
			objMail.HtmlBody = sMail
		Else
			objMail.TextBody = sMail
		End If
		objMail.Subject = sSubject
		If EW_SMTPSERVER <> "" And LCase(EW_SMTPSERVER) <> "localhost" Then
			Set objMail.Configuration = objConfig ' Use Configuration
			objMail.Send
		Else
			On Error Resume Next
			objMail.Send ' Send without Configuration
			If Err.Number <> 0 Then
				If Hex(Err.Number) = "80040220" Then ' Requires Configuration
					Set objMail.Configuration = objConfig
					Err.Clear
					On Error GoTo 0
					objMail.Send
				Else
					Dim ErrNo, ErrSrc, ErrDesc
					ErrNo = Err.Number
					ErrSrc = Err.Source