中文字幕二区_国产精品免费在线观看_黄色网站观看_人人草人人澡_日本真实娇小xxxx

一. 程序思路

　　所有的程序，主要實(shí)現(xiàn)兩個功能，一、發(fā)送郵件；二、上傳附件。使用無組件上傳程序來上傳附件到服務(wù)器，在發(fā)送完后，將刪除服務(wù)器上的郵件。實(shí)現(xiàn)這兩個功能，需要一個數(shù)據(jù)庫來存放郵件內(nèi)容及附件信息（文件名）。郵件的發(fā)送有兩種情況：一是，無附件的郵件；二是，有附件的郵件。

　　１.發(fā)送無附件的郵件。用戶根據(jù)實(shí)際情況來填寫收信人、發(fā)信人、抄送、密送、SMTP服務(wù)器地址、郵件主題、郵件內(nèi)容等信息，這些信息中，收信人、發(fā)信人、郵件主題、郵件內(nèi)容是必須填寫的，否則將收不到郵件。如果ＳＭＴＰ服務(wù)器支持ＳＭＴＰ驗(yàn)證，那么你就把你在該郵局的用戶名和密碼填上。如，你填的發(fā)信人地址是xxxx@163.com，因?yàn)椋保叮车模樱停裕蟹��?wù)，支持ＳＭＴＰ驗(yàn)證，所以你就要需要你在１６３的用戶名xxxx，密碼****，這樣才能順利發(fā)送郵件；如，你發(fā)信人地址是xxxx@hotmail.com，因?yàn)閔otmail是不需要ＳＭＴＰ驗(yàn)證的，所以你不用填寫用戶名和密碼。只要記住一點(diǎn)，你的發(fā)信的ＳＭＴＰ服務(wù)器支持ＳＭＴＰ驗(yàn)證的話，你就要填寫相應(yīng)的用戶名和密碼。你在填寫完表單后，點(diǎn)“發(fā)送”按鈕就直接發(fā)送郵件了。這個過程是在mail.asp和inc_clsEmail.asp完成的。

　　２.發(fā)送帶附件的郵件。這個過程，主要分三步，一、填寫表單信息（同上），不過在點(diǎn)“發(fā)送”按鈕前，需要轉(zhuǎn)到第二步，發(fā)送附件。二、此步聚主要是上傳附件到服務(wù)器。需要服務(wù)器支持FSO、Dictionary、Stream等組件。在進(jìn)入上傳附件界面前，先在數(shù)據(jù)庫中創(chuàng)建一條記錄，把剛成填的表單信息存在表里，然后選擇本地需要本地的rar或zip文件，選好后點(diǎn)“上傳”按鈕就行了，傳完后程序?qū)⒏�新�?shù)據(jù)庫中存入附件文件名和字段的內(nèi)容并自動跳轉(zhuǎn)到發(fā)信頁面，發(fā)信頁面從數(shù)據(jù)庫中讀取郵件信息并顯示出來，此時點(diǎn)“發(fā)送”，就將發(fā)送附件了。本過程主要由mail.asp、inc_clsEmail.asp、inc_clsUpload.asp、Upload.asp和Uploadok.asp來完成。

　　在這個發(fā)信程序中用到的文件清單:
　　　　attachment.mdb　　'郵件信息臨時存放庫
　　　　install.asp 　　　'在數(shù)據(jù)庫中創(chuàng)建郵件信息臨時表
　　　　Mail.asp　　　　　'發(fā)送郵件
　　　　Upload.asp　　　　'文件上傳
　　　　Uploadok.asp　　　'文件上傳成功
　　　　inc_clsEmail.asp　'郵件發(fā)送類
　　　　inc_clsUpload.asp '無組件上傳類
　　　　inc_set.asp　　　 '一些表格顏色的設(shè)置

