<% if bbswjop="1" then browsers=Lcase(Left(Request.ServerVariables("HTTP_USER_AGENT"),4)) if browsers="oper" or browsers="winw" or browsers="wapi" or browsers="mc21" or browsers="up.b" or browsers="upg1" or browsers="upsi" or browsers="qwap" or browsers="jigs" or browsers="java" or browsers="alca" or browsers="wapj" or browsers="cdr/" or browsers="nec-" or browsers="fetc" or browsers="r380" or browsers="winw" or browsers="mozi" or browsers="mozi" or browsers="m3ga" then Call Error("

请用手机下载！") end if end if dim path,tid,pathall path=request.querystring("path") tid=request.querystring("tid") info=request.querystring("info") if tid="" or IsNumeric(tid)=False then Call Error("

ID无效！") end if if path="" then Call Error("

地址无效！") end if Select Case info Case "ok" Call downok() Case "mail" Call mailok() Case else Call list() end select Sub list response.write "" response.write "

" Response.Write "直接下载" Response.Write "|发到邮箱" Response.Write "
太黑了,我闪
" response.write"注意:下载附件和发文件到自己的邮箱都要用到"&bbsmyjb&getcent&"
" response.write "您现在持有"&myjb&getcent&"
" end sub sub downok() if myjb>=abs(int(bbsmyjb)) then conn.Execute("update Users set myjb=myjb-"&abs(int(bbsmyjb))&" Where id="&myid) if Instr(path,"file/")>0 then pathall="http://"&Request.ServerVariables("HTTP_HOST")&"/bbs/"&path else pathall="http://"&Request.ServerVariables("HTTP_HOST")&"/bbs/"&deCode_base64(path) end if response.write "" response.write "

" response.write "正在下载文件中，请稍后..." Response.Write "
手动直接下载
" Response.Write "返回上一级
" else Call Error("

您的"&getcent&"不足！下载附件需用"&bbsmyjb&getcent&"
") end if end sub sub mailok response.write "" response.write "

" if myjb>=abs(int(bbsmyjb)) then conn.Execute("update Users set myjb=myjb-"&abs(int(bbsmyjb))&" Where id="&myid) dim path2 if Instr(path,"file/")>0 then path2=path else path2=deCode_base64(path) end if dim emname,mail set rs=Server.CreateObject("ADODB.Recordset") rs.open"select ID,name,email from [users] where id="&myid,conn,1,1 if CheckEmail(rs("email"))=False then Call Error("对不起，您的个人资料中还没有填写邮箱或者您的邮箱错误！") end if emname=rs("name") mail=rs("email") rs.close set rs=nothing Dim msg Set msg = Server.CreateObject("JMail.Message") msg.ContentType = "multipart/mixed" msg.CharSet = "GB2312" msg.FromName = "发送下载附件" '发件者的签名 msg.From = "nowtx.cn@qq.com" '发件者邮箱 msg.ReplyTo = "nowtx.cn@qq.com" '指定回复邮箱 msg.Subject = "发送下载附件" '邮件主题 msg.AddAttachment(Server.MapPath(path2)) '附件地址，必填 msg.Body ="" msg.Body =msg.Body &emname&"您好！您的文件已成功接收：" & vbCrLf msg.Body =msg.Body &"来自"& waptitle&"发送附件系统" '邮件正文 msg.AddRecipient mail, "来自"&waptitle&"" '收件人的邮箱、签名 msg.MailServerUserName = "nowtx.cn" '自己邮箱的管理用户名 msg.MailServerPassword = "nowtx.cn" '自己邮箱密码 msg.Send("smtp.qq.com") '发邮件服务器 msg.Close Set msg = Nothing response.Write "您的文件已成功发送到您的邮箱！
" else Call Error("

您的"&getcent&"不足！发送附件到邮箱需用"&bbsmyjb&getcent&"
") end if end sub Function CheckEmail(str) Dim re,a Set re = New RegExp re.IgnoreCase = True re.Global = True re.Pattern = "\w+([-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*" a = re.Test(str) If a then CheckEmail = True Else CheckEmail = False End If End Function %> 返回主帖