ASP发送邮件的CLASS-会员卡,广州印刷,深圳印刷,印刷公司,名片,彩页,名片设计,设计教程,名片制作,彩色名片,名片模板,贵宾卡,pvc卡,设计欣赏,深圳名片,广州名片,business card design

首页	名片设计 CorelDRAW Illustrator AuotoCAD Painter 其他软件 Photoshop Fireworks Flash

» 彩色名片
» PVC卡
» 彩色磁性卡
» 彩页/画册
» 个性印务
» 彩色不干胶
» 明信片
   » 明信片
   » 彩色书签
   » 门挂
» 其他产品与服务
   » 创业锦囊
   » 办公用品
   » 信封、信纸
   » 便签纸、斜面纸砖
   » 无碳复印纸
   » 海报
   » 大篇幅印刷
   » KT板
   » 海报
   » 横幅

ASP发送邮件的CLASS
一. 程序思路

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

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

　　２.发送带附件的邮件。这个过程，主要分三步，一、填写表单信息（同上），不过在点“发送”按钮前，需要转到第二步，发送附件。二、此步聚主要是上传附件到服务器。需要服务器支持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　类型为是／否字段(存放是否需要ＳＭＴＰ验证)
　　　　(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@hotmail.com\\\',cjj\\\',\\\'cjj8110@hotmail.com\\\',\\\'\\\',\\\'\\\',\\\'\\\',\\\'测试\\\',\\\'测试邮件件发送程序\\\',\\\'cjj8110\\\',\\\'********\\\',\\\'1,zip,1.rar\\\')"
\\\'删除表中全部数据。
SQL = "DELETE FROM attachment"
\\\'删除表中指定ＩＤ的记录
SQL = "DELETE FROM attachment WHERE 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 ("<br><font color=""#ff0000"">" & SYS_strTableName & "</font> 表创建成功！<br>")
%>
mail.asp的源码：

<%
Dim sAction,objMail,strID,strConn,strSQL,objConn,objRS
Dim sServer,bSMTPCheck,sSubject,sBody,sFrom,sFromName,sTo,sBCC,sCC,sSMTPCheck,sAddFile,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 MyMail.CC(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("<br>呵呵，邮件发送成功啦！<br>")
\\\'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")
sPassword = 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 MyMail.CC(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("<br>呵呵，邮件发送成功啦！<br>")
\\\'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
strSQL = "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
%>
<html>
<head>
<title>发送</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<script>
function scheck() {
if (form1.smtpcheck.checked)
form1.smtpcheck.value=true
else
form1.smtpcheck.value=false;
}
</script>
</head>

<body bgcolor="#FFFFFF" text="#000000">
<form name="form1" method="post" action="mail.asp">
<p>邮件服务器
<input type="text" name="smtpserver" value="<%=sServer%>">
</p>

<p>组件
<input type="text" name="mailobject">
</p>
<p>ＳＭＴＰ验证：
<%If bSMTPCheck Then%>
<input type="checkbox" name="smtpcheck" value="true" onclick="scheck();" checked>
<%Else%>
<input type="checkbox" name="smtpcheck" value="false" onclick="scheck();">
<%End If%>
</p>
<p>用户名：
<input type="text" name="username" value="<%=sUsername%>">
</p>
<p>密　码：
<input type="text" name="password" value="<%=sPassword%>">
</p>
<p>收信人地址
<input type="text" name="to" value="<%=sTo%>">
</p>
<p>发信人地址
<input type="text" name="from" value="<%=sFrom%>">
</p>
<p>发信人姓名
<input type="text" name="fromname" value="<%=sFromName%>">
</p>
<p>抄　送
<input type="text" name="cc" value="<%=sCC%>">
</p>
<p>密　送
<input type="text" name="bcc" value="<%=sBCC%>">
</p>
<p>主　题
<input type="text" name="subject" value="<%=sSubject%>">
</p>
<p>附　件：
<input type="text" name="addfile" value="<%=sAddFile%>">
</p>
<p>内　容
<textarea name="body" rows="20" cols="100"><%=sBody%>
</textarea>
</p>
<p>
<input type="submit" name="action" value="发送">
<input type="submit" name="action" value="附件">
</p>
</form>
</body>
</html>
<%End If%>
　inc_clsEmail.asp文件，主要实现了邮件发送的全过程。此类有如下几种方式：a)check,主要是检测服务器支持哪些发信组件，并且发送一封邮件，看看能否成功发送；b)mailerr,主要是返回发送邮件过程中的错误信息；c)server,设置ＳＭＴＰ服务器的地址；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 = "SMTP.163.com"

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

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

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