二.建立數(shù)據(jù)庫
　　1.打開你的Access建立一個文件名為:attachment.mdb.添加以下字段:
　　　　(1). ID 　　　　類型為自動編號(存放郵件信息的ID編號)
　　　　(2). smtpcheck　類型為是／否字段(存放是否需要ＳＭＴＰ驗(yàn)證)
　　　　(3). from 　　　類型為文本字段(存放發(fā)信人的Email地址)
　　　　(4). fromname 　類型為文本字段(存放發(fā)信人的名字)
　　　　(5). to 　　　　類型為文本字段(存放收信人的Email地址)
　　　　(6). bcc　　　　類型為文本字段(存放密送人的Email地址)
　　　　(7). cc 　　　　類型為文本字段(存放抄送人的Email地址)
　　　　(8). server 　　類型為文本字段(存放SMTP服務(wù)器地址)
　　　　(9). subject　　類型為文本字段(存放郵件主題)
　　　　(10). body　　　類型為備注字段(存放郵件的內(nèi)容)
　　　　(11). username　類型為文本字段(存放郵箱登錄用戶名)
　　　　(12). password　類型為文本字段(存放郵箱登錄的密碼)
　　　　(13). filenames 類型為文本字段(存放附件的文件名)
　　注意：可以把字段設(shè)置為允許為空。

　　當(dāng)然你可以自己添加你認(rèn)為需要的字段，如果你把字段名或表名換成其它名稱，則對程序也要作出相應(yīng)的更改，不然會出錯。如果你不想手工建表及添加字段，那你可以在瀏覽器中運(yùn)行Install.asp文件，它可以自動建表，你就可以偷懶了:)

　　2. 在開始編寫之前你可以羅列一下要用到的SQL語句.

'搜索出數(shù)據(jù)庫中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','','','','測試','測試郵件件發(fā)送程序','cjj8110','********','1,zip,1.rar')"
'刪除表中全部數(shù)據(jù)。
SQL = "DELETE FROM attachment"
'刪除表中指定ＩＤ的記錄
SQL = "DELETE FROM attachment WHERE id =" & id
'更新表中，指定ＩＤ的filenames字段的內(nèi)容
SQL = "UPDATE attachemnt SET filenames='" & filenames & "' WHERE ID=" & id

三.編寫代碼
　　Install.asp：考慮到手工建表有點(diǎn)麻煩，所以寫了這個文件。文件主要用到CREATE TABLE和DROP TABLE語句，不過由于數(shù)據(jù)庫的原因，有些數(shù)據(jù)庫有可能不支持此語句。本文以Access為例，因?yàn)锳CCESS支持這兩條語句，如果還是新手還看不懂那也沒關(guān)系，以為有機(jī)會再研究好了:)。由于不清楚數(shù)據(jù)庫定義了那些關(guān)鍵字，所以在創(chuàng)建表和字段時，都用[]把表名和字段名括起來，即使表名或字段名和數(shù)據(jù)庫的關(guān)鍵字沖突，也不會引起程序出錯。不過運(yùn)行本程序前，必須先在Access中創(chuàng)建一個數(shù)據(jù)庫名稱為attachment.mdb，可以不為其創(chuàng)建表，用此程序來創(chuàng)建。

install.asp的源碼：
<% '此文件在執(zhí)行后最好刪除，因?yàn)槿绻�不注意再次�?zhí)行的話，將會使數(shù)據(jù)庫的所有數(shù)據(jù)丟失，切記！ Dim SYS_strTableName,SYS_strSQL,SYS_objRS '需要創(chuàng)建的表的名字 SYS_strTableName = "attachment" Set objConn = Server.CreateObject("ADODB.Connection") 'OLEDB方式打開數(shù)據(jù)庫的Connection對象連接字符串 strcon="provider=microsoft.jet.oledb.4.0;data source=" & Server.mappath("attachment.mdb") objConn.open strcon'和數(shù)據(jù)庫已經(jīng)建立連接可對其操作了. 'DROP TABLE是一條從數(shù)據(jù)庫中刪除表的SQL語句。有些數(shù)據(jù)庫有可能不支持。 SYS_strSQL = "DROP TABLE [" & SYS_strTableName & "]" '刪除表時，如果有錯誤出現(xiàn)則跳轉(zhuǎn)執(zhí)行下語句 '因?yàn)槿绻鸇ROP TABLE一個數(shù)據(jù)庫中并不存在的表時，就會導(dǎo)致程序出錯， '所以加了這個語句On Error Resume Next On Error Resume Next objConn.Execute (SYS_strSQL) '因?yàn)镺n Error Resume Next比較耗資源，執(zhí)行這條語句后，下面再出現(xiàn)錯誤將不會被跳轉(zhuǎn)了也就是On Error Resume Next將不對此后的語句產(chǎn)生作用了，如果不加這句話，就對此后的都起屏蔽錯誤的作用。 On Error Goto 0 '創(chuàng)建表格的主要是用CREATE TABLE語句 'CREATE TABLE tablename (fieldname1 fieldytype1,fieldname2 fieldtype2......) SYS_strSQL = "CREATE TABLE [" & SYS_strTableName & "] (" '此為創(chuàng)建自動編號類型的字段id SYS_strSQL = SYS_strSQL & "[id] integer IDENTITY (1, 1) PRIMARY KEY NOT NULL ," '創(chuàng)建文本類型的字段smtpcheck，字段類型為是/否類型。 SYS_strSQL = SYS_strSQL & "[smtpcheck] yesno," '創(chuàng)建文本類型的字段homepage，并限定該字段的長度為50(char(50)實(shí)現(xiàn)該功能),允許為空(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) '顯示創(chuàng)建成功信息。 Response.Write ("<br><font color=""#ff0000"">" & SYS_strTableName & "</font> 表創(chuàng)建成功！<br>") %>
[Ctrl+A 全部選擇 然后拷貝]

