当前位置:文档之家› ASP发送邮件

ASP发送邮件

ASP发送邮件 【字体:小 大】

ASP发送邮件

作者:蓝色理想 文章来源:https://www.doczj.com/doc/f3509139.html, 点击数:519 更新时间:2006-8-25

https://www.doczj.com/doc/f3509139.html,/tech/program/2003/1173.asp

一. 程序思路

所有的程序,主要实现两个功能,一、发送邮件;二、上传附件。使用无组件上传程序来上传附件到服务器,在发送完后,将删除服务器上的邮件。实现这两个功能,需要一个数据库来存放邮件内容及附件信息(文件名)。邮件的发送有两种情况:一是,无附件的邮件;二是,有附件的邮件。

1.发送无附件的邮件。用户根据实际情况来填写收信人、发信人、抄送、密送、SMTP服务器地址、邮件主题、邮件内容等信息,这些信息中,收信人、发信人、邮件主题、邮件内容是必须填写的,否则将收不到邮件。如果SMTP服务器支持SMTP验证,那么你就把你在该邮局的用户名和密码填上。如,你填的发信人地址是xxxx@https://www.doczj.com/doc/f3509139.html,,因为163的SMTP服务,支持SMTP验证,所以你就要需要你在163的用户名xxxx,密码****,这样才能顺利发送邮件;如,你发信人地址是xxxx@https://www.doczj.com/doc/f3509139.html,,因为hotmail是不需要SMTP验证的,所以你不用填写用户名和密码。只要记住一点,你的发信的SMTP服务器支持SMTP验证的话,你就要填写相应的用户名和密码。你在填写完表单后,点“发送”按钮就直接发送邮件了。这个过程是在mail.asp和inc_clsEmail.asp完成的。

2.发送带附件的邮件。这个过程,主要分三步,一、填写表单信息(同上),不过在点“发送”按钮前,需要转到第二步,发送附件。二、此步聚主要是上传附件到服务器。需要服务器支持FSO、Dictionary、Stream等组件。在进入上传附件界面前,先在数据库中创建一条记录,把刚成填的表单信息存在表里,然后选择本地需要本地的rar或zip文件,选好后点“上传”按钮就行了,传完后程序将更新数据库中存入附件文件名和字段的内容并自动跳转到发信页面,发信页面从数据库中读取邮件信息并显示出来,此时点“发送”,就将发送附件了。本过程主要由mail.asp、inc_clsEmail.asp、inc_clsUpload.asp、Upload.asp和Uploadok.asp来完成。

在这个发信程序中用到的文件清单:
attachment.mdb '邮件信息临时存放库
install.asp '在数据库中创建邮件信息临时表
Mail.asp '发送邮件
Upload.asp '文件上传
Uploadok.asp '文件上传成功
inc_clsEmail.asp '邮件发送类
inc_clsUpload.asp '无组件上传类
inc_set.asp '一些表

格颜色的设置

二.建立数据库
1.打开你的Access建立一个文件名为:attachment.mdb.添加以下字段:
(1). ID 类型为自动编号(存放邮件信息的ID编号)
(2). smtpcheck 类型为是/否字段(存放是否需要SMTP验证)
(3). from 类型为文本字段(存放发信人的Email地址)
(4). fromname 类型为文本字段(存放发信人的名字)
(5). to 类型为文本字段(存放收信人的Email地址)
(6). bcc 类型为文本字段(存放密送人的Email地址)
(7). cc 类型为文本字段(存放抄送人的Email地址)
(8). server 类型为文本字段(存放SMTP服务器地址)
(9). subject 类型为文本字段(存放邮件主题)
(10). body 类型为备注字段(存放邮件的内容)
(11). username 类型为文本字段(存放邮箱登录用户名)
(12). password 类型为文本字段(存放邮箱登录的密码)
(13). filenames 类型为文本字段(存放附件的文件名)
注意:可以把字段设置为允许为空。

当然你可以自己添加你认为需要的字段,如果你把字段名或表名换成其它名称,则对程序也要作出相应的更改,不然会出错。如果你不想手工建表及添加字段,那你可以在浏览器中运行Install.asp文件,它可以自动建表,你就可以偷懒了:)

2. 在开始编写之前你可以罗列一下要用到的SQL语句.


'搜索出数据库中ID号为1的邮件信息
SQL = "SELECT * FROM attachment ORDER BY WHERE id=1"
'这个语句是添加新的临时邮件信息时用到的.
SQL="INSERT INTO attachment(smtpcheck,from,fromname,to,bcc,cc,server,subject,body,username,
password,filenames) VALUES(true,'cjj8110@https://www.doczj.com/doc/f3509139.html,',cjj','cjj8110@https://www.doczj.com/doc/f3509139.html,','','','','测试','测试邮件件发送程序','cjj8110','********','1,zip,1.rar')"
'删除表中全部数据。
SQL = "DELETE FROM attachment"
'删除表中指定ID的记录
SQL = "DELETE FROM attachment WHERE id =" & id
'更新表中,指定ID的filenames字段的内容
SQL = "UPDATE attachemnt SET filenames='" & filenames & "' WHERE ID=" & id



三.编写代码
Install.asp:考虑到手工建表有点麻烦,所以写了这个文件。文件主要用到CREATE TABLE和DROP TABLE语句,不过由于数据库的原因,有些数据库有可能不支持此语句。本文以Access为例,因为ACCESS支持这两条语句,如果还是新手还看不懂那也没关系,以为有机会再研究好了:)。由于不清楚数据库定义了那些关键字,所以在创建表和字段时,都用[]把表名和字段名括起来,即使表名或字段名和数据库的关键字冲突,也不会引起程序出错。不过运行本程序前,必须先在Access中

创建一个数据库名称为attachment.mdb,可以不为其创建表,用此程序来创建。

install.asp的源码:
<%
'此文件在执行后最好删除,因为如果不注意再次执行的话,将会使数据库的所有数据丢失,切记!

Dim SYS_strTableName,SYS_strSQL,SYS_objRS

'需要创建的表的名字
SYS_strTableName = "attachment"

Set objConn = Server.CreateObject("ADODB.Connection")

'OLEDB方式打开数据库的Connection对象连接字符串
strcon="provider=microsoft.jet.oledb.4.0;data source=" & Server.mappath("attachment.mdb")
objConn.open strcon'和数据库已经建立连接可对其操作了.


'DROP TABLE是一条从数据库中删除表的SQL语句。有些数据库有可能不支持。
SYS_strSQL = "DROP TABLE [" & SYS_strTableName & "]"

'删除表时,如果有错误出现则跳转执行下语句
'因为如果DROP TABLE一个数据库中并不存在的表时,就会导致程序出错,
'所以加了这个语句On Error Resume Next

On Error Resume Next

objConn.Execute (SYS_strSQL)