Class SWEmail
\\\'检测服务支持的邮件组件
Sub Check(sFrom,sFromName,sTo,sSubject,sBody)
Dim i,objTest,sReturn
Response.Write("<table border=""0"" cellspacing=""1"" cellpadding=""0"" bgcolor=""#000000"" align=""center"" width=""85%"">" & vbcrlf)
Response.Write(" <tr align=""center"" height=""30"" bgcolor=""#FFFFFF"">" & vbcrlf)
Response.Write(" <td width=""33%"">Name</td>" & vbcrlf & " <td>Enable</td>" & vbcrlf & " <td>IsSent</td>" & vbcrlf)
Response.Write(" </tr>" & vbcrlf)
For i = 0 To SWEmail_intMailobjects
On Error Resume Next
Set objTest = CreateObject(CStr(SWEmail_aryMailObject(i,0)))
Response.Write(" <tr align=""center"" height=""25"" bgcolor=""#FFFFFF"">" & vbcrlf)
Response.Write(" <td>" & SWEmail_aryMailObject(i,0) & "</td>" & vbcrlf)
If err.Number <> 0 Then \\\'查看错误原因
On Error Goto 0
Response.Write( " <td>No</td>" & vbcrlf)
Response.Write( " <td>No</td>" & vbcrlf)
Else
SWEmail_strMailObject = SWEmail_aryMailObject(i,0)
SWEmail_intMailType = SWEmail_aryMailObject(i,1)
Response.Write( " <td>Yes</td>" & vbcrlf)
sReturn = Send(sFrom,sFromName,sTo,sSubject,sBody)
If (sReturn = True) Then
Response.Write(" <td>Success</td>" & vbcrlf)
Else
If sReturn = False Then
Response.Write(" <td>Failed</td>" & vbcrlf)
Else
Response.Write(" <td>" & sReturn & "</td>" & vbcrlf)
End If
End If
End If
Response.Write(" </tr>" & vbcrlf)
Next
Response.Write("</table>" & 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_intMailObjects
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 <font color=""#ff0000"">" & SWEmail_strMailObject & "</font>."
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(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.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 objMail.Username = 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
objMail.useRichEditer = 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(objMail.LastResponse, 3) <> "+OK" Then
SWEmail_strError = "错误原因：" & objMail.LastResponse
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 = LBound(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 & "<br>"
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
%>

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
%>

<html>
<head>
<title>文件上传</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<style type="text/css">

</style>
</head>

<body topmargin="0">
<table border="1">
<tr>
<td>

  <br><form name="form1" method="post" action="uploadok.asp" enctype="multipart/form-data">
<table width="88%" border="0" cellspacing="1" cellpadding="0" align="center">

<tr bgcolor="<%=clrTitleTR%>">
<td height="28" align="center" valign="middle" bgcolor="<%=clrTitleTR%>"><b>文件上传</b></td>
</tr>
<tr align="left" valign="middle" bgcolor="<%=clrGeneralTR%>">
<td height="92">
<script language="javascript">

</script>
<li> 需要上传的个数
<input type="text" name="upcount" class="tx" value="2">
<input type="button" name="Button" class="button" onclick="setid();" value="设置">
</li>
</td>
</tr>
<tr align="center" valign="middle" bgcolor="<%=clrGeneralTR%>">
<td align="left" id="upid" height="122"> 文件1:
<input type="file" name="file1" style="width:200" class="tx1" value="">  
<input type="text" name="filename1" style="width:30" class="tx">
</td>
</tr>
<tr align="center" valign="middle" bgcolor="<%=clrTitleTR%>">
<td height="28" bgcolor="<%=clrTitleTR%>"></td>
</tr>
<tr>
<td>
<input type="submit" name="action" value="上传" class="button">
</td>
</tr>
</table>
</form>

</td>
</tr>
</table>
</body>
</html>
<script language="javascript">

</script>
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.ErrorInfo
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
%>
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,iFindEnd,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 & "<br>文件 <b>" & sFileName & "</b> 已经存在！"
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 & "<Br>"
strErrorInfo = strErrorInfo & "<br>文件 <Font Color=""#FF0000"">" & sFileName & "</Font>上传成功"
\\\'存成文件，2表示adSaveCreateOverWrite
objSaveFile.SaveToFile sNewPath,2
Else
strErrorInfo = strErrorInfo & "<br>文件 <font color=""#ff00000"">" & sFileName & "</font> 为不被答应上传的文件，请检查文件后缀<br>"
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 & "<Br>"
strErrorInfo = strErrorInfo & "<br>文件 <Font Color=""#FF0000"">" & FileName & "</Font>"
objSaveFile.SaveToFile sNewPath,2
Else
strErrorInfo = strErrorInfo & "<br>文件 <Font Color=""#FF0000"">" & sFileName & "</font> 为不被答应上传的文件，请检查文件后缀！"
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

返回类别: 教程
上一教程: VBSCRIPT语言基础知识
下一教程: ASP利用正表达式解析HTML的类代码

您可以阅读与"ASP发送邮件的CLASS"相关的教程:
· 利用CDONTS发送邮件的ASP函数
· ASP用JMAIL、CDO发送邮件
· 使用CDONTS发送邮件的几个例子
· 用ASP发送邮件
· ASP用JMail、CDO发送邮件


	快精灵印艺坊版权所有	首页会员中心在线印刷在线编辑付款方式索取样品设计指南连锁门店网站地图关于我们友情链接