mail.asp的源碼：
<!--#include file="inc_clsEmail.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 = "發(fā)送" 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 '去除附件表中的相應(yīng)附件記錄 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")) '創(chuàng)建郵件Class Set MyMail = New SWEmail '自已設(shè)定郵件組件創(chuàng)建字符串 '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) '發(fā)送的是純文本郵件，默認(rèn)為HTML郵件 MyMail.IsHTML(False) '組件測試 MyMail.Check sFrom,sFromName,sTo,sSubject,sBody '發(fā)送郵件 'sReturn = MyMail.Send(sFrom,sFromname,sTo,sSubject,sBody) '釋放class占用的資源 MyMail.Close 'If sReutrn = True Then ' Response.Write("<br>呵呵，郵件發(fā)送成功啦！<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") '去除附件表中的相應(yīng)附件記錄 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 '創(chuàng)建郵件Class Set MyMail = New SWEmail '自已設(shè)定郵件組件創(chuàng)建字符串 '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) '發(fā)送的是純文本郵件，默認(rèn)為HTML郵件 MyMail.IsHTML(False) '組件測試 MyMail.Check sFrom,sFromName,sTo,sSubject,sBody '發(fā)送郵件 'sReturn = MyMail.Send(sFrom,sFromname,sTo,sSubject,sBody) '釋放class占用的資源 MyMail.Close 'If sReutrn = True Then ' Response.Write("<br>呵呵，郵件發(fā)送成功啦！<br>") 'Else ' Response.Write(sReturn) 'End If '刪除服務(wù)器上的附件 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("找不到相應(yīng)的附件，程序?qū)⒔K止運(yùn)行！") 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>發(fā)送</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>郵件服務(wù)器 <input type="text" name="smtpserver" value="<%=sServer%>"> </p> <p>組件 <input type="text" name="mailobject"> </p> <p>ＳＭＴＰ驗(yàn)證： <%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>發(fā)信人地址 <input type="text" name="from" value="<%=sFrom%>"> </p> <p>發(fā)信人姓名 <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>內(nèi)　容 <textarea name="body" rows="20" cols="100"><%=sBody%> </textarea> </p> <p> <input type="submit" name="action" value="發(fā)送"> <input type="submit" name="action" value="附件"> </p> </form> </body> </html> <%End If%>
[Ctrl+A 全部選擇 然后拷貝]