'因为On Error Resume Next比较耗资源,执行这条语句后,下面再出现错误将不会被跳转了也就是On Error Resume Next将不对此后的语句产生作用了,如果不加这句话,就对此后的都起屏蔽错误的作用。
On Error Goto 0

'创建表格的主要是用CREATE TABLE语句
'CREATE TABLE tablename (fieldname1 fieldytype1,fieldname2 fieldtype2......)
SYS_strSQL = "CREATE TABLE [" & SYS_strTableName & "] ("

'此为创建自动编号类型的字段id
SYS_strSQL = SYS_strSQL & "[id] integer IDENTITY (1, 1) PRIMARY KEY NOT NULL ,"

'创建文本类型的字段smtpcheck,字段类型为是/否类型。
SYS_strSQL = SYS_strSQL & "[smtpcheck] yesno,"

'创建文本类型的字段homepage,并限定该字段的长度为50(char(50)实现该功能),允许为空(NULL)
SYS_strSQL = SYS_strSQL & "[from] char(50) NULL ,"
SYS_strSQL = SYS_strSQL & "[fromname] char(50) NULL,"
SYS_strSQL = SYS_strSQL & "[to] char(50) NULL ,"
SYS_strSQL = SYS_strSQL & "[bcc] char(50) NULL,"
SYS_strSQL = SYS_strSQL & "[cc] char(50) NULL ,"
SYS_strSQL = SYS_strSQL & "[server] char(50) NULL,"
SYS_strSQL = SYS_strSQL & "[subject] char(50) NULL ,"
SYS_strSQL = SYS_strSQL & "[body] memo,"
SYS_strSQL = SYS_strSQL & "[username] char(50) NULL,"
SYS_strSQL = SYS_strSQL & "[password] char(50) NULL ,"
SYS_strSQL = SYS_strSQL & "[filenames] char(50) NULL)"

Set SYS_objRS = objConn.Execute(SYS_strSQL)
'显示创建成功信息。
Response.Write ("
" & SYS_strTableName & " 表创建成功!
")
%>
[Ctrl+A 全部选择 然后拷贝]

mail.asp的源码:

<%
Dim sAction,objMail,strID,strConn,strSQL,objConn,objRS
Dim sServer,bSMTPCheck,sSubject,sBody,sFrom,sFromName,sTo,sBCC,sCC,sSMTPCheck,sAddF

ile,sUsername,sPassword

sAction = Trim(Request.Form("action"))

If sAction = "发送" Then
Sub DelFiles(filename)
Dim objFSO
On Error Resume Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFile filename
If Err.Number <> 0 Then On Error Goto 0
End Sub

Dim MyMail,sReturn,aryTemp,i,sAttachmentPath
Dim sFileName,sFilePath,intID

intID = Trim(Session("Attachment_ID"))
If intID = "" THen
'去除附件表中的相应附件记录
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.Mappath("attachment.mdb")
strSQL = "DELETE FROM [attachment]"

Set objConn = CreateObject("Adodb.Connection")
On Error Resume Next
Set objRS = objConn.Execute(strSQL)

If err.Number <> 0 Then
On Error Goto 0
End If

Set objConn = Nothing

Session("Attachment_ID") = ""
Session.Abandon


sSubject = Trim(Request.Form("subject"))
sUsername = Trim(Request.Form("username"))
sPassword = TriM(Request.Form("password"))
sBody = Trim(Request.Form("body"))
sFrom = Trim(Request.Form("from"))
sFromName = Trim(Request.Form("fromname"))
sTo = Trim(Request.Form("to"))
sBCC = Trim(Request.Form("BCC"))
sCC = Trim(Request.Form("CC"))

'创建邮件Class
Set MyMail = New SWEmail

'自已设定邮件组件创建字符串
'MyMail.SetObject("CDONTS.NewMail")
'MyMail.SetObject("JMail.Message")
'MyMail.SetObject("JMail.SmtpMail")

If sBCC <> "" Then MyMail.BCC(sBCC) '密送
If sCC <> "" Then https://www.doczj.com/doc/f3509139.html,(sCC) '抄送

If sServer <> "" Then MyMail.Server(sServer)
'发送的是纯文本邮件,默认为HTML邮件
MyMail.IsHTML(False)

'组件测试
MyMail.Check sFrom,sFromName,sTo,sSubject,sBody

'发送邮件
'sReturn = MyMail.Send(sFrom,sFromname,sTo,sSubject,sBody)
'释放class占用的资源
MyMail.Close


'If sReutrn = True Then
' Response.Write("
呵呵,邮件发送成功啦!
")
'Else
' Response.Write(sReturn)
'End If
Response.End
Else
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.Mappath("attachment.mdb")
strSQL = "SELECT * FROM [attachment] WHERE id=" & intID

Set objConn = CreateObject("Adodb.Connection")
objConn.Open strConn

Set objRS = objConn.Execute(strSQL)

sFrom = objRS("From")
sFromname = objRS("Fromname")
sSubject = objRS("subject")
sBody = objRS("body")
sTo = objRS("to")
sAddFile = objRS("filenames")
sBCC = objRS("bcc")
sCC = objRS("cc")
sServer = objRS("server")
sUsername = objRS("username")
sPa

ssword = objRS("password")
bSMTPCheck = objRS("smtpcheck")

'去除附件表中的相应附件记录
strSQL = "DELETE FROM [attachment] WHERE id=" & intID
On Error Resume Next
Set objRS = objConn.Execute(strSQL)
If err.Number <> 0 Then
On Error Goto 0
End If

Session("Attachment_ID") = ""
Session.Abandon

objConn.Close
Set objConn = Nothing

'创建邮件Class
Set MyMail = New SWEmail

'自已设定邮件组件创建字符串
'MyMail.SetObject("CDONTS.NewMail")
'MyMail.SetObject("JMail.Message")
'MyMail.SetObject("JMail.SmtpMail")

If sBCC <> "" Then MyMail.BCC(sBCC) '密送
If sCC <> "" Then https://www.doczj.com/doc/f3509139.html,(sCC) '抄送

MyMail.AddFile(Replace(sAddFile,",","$")) '添加附件

If sServer <> "" Then MyMail.Server(sServer)

'发送的是纯文本邮件,默认为HTML邮件
MyMail.IsHTML(False)

'组件测试
MyMail.Check sFrom,sFromName,sTo,sSubject,sBody

'发送邮件
'sReturn = MyMail.Send(sFrom,sFromname,sTo,sSubject,sBody)
'释放class占用的资源
MyMail.Close

'If sReutrn = True Then
' Response.Write("
呵呵,邮件发送成功啦!
")
'Else
' Response.Write(sReturn)
'End If

'删除服务器上的附件
sAttachmentPath = Server.Mappath("AttachmentFiles\")
If Instr(sAddFile,",") <> 0 Then
aryTemp = Split(sAddFile,",")
For i = LBound(aryTemp) To UBound(aryTemp)
Call DelFiles(sAttachmentPath & "\" & aryTemp(i))
Next
Else
If Trim(sAddFile) <> "" Then
Call DelFiles(sAttachmentPath & "\" & sAddFile)
End If
End If

Response.End
End If

ElseIf sAction = "附件" Then

sServer = Trim(Request.Form("smtpserver"))
bSMTPCheck= Trim(Request.Form("smtpcheck"))
If (bSMTPCheck = "True") or (bSMTPCheck=True) Then
bSMTPCheck = True
Else
bSMTPCheck = False
End If
sSubject = Trim(Request.Form("subject"))
sUsername = Trim(Request.Form("username"))
sPassword = TriM(Request.Form("password"))
sBody = Trim(Request.Form("body"))
sFrom = Trim(Request.Form("from"))
sFromName = Trim(Request.Form("fromname"))
sTo = Trim(Request.Form("to"))
sBCC = Trim(Request.Form("BCC"))
sCC = Trim(Request.Form("CC"))

strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.Mappath("attachment.mdb")

Set objConn = CreateObject("Adodb.Connection")
objConn.Open strConn
Set objRS = CreateObject("Adodb.RecordSet")

If Session("Attachment_ID") <> "" Then
strSQL = "SELECT * FROM [attachment] WHERE id=" & Session("Attachment_ID")

objRS.Open strSQL,objConn,1,2
Else
strS

QL = "SELECT * FROM [attachment]"

objRS.Open strSQL,objConn,1,2
objRS.Addnew
End If

objRS("SmtpCheck") = bSMTPCheck
objRS("username") = sUsername
objRS("password") = sPassword
objRS("Server") = sServer
objRS("Subject") = sSubject
objRS("body") = sBody
objRS("from") = sFrom
objRS("fromname") = sFromname
objRS("bcc") = sBCC
objRS("cc") = sCC
objRS("to") = sTo
objRS.Update

Session("Attachment_ID") = objRS("id")

objRS.Close
Set objRS = Nothing
objConn.Close
Set objConn = Nothing

Response.Redirect "upload.asp"

Else
strID = Trim(Session("Attachment_ID"))

If strID <> "" Then
' strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.Mappath("attachment.mdb")
strConn = "Driver={Microsoft Access Driver (*.mdb)};DBQ=" & Server.Mappath("attachment.mdb")

strSQL = "SELECT * FROM [attachment] WHERE id=" & strID

Set objConn = Server.CreateObject("Adodb.Connection")
objConn.Open strConn

On Error Resume Next
Set objRS = objConn.Execute(strSQL)
If err.Number <> 0 Then
On Error Goto 0
Response.Write("找不到相应的附件,程序将终止运行!")
Response.End
Else
sServer = objRS("server")
bSMTPCheck = objRS("SMTPCheck")
sSubject = objRS("Subject")
sBody = objRS("body")
sFrom = objRS("from")
sFromname = objRS("fromname")
sTo = objRS("to")
sBCC = objRS("bcc")
sCC = objRS("cc")
sUsername = objRS("username")
sPassword = objRS("password")
sAddFile = objRS("filenames")
End If
objConn.Close
Set objConn = Nothing
End If
%>


发送






邮件服务器



组件


SMTP验证:
<%If bSMTPCheck Then%>

<%Else%>

<%End If%>


用户名:


密 码:


收信人地址


发信人地址

t type="text" name="from" value="<%=sFrom%>">


发信人姓名


抄 送


密 送


主 题


附 件:


内 容









<%End If%>
[Ctrl+A 全部选择 然后拷贝]

inc_clsEmail.asp文件,主要实现了邮件发送的全过程。此类有如下几种方法:a)check,主要是检测服务器支持哪些发信组件,并且发送一封邮件,看看能否成功发送;b)mailerr,主要是返回发送邮件过程中的错误信息;c)server,设置SMTP服务器的地址;d)send,发送邮件;e)BCC,密送邮件;f)CC,抄送邮件;g)addfile,添加附件,可添加多个附件;h)close,释放数据。