　　inc_clsEmail.asp文件，主要實(shí)現(xiàn)了郵件發(fā)送的全過程。此類有如下幾種方法：a)check,主要是檢測服務(wù)器支持哪些發(fā)信組件，并且發(fā)送一封郵件，看看能否成功發(fā)送；b)mailerr,主要是返回發(fā)送郵件過程中的錯誤信息；c)server,設(shè)置ＳＭＴＰ服務(wù)器的地址；d)send,發(fā)送郵件；e)BCC,密送郵件；f)CC,抄送郵件;g)addfile,添加附件，可添加多個附件；h)close,釋放數(shù)據(jù)。

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 '本類支持的組件數(shù),由于數(shù)組的下標(biāo)是從0開始的，所以實(shí)際是支持7個組件 Private Const SWEmail_intMailobjects = 6 '郵件組件數(shù)組 ReDim SWEmail_aryMailObject(SWEmail_intMailobjects,2) 'JMail 4.3 SWEmail_aryMailObject(0,0) = "JMail.Message" '創(chuàng)建組件的字符串，此字符串固定 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 '記錄郵件組件創(chuàng)建字符串 Private SWEmail_strMailObject '郵件組件的類型 Private SWEmail_intMailType '郵件組件的名稱（描述） Private strMailName '郵件附件信息 Private SWEmail_strFiles Private SWEmail_strFrom '發(fā)件人Email地址 Private SWEmail_strFromName '發(fā)件人姓名 Private SWEmail_strTo '收件人Email地址 Private SWEmail_strSubject '郵件主題 Private SWEmail_strBody '郵件內(nèi)容 Private SWEmail_strBCC '密送人Email地址 Private SWEmail_strCC '抄送人Email地址 Private SWEmail_strSMTPServer '郵件服務(wù)器地址 Private SWEmail_intSpeed '郵件等級 Private SWEmail_blnIsHTML '是否HTML郵件，True為HTML郵件，F(xiàn)ASLE為純文本郵件 Private SWEmail_strUserName '身份驗(yàn)證時輸入的用戶名 Private SWEmail_strPassword '身份驗(yàn)證時輸入的密碼 Private SWEmail_strAttachmentPath '附件路徑 Private SWEmail_strError '錯誤信息 '#########聲明結(jié)束######## '#########數(shù)據(jù)初始化######## '默認(rèn)為普通 SWEmail_intSpeed = 1 '默認(rèn)為HTML郵件 SWEmail_blnIsHTML = True '設(shè)置默認(rèn)發(fā)件服務(wù)器地址 'SWEmail_strSMTPServr = "SMTP.163.com" '設(shè)置默認(rèn)組件字符串 'SWEmail_strMailObject = "JMail.Message" '設(shè)置附件文件的路徑 SWEmail_strAttachmentPath = Server.Mappath("attachmentfiles\") '#########初始化結(jié)束######## Class SWEmail '檢測服務(wù)支持的郵件組件 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 '自動檢測服務(wù)器支持的組件并設(shè)置，如果成功返回True，否則返回False Function AutoSet() Dim i,objTest '沒檢測到發(fā)送郵件的組件 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 '只要檢測到就退出，不繼續(xù)檢測！ 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 '郵件等級設(shè)置 Sub Speed(str) '0:最慢,1:默認(rèn),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 '是否發(fā)送HTML郵件 Sub IsHTML(bln) SWEmail_blnIsHTML = bln End Sub 'SMTP服務(wù)器地址 Sub Server(str) SWEmail_strSMTPServer = str End Sub '發(fā)信 Function Send(from,fromname,go,subject,body) Dim sReturn '發(fā)信人的Email地址 SWEmail_strFrom = from '發(fā)信人的名字 SWEmail_strFromName = fromname '收信人Email地址 SWEmail_strTo = go '郵件主題 SWEmail_strSubject = subject '郵件內(nèi)容 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驗(yàn)證,只有JMail組件可用 Sub SMTPCheck(username,password) SWEmail_strUsername = username SWEmail_strPassword = password End Sub '設(shè)置郵件組件對象 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 '發(fā)送郵件主體 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 發(fā)信主體 '屏蔽例外錯誤 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 '發(fā)送附件 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早期版本發(fā)信主體 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 '發(fā)送附件 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 '發(fā)送附件 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 '發(fā)送附件 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 '發(fā)送附件 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= "有錯誤發(fā)生" 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 '微軟自帶發(fā)信主體 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 表示將采用連續(xù)的純文本（默認(rèn)值） 'objMail.MailFormat = 0 objMail.Body = SWEmail_strBody '發(fā)送附件 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 '清空內(nèi)容 Sub Close() SWEmail_strMailObject = "" SWEmail_intMailType = "" strMailName = "" SWEmail_strFiles = "" SWEmail_intSpeed = "" '釋放數(shù)組 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 %> <!--#include file="inc_set.asp"--> <html> <head> <title>文件上傳</title> <meta http-equiv="Content-Type" content="text/html; charset=gb2312"> <style type="text/css"> <!-- .tx { height: 16px; width: 30px; border-color: black black #000000; border-top-width: 0px; border-right-width: 0px; border-bottom-width: 1px; border-left-width: 0px; font-size: 9pt; background-color: <%=clrGeneralTR%>; color: #0000FF} .tx1 { height: 20px; width: 30px; font-size: 9pt; border: 1px solid; border-color: black black #000000; color: #0000FF} --> </style> </head> <body topmargin="0"> <table border="1"> <tr> <td> &nbsp; <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"> <!-- function setid() { str='<br>'; if(!window.form1.upcount.value) window.form1.upcount.value=1; for(i=1;i<=window.form1.upcount.value;i++) str+='文件'+i+':<input type="file" name="file'+i+'" style="width:350" class="tx1">&nbsp;&nbsp;&nbsp;&nbsp;文件重命名：<input type="text" name="filename'+i+'" style="width:100" class="tx"><br><br>'; window.upid.innerHTML=str+'<br>'; } file://--> </script> <li> 需要上傳的個數(shù) <input type="text" name="upcount" class="tx" value="2"> <input type="button" name="Button" class="button" onclick="setid();" value="設(shè)置"> </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="">&nbsp;&nbsp; <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"> <!-- setid(); file://--> </script>
[Ctrl+A 全部選擇 然后拷貝]