inc_clsEmail.asp的代码:
<%Option Explicit
'#########声明变量########

'以下定义邮件组件类型常量
Private Const SWEmail_JMail43 = 0
Private Const SWEmail_JMail = 1
Private Const SWEmail_ASPEMail = 2
Private Const SWEmail_ASPMail = 3
Private Const SWEmail_EasyWebmail = 4
Private Const SWEmail_CMailServer = 5
Private Const SWEmail_CDO = 6

'本类支持的组件数,由于数组的下标是从0开始的,所以实际是支持7个组件
Private Const SWEmail_intMailobjects = 6

'邮件组件数组
ReDim SWEmail_aryMailObject(SWEmail_intMailobjects,2)
'JMail 4.3
SWEmail_aryMailObject(0,0) = "JMail.Message" '创建组件的字符串,此字符串固定
SWEmail_aryMailObject(0,1) = SWEmail_JMail43 '组件的类型,自定义

'JMail 早期版本
SWEmail_aryMailObject(1,0) = "JMail.SmtpMail"
SWEmail_aryMailObject(1,1) = SWEmail_JMail

'ASP EMail
SWEmail_aryMailObject(2,0) = "Persits.MailSender"
SWEmail_aryMailObject(2,1) = SWEmail_ASPEMail

'ASP Mail
SWEmail_aryMailObject(3,0) = "smtpsvg.mailer"
SWEmail_aryMailObject(3,1) = SWEmail_ASPMail

'Easy Web Mail
SWEmail_aryMailObject(4,0) = "easymail.MailSEnd"
SWEmail_aryMailObject(4,1) = SWEmail_EasyWebmail

'CMail Server
SWEmail_aryMailObject(5,0) = "CMailCOM.SMTP.1"
SWEmail_aryMailObject(5,1) = SWEmail_CMailServer

'微软自带的组件
SWEmail_aryMailObject(6,0) = "CDONTS.NewMail"
SWEmail_aryMailObject(6,1) = SWEmail_CDO


'记录邮件组件创建字符串
Private SWEmail_strMailObject
'邮件组件的类型
Private SWEmail_intMailType
'邮件组件的名称(描述)
Private strMailName
'

邮件附件信息
Private SWEmail_strFiles

Private SWEmail_strFrom '发件人Email地址
Private SWEmail_strFromName '发件人姓名
Private SWEmail_strTo '收件人Email地址
Private SWEmail_strSubject '邮件主题
Private SWEmail_strBody '邮件内容

Private SWEmail_strBCC '密送人Email地址
Private SWEmail_strCC '抄送人Email地址