uploadok.asp的源碼：
<%Option Explicit Response.Expires = 0 %> <!--#include file="inc_clsUpload.asp"--> <% Private Function FormatStr(str) str = Trim(BinToStr(str)) str = Replace(str,"'","''") str = Replace(str,vbcrlf,"") FormatStr = str End Function '設(shè)置文件上傳路徑，此目錄必須存在，否則會出錯 Private Const svrUploadFilePath = "attachmentfiles" Dim strNewName,sNewname,strSQL,strNoPic,strInfo,strFileName,strFilePath Dim intFormSize,intFileCount,I Dim binFormData,binTextData,binFileData Dim aryFileName Dim objUpload '獲取表單數(shù)據(jù)的大小 intFormSize = Request.TotalBytes '獲取所有的表單數(shù)據(jù) binFormData = Request.BinaryRead(intFormSize) '創(chuàng)建上傳類 Set objUpload = New Upload '初始化表單提交的數(shù)據(jù)中 objUpload.Init(binFormData) '清空數(shù)據(jù) binFormData = "" strInfo = "" intFileCount = objUpload.FileCount '設(shè)置上傳文件存放的路徑 objUpload.SetPath(svrUploadFilePath) '獲取上傳文件的存放路徑 'strFilePath = objUpload.GetPath '設(shè)置允許上傳的文件格式,多種格式以|分隔 objUpload.AllowFiles ("zip|rar|jpg|png|bmp|txt|htm|html") '獲取默認(rèn)文件名列表 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 '清空文本內(nèi)容 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 %>
[Ctrl+A 全部選擇 然后拷貝]