Private SWEmail_strSMTPServer '邮件服务器地址
Private SWEmail_intSpeed '邮件等级
Private SWEmail_blnIsHTML '是否HTML邮件,True为HTML邮件,FASLE为纯文本邮件
Private SWEmail_strUserName '身份验证时输入的用户名
Private SWEmail_strPassword '身份验证时输入的密码
Private SWEmail_strAttachmentPath '附件路径
Private SWEmail_strError '错误信息
'#########声明结束########


'#########数据初始化########

'默认为普通
SWEmail_intSpeed = 1

'默认为HTML邮件
SWEmail_blnIsHTML = True

'设置默认发件服务器地址
'SWEmail_strSMTPServr = "https://www.doczj.com/doc/f3509139.html,"

'设置默认组件字符串
'SWEmail_strMailObject = "JMail.Message"

'设置附件文件的路径
SWEmail_strAttachmentPath = Server.Mappath("attachmentfiles\")

'#########初始化结束########

Class SWEmail
'检测服务支持的邮件组件
Sub Check(sFrom,sFromName,sTo,sSubject,sBody)
Dim i,objTest,sReturn
Response.Write("

" & vbcrlf)
Response.Write(" " & vbcrlf)
Response.Write(" " & vbcrlf & " " & vbcrlf & " " & vbcrlf)
Response.Write(" " & vbcrlf)
For i = 0 To SWEmail_intMailobjects
On Error Resume Next
Set objTest = CreateObject(CStr(SWEmail_aryMailObject(i,0)))
Response.Write(" " & vbcrlf)
Response.Write(" " & vbcrlf)
If err.Number <> 0 Then '查看错误原因
On Error Goto 0
Response.Write( " " & vbcrlf)
Response.Write( " " & vbcrlf)
Else
SWEmail_strMailObject = SWEmail_aryMailObject(i,0)
SWEmail_intMailType = SWEmail_aryMailObject(i,1)
Response.Write( " " & vbcrlf)
sReturn = Send(sFrom,sFromName,sTo,sSubject,sBody)
If (sReturn = True) Then
Response.Write(" " & vbcrlf)
Else
If sReturn = False Then
Response.Write(" " & vbcrlf)
Else
Response.Write(" " & vbcrlf

)
End If
End If
End If
Response.Write("

" & vbcrlf)
Next
Response.Write("
NameEnableIsSent
" & SWEmail_aryMailObject(i,0) & "NoNoYesSuccessFailed" & sReturn & "
" & vbcrlf)
End Sub

'自动检测服务器支持的组件并设置,如果成功返回True,否则返回False
Function AutoSet()
Dim i,objTest

'没检测到发送邮件的组件
AutoSet = False

SWEmail_strMailObject = ""
SWEmail_intMailType = ""
For i = 0 To SWEmail_intMailobjects
On Error Resume Next
Set objTest = CreateObject(SWEmail_aryMailObject(i,0))
If err.Number = 0 Then
'只要检测到就退出,不继续检测!
AutoSet = True
SWEmail_strMailObject = SWEmail_aryMailObject(i,0)
SWEmail_intMailType = SWEmail_aryMailObject(i,1)
Exit Function
End If
Next
Set objTest = Nothing
End Function

Function MailErr()
MailErr = SWEmail_strError
End Function

'邮件等级设置
Sub Speed(str)
'0:最慢,1:默认,2,最快
If Trim(str) = "" Then
str = 1
Else
str = CInt(str)
End If

Select Case SWEmail_intMailType
Case SWEmail_JMail43
If str = 0 Then
SWEmail_intSpeed = 5
ElseIf str = 1 Then
SWEmail_intSpeed = 3
ElseIf str = 2 Then
SWEmail_intSpeed = 1
Else
SWEmail_intSpeed = 3
End If
Case SWEmail_JMail
If str = 0 Then
SWEmail_intSpeed = 5
ElseIf str = 1 Then
SWEmail_intSpeed = 3
ElseIf str = 2 Then
SWEmail_intSpeed = 1
Else
SWEmail_intSpeed = 3
End If
Case SWEmail_CDO
SWEmail_intSpeed = str
End Select
End Sub

'是否发送HTML邮件
Sub IsHTML(bln)
SWEmail_blnIsHTML = bln
End Sub

'SMTP服务器地址
Sub Server(str)
SWEmail_strSMTPServer = str
End Sub

'发信
Function Send(from,fromname,go,subject,body)
Dim sReturn
'发信人的Email地址
SWEmail_strFrom = from
'发信人的名字
SWEmail_strFromName = fromname
'收信人Email地址
SWEmail_strTo = go
'邮件主题
SWEmail_strSubject = subject
'邮件内容
SWEmail_strBody = body

sReturn = Execute()
If sReturn = True Then
Send = True
Else
Send = sReturn
End If
End Function

'密送
Sub BCC(str)
SWEmail_strBCC = str
End Sub

'抄送
Sub CC(str)
SWEmail_strCC = str
End Sub

'添加附件
Sub AddFile(str)
SWEmail_strFiles = str
End Sub

'SMTP验证,只有JMail组件可用
Sub SMTPCheck(username,password)
SWEmail_strUsername = username
SWEmail_strPassword = password
End Sub

'设置邮件组件对象
Sub SetObject(str)
Dim i
For i = 0 To SWEmail_intMailObj

ects
If SWEmail_aryMailObject(i,0) = str Then
SWEmail_strMailObject = str
SWEmail_intMailType = SWEmail_aryMailObject(i,1)
Exit For
End If
Next
End Sub

'发送邮件主体
Function Execute()
Dim i,sFilePath,strFileName,strTemp,aryTemp,intUpLimit
Dim objMail

If Trim(SWEmail_strMailObject) = "" Then
Execute = "It can't create a null string object."
Exit Function
End If

'On Error Resume Next

Set objMail = CreateObject(SWEmail_strMailObject)
If Err.Number <> 0 Then
Execute = "Can't create object " & SWEmail_strMailObject & "."
Exit Function
End If

Select Case SWEmail_intMailType
Case SWEmail_JMail43 'Jmail4.3 发信主体
'屏蔽例外错误
objMail.Silent = True
'启用邮件日志
'objMail.logging = True
objMail.Charset = "GB2312"
objMail.AddRecipient SWEmail_strTo
objMail.AddRecipientBCC SWEmail_strBCC
objMail.AddRecipientCC SWEmail_strCC
objMail.From = SWEmail_strFrom
objMail.MailServerUserName = SWEmail_strUserName
objMail.MailServerPassword = SWEmail_strPassword
objMail.Subject = SWEmail_strSubject
If SWEmail_blnIsHTML = True Then
objMail.ContentType = "text/html"
objMail.HtmlBody = SWEmail_strBody
Else
objMail.Body = SWEmail_strBody
End If
objMail.Priority = SWEmail_intSpeed

'发送附件
If Trim(SWEmail_strFiles) <> "" Then
If Instr(SWEmail_strFiles,"$") <> 0 Then
aryTemp = Split(SWEmail_strFiles,"$")
intUpLimit = UBound(aryTemp)
For i = LBound(aryTemp) To intUpLimit
strFileName = Trim(aryTemp(i))
If strFileName <> "" Then
objMail.AddAttachment (SWEmail_strAttachmentPath & "\" & strFileName)
End If
Next
Else
objMail.AddAttachment (SWEmail_strAttachmentPath & "\" & SWEmail_strFiles)
End If
End If

objMail.Send(SWEmail_strSMTPServer)
objMail.Close()
Case SWEmail_JMail
'Jmail早期版本发信主体
objMail.Silent = True
objMail.logging = True
objMail.Charset = "GB2312"
objMail.ContentType = "text/html"
objMail.ServerAddress = SWEmail_strSMTPServer
objMail.AddRecipient SWEmail_strTo
objMail.AddRecipientBCC SWEmail_strBCC
objMail.AddRecipientCC SWEmail_strCC
objMail.SenderName = SWEmail_strFromName
objMail.Sender = SWEmail_strFrom
objMail.Priority = SWEmail_intSpeed
objMail.Subject = SWEmail_strSubject
objMail.Body = SWEmail_strBody

'发送附件
If Trim(SWEmail_strFiles) <> "" Then
If Instr(SWE

mail_strFiles,"$") <> 0 Then
aryTemp = Split(SWEmail_strFiles,"$")
intUpLimit = UBound(aryTemp)
For i = LBound(aryTemp) To intUpLimit
strFileName = Trim(aryTemp(i))
If strFileName <> "" Then
objMail.AddAttachment (SWEmail_strAttachmentPath & "\" & strFileName)
End If
Next
Else
objMail.AddAttachment (SWEmail_strAttachmentPath & "\" & SWEmail_strFiles)
End If
End If

objMail.Execute()
objMail.Close
Case SWEmail_ASPEMail
'ASPMail组件
If Trim(SWEmail_strServer) <> "" Then objMail.Host = SWEmail_strServer
If Trim(SWEmail_strBCC) <> "" Then objMail.AddBcc SWEmail_strBCC
If Trim(SWEmail_strUsername) <>"" Then https://www.doczj.com/doc/f3509139.html,ername = SWEmail_strUsername
If Trim(SWEmail_strPassword) <>"" Then objMail.Password = SWEmail_strPassword
objMail.Subject = SWEmail_strSubject
objMail.From = SWEmail_strFrom
objMail.Body = SWEmail_strBody
objMail.AddAddress SWEmail_strTo
objMail.IsHTML = SWEmail_blnIsHTML
objMail.CharSet = "gb2312"
objMail.Priority = SWEmain_intSpeed

'发送附件
If Trim(SWEmail_strFiles) <> "" Then
If Instr(SWEmail_strFiles,"$") <> 0 Then
aryTemp = Split(SWEmail_strFiles,"$")
intUpLimit = UBound(aryTemp)
For i = LBound(aryTemp) To intUpLimit
strFileName = Trim(aryTemp(i))
If strFileName <> "" Then
objMail.AddAttachment (SWEmail_strAttachmentPath & "\" & strFileName)
End If
Next
Else
objMail.AddAttachment (SWEmail_strAttachmentPath & "\" & SWEmail_strFiles)
End If
End If
Case SWEmail_ASPMail
objMail.CusTomCharSet = "gb2312"
objMail.FromAddress = FromMail
objMail.FromName = FromName
objMail.AddRecipient ToMail, ToMail
If ToMailbcc <> "" Then objMail.AddBCC ToMailbcc, ToMailbcc
objMail.Subject = MailSubject
If MailFormat = "html" Then
objMail.ContentType = "text/html"
objMail.BodyText = MailBody
Else
objMail.BodyText = MailBody
End If

'发送附件
If Trim(SWEmail_strFiles) <> "" Then
If Instr(SWEmail_strFiles,"$") <> 0 Then
aryTemp = Split(SWEmail_strFiles,"$")
intUpLimit = UBound(aryTemp)
objMail.ClearAttachments
For i = LBound(aryTemp) To intUpLimit
strFileName = Trim(aryTemp(i))
If strFileName <> "" Then
objMail.AddAttachment (SWEmail_strAttachmentPath & "\" & strFileName)
End If
Next
Else

objMail.AddAttachment (SWEmail_strAttachmentPath & "\" & SWEmail_strFiles)
End If
End If

objMail.Priority = SWEmail_intSpeed
objMail.RemoteHost = SWEmail_strServer
objMail.Timeout = 9999
objMail.SendMail
SWEmail_strError = objMail.Response
Case SWEmail_EasyWebmail
objMail.CreateNew SWEmail_strFrom, "temp"
objMail.MailName = SWEmail_strFromName
objMail.EM_To = SWEmail_strTo
If Trim(SWEmail_strBCC) <> "" Then objMail.EM_BCC SWEmail_strBCC
objMail.EM_Subject = SWEmail_strSubject
If SWEmail_IsHTML = true Then
objMail.EM_HTML_Text = SWEmail_strBody
https://www.doczj.com/doc/f3509139.html,eRichEditer = true
Else
objMail.EM_Text = SWEmail_strBody
End If

objMail.EM_Priority = SWEmail_intSpeed
'If TimeMail Then objMail.EM_TimerSEnd = webmailtime

'发送附件
If Trim(SWEmail_strFiles) <> "" Then
If Instr(SWEmail_strFiles,"$") <> 0 Then
aryTemp = Split(SWEmail_strFiles,"$")
intUpLimit = UBound(aryTemp)
For i = LBound(aryTemp) To intUpLimit
strFileName = Trim(aryTemp(i))
If strFileName <> "" Then
objMail.AddFromAttFileString = SWEmail_strAttachmentPath & "\" & strFileName
End If
Next
Else
objMail.AddAttFileString = SWEmail_strAttachmentPath & "\" & SWEmail_strFiles
End If
End If

If objMail.Send() = FALSE Then
SWEmail_strError= "有错误发生"
End If
Case SWEmail_CMailServer
objMail.CreateUserPath("ASPMail")
objMail.Subject = SWEmail_strSubject
objMail.Body = SWEmail_strBody
objMail.To = SWEmail_strTo
objMail.From = SWEmail_strFrom
objMail.SendMail
If Left(https://www.doczj.com/doc/f3509139.html,stResponse, 3) <> "+OK" Then
SWEmail_strError = "错误原因:" & https://www.doczj.com/doc/f3509139.html,stResponse
End If
Case SWEmail_CDO
'微软自带发信主体
objMail.Subject = SWEmail_strSubject
objMail.From = SWEmail_strFrom
objMail.To = SWEmail_strTo

If SWEmail_blnIsHTML Then
objMail.BodyFormat = 0 '支持HTML
Else
objMail.BodyFormat = 1 '支持纯文本
End If

'0 表示将采用 MIME 格式
'1 表示将采用连续的纯文本(默认值)
'objMail.MailFormat = 0

objMail.Body = SWEmail_strBody

'发送附件
If Trim(SWEmail_strFiles) <> "" Then
If Instr(SWEmail_strFiles,"$") <> 0 Then
aryTemp = Split(SWEmail_strFiles,"$")
intUpLimit = UBound(aryTemp)
For i = LB

ound(aryTemp) To intUpLimit
strFileName = Trim(aryTemp(i))
If strFileName <> "" Then
objMail.AttachFile (SWEmail_strAttachmentPath & "\" & strFileName)
End If
Next
Else
objMail.AttachFile (SWEmail_strAttachmentPath & "\" & SWEmail_strFiles)
End If
End If
objMail.Send
End Select
If Err.Number <> 0 Then
If Trim(err.Description) <> "" Then Execute = Err.Description & "
"
Else
Execute = True
End If
Set objMail = Nothing
End Function

'清空内容
Sub Close()
SWEmail_strMailObject = ""
SWEmail_intMailType = ""
strMailName = ""
SWEmail_strFiles = ""

SWEmail_intSpeed = ""
'释放数组
Erase SWEmail_aryMailObject
End Sub
End Class
%>
[Ctrl+A 全部选择 然后拷贝]

upload.asp的源码:
<%
If Trim(Request.ServerVariables("HTTP_REFERER"))="" Then
'Response.Write(Request.ServerVariables("HTTP_REFERER"))
'Response.End
Response.Redirect "mail.asp"
Response.End
End If
%>



文件上传











 



















文件上传


  • 需要上传的个数



  • 文件1:
      










    [Ctrl+A 全部选择 然后拷贝]

    uploadok.asp的源码:
    <%Option Explicit
    Response.Expires = 0
    %>

    <%
    Private Function FormatStr(str)
    str = Trim(BinToStr(str))
    str = Replace(str,"'","''")
    str = Replace(str,vbcrlf,"")
    FormatStr = str
    End Function

    '设置文件上传路径,此目录必须存在,否则会出错
    Private Const svrUploadFilePath = "attachmentfiles"

    Dim strNewName,sNewname,strSQL,strNoPic,strInfo,strFileName,strFilePath
    Dim intFormSize,intFileCount,I
    Dim binFormData,binTextData,binFileData
    Dim aryFileName
    Dim objUpload

    '获取表单数据的大小
    intFormSize = Request.TotalBytes

    '获取所有的表单数据
    binFormData = Request.BinaryRead(intFormSize)
    '创建上传类
    Set objUpload = New Upload

    '初始化表单提交的数据中
    objUpload.Init(binFormData)

    '清空数据
    binFormData = ""
    strInfo = ""

    intFileCount = objUpload.FileCount

    '设置上传文件存放的路径
    objUpload.SetPath(svrUploadFilePath)

    '获取上传文件的存放路径
    'strFilePath = objUpload.GetPath

    '设置允许上传的文件格式,多种格式以|分隔
    objUpload.AllowFiles ("zip|rar|jpg|png|bmp|txt|htm|html")

    '获取默认文件名列表
    strFileName = objUpload.FileName
    aryFileName = Split(strFileName,",")

    If intFileCount > 1 Then
    For i = 1 To intFileCount
    sNewname = objUpload.FormName("filename" & i)
    If sNewname = "" Then sNewname = aryFileName(i-1)
    If strNewname = "" Then
    strNewname = strNewname & sNewname
    Else
    strNewname = strNewname & "," & sNewname
    End If
    Next
    Else
    strNewname = objUpload.FormName("filename1")
    End If

    '清空文本内容
    binTextData = ""
    Dim strAttachmentFiles

    If strInfo = "" Then
    If strNewName = "" Then strNewName = strFileName
    If objUpload.FileExist(strNewName) Then'如果文件不存在,则保存文件
    If objUpload.SaveFile(strNewName) Then
    strAttachmentFiles = strAttachmentFiles & strNewName & ","
    ' strInfo = strInfo & objUpload.ErrorInfo
    ' Else
    ' strInfo = strInfo & objUpload.E

    rrorInfo
    End If
    ' Else
    ' strInfo = strInfo & objUpload.ErrorInfo
    End If
    End If

    Dim oConn,oRS,sConn

    strSQL = "UPDATE [attachment] SET filenames='" & Left(strAttachmentFiles,Len(strAttachmentFiles)-1) & "' WHERE id=" & Session("Attachment_ID")


    sConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.Mappath("attachment.mdb")
    ' sConn = "Driver={Microsoft Access Driver (*.mdb)};DBQ=" & Server.Mappath("attachment.mdb")
    Set oConn = CreateObject("Adodb.Connection")

    oConn.Open sConn
    Set oRS = oConn.Execute(strSQL)
    Set oConn = Nothing
    Response.Redirect "mail.asp"
    Response.End
    %>
    [Ctrl+A 全部选择 然后拷贝]

    inc_clsUpload.asp的源码:
    <%
    '*****************************************
    ' 目的: 将Binary字符转成String。
    ' 输入: str: 需要转换Binary。
    ' 返回: 转换后的String,并把string中的'替换成'',换行符去掉。
    '*****************************************
    Private Function BinToStr(str)
    Dim i,strTemp
    strTemp = ""
    For i=1 To LenB(str)
    If AscB(MidB(str, i, 1)) > 127 Then
    strTemp = strTemp & Chr(Ascb(MidB(str, i, 1))*256+Ascb(MidB(str, i+1, 1)))
    i = i + 1
    Else
    strTemp = strTemp & Chr(AscB(MidB(str, i, 1)))
    End If
    Next
    strTemp = Replace(Replace(Trim(strTemp),"'","''"),VBCRLF,"")
    BinToStr=strTemp
    End Function

    '*****************************************
    ' 目的: 将String转成Binary。
    ' 输入: str: 需要转换的String。
    ' 返回: 转换后的二进制字符串。
    '*****************************************
    Private Function StrToBin(str)
    Dim i, binTemp
    For i = 1 To Len(str)
    binTemp = binTemp & ChrB(Asc(Mid(str,I,1)))
    Next
    StrToBin = binTemp
    End Function

    Class Upload
    '文件名、文件路径、错误信息、文件信息、允许上传的文件后缀名
    Dim strFileName,strFilePath,strErrorInfo,strFileInfo,strAllowed
    '文件开始位置、文件大小、文件个数
    Dim intFileStart,intFileSize,intFileCount
    'AdoStream对象objData和Dictionary对象objFiles
    Dim objData,objFiles
    '二进制数据
    Dim binTxtData

    '以上变量均为Class级变量,可在此Class的所有过程函数中使用

    '*****************************************
    ' 目的: 将文件与文本数据分离,保存文件到Dictionary对象
    ' 输入: formdata: 为表单提交的所有数据
    ' 返回: 无
    '*****************************************
    Sub Init(formdata)
    Dim BnCrlf,binName,binFileName,binQuotation,binSpace,binFileContent
    Dim sStart,sInfo,sFileName,sFormName,sFormValue
    Dim iStart,iFormStart,iFormEnd,iInfoStart,iInfoEnd,iFindStart,iFi

    ndEnd,iValStart,iValEnd,iFileName

    Set objFiles = Server.CreateObject("Scripting.Dictionary")
    Set objData = Server.CreateObject("Adodb.Stream")
    objData.Type = 1
    objData.Mode = 3
    objData.Open
    objData.Write formdata

    BnCrlf = ChrB(13) & ChrB(10)
    binName = StrToBin("name=""")
    binFileName = StrToBin("filename=""")
    binQuotation = StrToBin("""")
    binSpace = StrToBin(" ")
    intFileCount = 0 '文件个数清零

    iFormEnd = LenB(formdata)
    iFormStart = 1
    '-----------------------------7d320717017a
    sStart = MidB(formdata,1,InStrB(1,formdata,bnCrlf)-1)

    iStart = LenB(sStart)
    iFormStart = iFormStart+iStart+1
    While iFormStart + 10 < iFormEnd
    iInfoEnd = InStrB(iFormStart,formdata,BnCrlf&BnCrlf)+1
    sInfo = MidB(formdata,iFormStart,iInfoEnd-iFormStart)

    'Find form name
    iFormStart = InStrB(iInfoEnd,formdata,sStart)
    iFindStart = InStrB(11,sInfo,binName,1)
    iFindEnd = InStrB(iFindStart+6,sInfo,binQuotation,1)

    sFormName = MidB(sInfo,iFindStart,iFindEnd-iFindStart)
    '取得表单值起始位置
    iValStart = iInfoEnd + 1
    '如果是文件
    If InStrB (22,sInfo,binFileName,0) > 0 Then
    '取得文件名
    iFindStart = InStrB(iFindEnd,sInfo,binFileName,0) + 10
    iFindEnd = InStrB(iFindStart,sInfo,binQuotation,1)
    sFileName = MidB(sInfo,iFindStart,iFindEnd-iFindStart)
    sFileName = BinToStr(sFileName)
    iFileName = InstrRev(sFileName,"\",-1) + 1
    sFileName = Mid(sFileName,iFileName,Len(sFileName)-iFileName + 1)
    If Trim(strFileName) <> "" Then
    strFileName = strFileName & "," & sFileName
    Else
    strFileName = sFileName
    End If
    '文件开始位置
    intFileStart = iInfoEnd
    '文件大小
    intFileSize = iFormStart -iInfoEnd
    '文件内容
    'binFileContent = MidB(formdata,intFileStart,intFileSize)

    '添加文件,以文件名为关键字
    If Not objFiles.Exists(sFileName) Then
    objFiles.Add sFileName,intFileStart & "," & intFileSize
    Else
    strErrorInfo = strErrorInfo & "
    文件 " & sFileName & " 已经存在!"
    Exit Sub
    End If

    '统计文件个数
    intFileCount = intFileCount + 1
    Else '如果是表单项目
    iValEnd = iFormStart-iInfoEnd-3
    If iValEnd> 0 Then
    sFormValue = MidB(formdata,iValStart,iValEnd)
    Else
    sFormValue = ""
    End If
    binTxtData = binTxtData & sFormname & StrToBin(":") & sFormValue & StrToBin("""")

    End If
    iFormStart=iFormStart + iStart + 1
    Wend
    formdata=""
    End Sub

    '*****************************************
    ' 目的: 限制文件上传的类型,只能许sAllow格式的文件
    ' 输入: strLimit,允许上传的文件格式,多种格式用|分开
    '
    ' 返回: 允许上传的文件格式(多种格式用|分开)
    '*****************************************
    Sub AllowFiles(sAllow)
    strAllowed = sAllow
    End Sub

    '*****************************************
    ' 目的: 检查文件后缀是否为被允许的文件格式
    ' 输入: filename
    '
    ' 返回: 如果是允许的文件格式返回True,否则返回False
    '*****************************************
    Function IsAllowed(filename)
    Dim intStart
    IsAllowed = False
    If strAllowed = "" Then
    IsAllowed = True
    Else
    filename=Trim(filename)
    If Trim(filename) <> "" Then
    intStart = InstrRev(filename,".")
    If intStart > 0 Then
    If Instr(strAllowed,Mid(filename,intStart+1,Len(filename)-intStart))>0 Then
    IsAllowed = True
    End If
    End IF
    End If
    End If
    End Function

    '*****************************************
    ' 目的: 统计文件个数
    ' 输入: 无
    ' 返回: 返回上传的文件个数
    ' 说明: intFileCount是一个Class级变量,在本Class内有效
    ' 在函数PickData过程中,统计文件个数
    '*****************************************
    Function FileCount()
    FileCount = intFileCount
    End Function

    '*****************************************
    ' 目的: 将二进制数据写入文件
    ' 输入: FileName: 文件名
    ' 返回: 保存成功返回TRUE,失败则返回错误信息
    '*****************************************
    Function SaveFile(filename)
    Dim i,iFileCount
    Dim objSaveFile
    Dim sFileName,sNewpath,binFileCount
    Dim aryFileName,aryNewName,aryFileInfo
    SaveFile = True
    Set objSaveFile = Server.CreateObject("Adodb.Stream")
    objSaveFile.Mode=3 '3表示adModeReadWrite
    objSaveFile.Type=1 '1表示adTypeBinary
    objSaveFile.Open()
    'On Error Resume Next

    If Trim(filename) = "" Then filename = strFileName
    If Instr(filename,",")>0 Then
    '多文件
    aryFileName = Split(strFileName,",")
    aryNewname = Split(filename,",")
    For i =LBound(aryNewName) To UBound(aryNewName)
    sFileName = aryFileName(i)
    If IsAllowed(sFileName) Then '是否为允许的文件格式
    objSaveFile.Position = 0
    aryFileInfo =

    Split(objFiles.Item(sFileName),",")
    'objSaveFile.Write objFiles.Item(sFileName)
    objData.Position = aryFileInfo(0) + 2
    objData.CopyTo objSaveFile,aryFileInfo(1)
    sNewPath = Server.Mappath(strfilepath&sFileName)
    ' strFileInfo = strFileInfo & FileName & "
    "
    strErrorInfo = strErrorInfo & "
    文件 " & sFileName & "上传成功"
    '存成文件,2表示adSaveCreateOverWrite
    objSaveFile.SaveToFile sNewPath,2
    Else
    strErrorInfo = strErrorInfo & "
    文件 " & sFileName & " 为不被允许上传的文件,请检查文件后缀
    "
    SaveFile = False
    'Exit Function
    End If
    Next
    Else
    '单文件
    If IsAllowed(strFileName) Then '是否为允许的文件格式
    aryFileInfo = Split(objFiles.Item(strFileName),",")
    objData.Position = aryFileInfo(0) + 2
    objData.CopyTo objSaveFile,aryFileInfo(1)
    sNewPath = Server.Mappath(strFilePath&FileName)
    ' strFileInfo = strFileInfo & FileName & "
    "
    strErrorInfo = strErrorInfo & "
    文件 " & FileName & ""
    objSaveFile.SaveToFile sNewPath,2
    Else
    strErrorInfo = strErrorInfo & "
    文件 " & sFileName & " 为不被允许上传的文件,请检查文件后缀!"
    SaveFile = False
    'Exit Function
    End If
    End If

    objSaveFile.Close
    Set objSaveFile = Nothing
    objData.Close
    Set objData = Nothing
    Set objFiles = Nothing
    'If err.Number <> 0 Then SaveFile = False
    End Function

    '*****************************************
    ' 目的: 获取表单项的值
    ' 输入: name: 为要寻找的字段变量
    ' txtdata: 为已从图象中分离出来的的所有文本
    ' 返回: 表单项的值
    '*****************************************
    Function FindInput(fName,txtdata)
    Dim intStartPos,intEndPos,intNameLen,intValEnd,i,bReturn
    intStartPos = 1
    intNameLen = LenB(StrToBin("name=""" & fName & ":"))
    intStartPos = InstrB(intStartPos,txtdata,fName,1) + intNameLen
    If intStartPos > intNameLen Then
    intEndPos = InstrB(intStartPos-3,txtdata,StrToBin(""""))
    bReturn = bReturn & MidB(txtdata,intStartPos,intEndPos-intStartPos)
    intValEnd = intEndPos
    '表单中可能有多个同名变量(用在有主表与明细表中的数据更新中)
    Do
    intStartPos = Instr(intValEnd,txtdata,fName) + intNameLen
    If intStartPos > intNameLen Then
    intValEnd = Instr(intStartPos,txtdata,"""")
    bReturn = bReturn & "," & Mid(intStartPos,txt

    data,intEndPos-intStartPos)
    End If
    Loop While (intStartPos > intNameLen)
    End If
    FindInput = bReturn
    End Function

    '*****************************************
    ' 目的: 检测文件是否存在
    ' 输入: filename: 文件名
    ' 返回: 文件存在返回False,文件不存在返回True
    '*****************************************
    Function FileExist(filename)
    Dim objFSO,objFile
    Dim sPath,sError
    Dim i

    FileExist = False
    If Trim(filename) = "" Then
    strErrorInfo = strErrorInfo & "
    文件名不能为空!"
    Exit Function
    End If
    Set objFSO = Server.CreateObject("Scripting.FileSystemObject")

    If Instr(filename,",")>0 Then
    'Response.Write("
    @" & filename & "@
    ")
    aryFileName = Split(filename,",")
    For i = LBound(aryFileName) To UBound(aryFileName)
    'Response.Write("
    file:" & strFilePath &"#" & aryFileName(i) & "
    ")
    sPath = Server.Mappath(strFilePath & aryFileName(i))
    If objFSO.FileExists(sPath) Then
    sError = sError & "
    文件 " & aryFileName(i) & " 已经存在!"
    End If
    Next
    Else
    sPath = Server.Mappath(strFilePath & filename)
    If objFSO.FileExists(sPath) Then
    sError = sError & "
    文件 " & filename & " 已经存在!"
    End If
    End If
    Set objFSO = Nothing
    If Trim(sError) <> "" Then
    strErrorInfo = strErrorInfo & sError
    Else
    FileExist = True
    End If
    End Function

    '*****************************************
    ' 目的: 获取表单项的值
    ' 输入: name: 为要寻找的字段变量
    ' 返回: 转成普通字符串后的表单项的值
    '*****************************************
    Function FormName(aName)
    Dim binFormName,binTest
    'binTxtData已经分离出来的文件数据
    binFormName = FindInput(aName,binTxtData)
    FormName = BinToStr(binFormName)
    End Function

    '*****************************************
    ' 目的: 设置文件存放路径
    ' 输入: str: 文件存放相对路径
    ' 说明: 将输入的str赋给Class级变量FilePath,记录文件相对路径
    '*****************************************
    Sub SetPath(str)
    strFilePath = str & "\"
    End Sub

    '*****************************************
    ' 目的: 获取文件存放相对路径
    ' 输入: 无
    ' 返回: 返回文件存放相对路径
    '*****************************************
    Function GetPath()
    GetPath = strFilePath
    End Function

    '*****************************************
    ' 目的: 获取错误信息
    ' 输

    入: 无
    ' 返回: 返回错误信息
    '*****************************************
    Function ErrorInfo()
    ErrorInfo = strErrorInfo
    End Function

    '*****************************************
    ' 目的: 获取文件名或文件名列表
    ' 返回: 文件名或文件名列表
    '*****************************************
    Function FileName()
    FileName = strFileName
    End Function
    End Class
    %>
    [Ctrl+A 全部选择 然后拷贝]

    inc_set.asp的源码:
    <%
    Private Const HTMLTitle = "WEB内容管理系统"
    'TOP。htm中行的颜色
    Private Const ClrTopTR = "#D1A798"

    '表格的颜色
    Private Const clrLeftTD = "#B57560"
    Private Const clrRightTD = "#A6624A"
    Private Const clrTitleTR = "#C18B79"
    Private Const clrGeneralTR = "#CEA293"
    Private Const clrBottmTR = "#C18B79"
    %>
    [Ctrl+A 全部选择 然后拷贝]

    四、商业应用中的问题

    优点:1.支持多种发送邮件组件;
    2.支持发送多附件。

    缺点:1.对附件大小没有限制;
    2.如果附件已经存在于服务器上,无法再上传;
    3.对填写的表单信息是否为空,没进行判断;

    五、注意事项

    本程序主要目的是学习,不适合用于商业,因为在使用中还有问题存在,当然你可以对其进行完善再应用到商业上。大家,在使用过程中,如发现问题,可以到论坛问https://www.doczj.com/doc/f3509139.html,/bbs,也可以发email给我cjj8110@https://www.doczj.com/doc/f3509139.html,(也是我的MSN地址)。最后,感谢各位兄弟帮忙测试。Jmail部分代码已测试通过,用CDO发附件,及其它发信组件还没有测试,由于条件有限,只能到此为止了。

    还有一点,在存入程序文件的目录下,需要建一文件夹attachmentfiles(用于存放附件),此文件夹是必须的。



    相关主题
    相关文档 最新文档