inc_clsUpload.asp的源碼：
<% '***************************************** ' 目的： 將Binary字符轉(zhuǎn)成String。 ' 輸入： str: 需要轉(zhuǎn)換Binary。 ' 返回： 轉(zhuǎn)換后的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轉(zhuǎn)成Binary。 ' 輸入： str: 需要轉(zhuǎn)換的String。 ' 返回： 轉(zhuǎn)換后的二進(jìn)制字符串。 '***************************************** 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 '文件開始位置、文件大小、文件個數(shù) Dim intFileStart,intFileSize,intFileCount 'AdoStream對象objData和Dictionary對象objFiles Dim objData,objFiles '二進(jìn)制數(shù)據(jù) Dim binTxtData '以上變量均為Class級變量，可在此Class的所有過程函數(shù)中使用 '***************************************** ' 目的： 將文件與文本數(shù)據(jù)分離,保存文件到Dictionary對象 ' 輸入： formdata： 為表單提交的所有數(shù)據(jù) ' 返回： 無 '***************************************** 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 '文件個數(shù)清零 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 '文件內(nèi)容 'binFileContent = MidB(formdata,intFileStart,intFileSize) '添加文件,以文件名為關(guān)鍵字 If Not objFiles.Exists(sFileName) Then objFiles.Add sFileName,intFileStart & "," & intFileSize Else strErrorInfo = strErrorInfo & "<br>文件 <b>" & sFileName & "</b> 已經(jīng)存在！" Exit Sub End If '統(tǒng)計(jì)文件個數(shù) intFileCount = intFileCount + 1 Else '如果是表單項(xiàng)目 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 '***************************************** ' 目的： 統(tǒng)計(jì)文件個數(shù) ' 輸入： 無 ' 返回： 返回上傳的文件個數(shù) ' 說明： intFileCount是一個Class級變量，在本Class內(nèi)有效 ' 在函數(shù)PickData過程中，統(tǒng)計(jì)文件個數(shù) '***************************************** Function FileCount() FileCount = intFileCount End Function '***************************************** ' 目的： 將二進(jìn)制數(shù)據(jù)寫入文件 ' 輸入： 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 '***************************************** ' 目的： 獲取表單項(xiàng)的值 ' 輸入： name： 為要尋找的字段變量 ' txtdata： 為已從圖象中分離出來的的所有文本 ' 返回： 表單項(xiàng)的值 '***************************************** 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 '表單中可能有多個同名變量(用在有主表與明細(xì)表中的數(shù)據(jù)更新中） Do intStartPos = Instr(intValEnd,txtdata,fName) + intNameLen If intStartPos > intNameLen Then intValEnd = Instr(intStartPos,txtdata,"""") bReturn = bReturn & "," & Mid(intStartPos,txtdata,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 & "<Br>文件名不能為空！" Exit Function End If Set objFSO = Server.CreateObject("Scripting.FileSystemObject") If Instr(filename,",")>0 Then 'Response.Write("<br>@" & filename & "@<br>") aryFileName = Split(filename,",") For i = LBound(aryFileName) To UBound(aryFileName) 'Response.Write("<br>file:" & strFilePath &"#" & aryFileName(i) & "<br>") sPath = Server.Mappath(strFilePath & aryFileName(i)) If objFSO.FileExists(sPath) Then sError = sError & "<br>文件 " & aryFileName(i) & " 已經(jīng)存在！" End If Next Else sPath = Server.Mappath(strFilePath & filename) If objFSO.FileExists(sPath) Then sError = sError & "<br>文件 " & filename & " 已經(jīng)存在!" End If End If Set objFSO = Nothing If Trim(sError) <> "" Then strErrorInfo = strErrorInfo & sError Else FileExist = True End If End Function '***************************************** ' 目的： 獲取表單項(xiàng)的值 ' 輸入： name： 為要尋找的字段變量 ' 返回： 轉(zhuǎn)成普通字符串后的表單項(xiàng)的值 '***************************************** Function FormName(aName) Dim binFormName,binTest 'binTxtData已經(jīng)分離出來的文件數(shù)據(jù) binFormName = FindInput(aName,binTxtData) FormName = BinToStr(binFormName) End Function '***************************************** ' 目的： 設(shè)置文件存放路徑 ' 輸入： 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內(nèi)容管理系統(tǒng)" 'ＴＯＰ。ｈｔｍ中行的顏色 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 全部選擇 然后拷貝]

四、商業(yè)應(yīng)用中的問題

　　優(yōu)點(diǎn)：1.支持多種發(fā)送郵件組件；
　　　　　　2.支持發(fā)送多附件。

　　缺點(diǎn)：1.對附件大小沒有限制；
　　　　　　2.如果附件已經(jīng)存在于服務(wù)器上，無法再上傳；
　　　　　　3.對填寫的表單信息是否為空，沒進(jìn)行判斷;

五、注意事項(xiàng)

　　本程序主要目的是學(xué)習(xí)，不適合用于商業(yè)，因?yàn)樵谑褂弥羞�有問題存在，當(dāng)然你可以對其進(jìn)行完善再應(yīng)用到商業(yè)上。大家，在使用過程中，如發(fā)現(xiàn)問題，可以到論壇問http://m.95time.cn/bbs，也可以發(fā)email給我cjj8110@hotmail.com(也是我的ＭＳＮ地址)。最后，感謝各位兄弟幫忙測試。Ｊmail部分代碼已測試通過，用ＣＤＯ發(fā)附件，及其它發(fā)信組件還沒有測試，由于條件有限，只能到此為止了。

　　還有一點(diǎn)，在存入程序文件的目錄下，需要建一文件夾attachmentfiles（用于存放附件），此文件夾是必須的。

全部代碼請點(diǎn)擊此處下載

出處：藍(lán)色理想
責(zé)任編輯：cjj

◎進(jìn)入論壇網(wǎng)絡(luò)編程版塊參加討論