请选择 进入手机版 | 继续访问电脑版
 找回密码
 注册
楼主: 蓝雨
收起左侧

蓝雨论坛上传附件显示详细信息for Dvbbs8.0.0

[复制链接]

5311

主题

8316

帖子

1万

积分

管理员

出售国内外虚拟空间

Rank: 10Rank: 10Rank: 10

积分
14658
帖子
8316
精华
67
体力
14658 点
蓝豆
2391 点
注册时间
2007-6-8

终身成就奖LY官方团队会员身份ID卡

发表于 2007-6-22 20:29:00 | 显示全部楼层 |阅读模式

插件名称:上传附件显示详细信息for Dvbbs8.0.0
插件版本:2.0
修改: 168168
修改时间:2007.06.19
特别提示:本修改在动网论坛8.0.0正式版[2007-6-18 18:10更新] ACC版本程序测试通过,修改前请先备份,出错别怪哦,呵呵
根据原1.11版本修改原插件作者:老庙黄金


主要功能:


1、单贴间多个下载文件单独记录下载次数并显示文件名
2、显示原来上传时的文件名,而不是变成序号的文件名(不影响保密功能)
3、可以查看下载者的功能
4、文件长度显示,该Byte就Byte,该KByte就KByte,该MByte就MByte
5、无论上传文件后系统加了什么样的后缀序号(其实是用于防盗和防止文件重名的),下载时都会只显示原来的文件名,不会出现后边的一长

串序号(这个功能要在系统开启了防盗功能才有效)
6、上传图片时不进行原文件名的处理

安装办法:


一、将压缩包中的z_Upload.asp上传至论坛根目录

二、修改inc/dv_ubbcode.asp:


修改inc/dv_ubbcode.asp:

1、在第一行之前添加:

2、41行找到 Public Re,reed,isgetreed,Board_Setting,WapPushUrl,xml,isxhtml
增加一个新变量定义abgcolor
Public Re,reed,isgetreed,Board_Setting,WapPushUrl,xml,isxhtml,abgcolor

164-168行 找到
Dim textonly
textonly=istext(s)
If textonly Then
re.Pattern=\"<\"
s= re.Replace(s,\"<\")

下边添加


Else
re.Pattern=\">\"& Chr(13) &Chr(10) &\"<\"
Do While re.Test(s)
s= re.Replace(s,\"><\")
Loop
re.Pattern=\">\"& Chr(10) &\"<\"
Do While re.Test(s)
s= re.Replace(s,\"><\")
Loop
re.Pattern=\">\"& Chr(13) &\"<\"
Do While re.Test(s)
s= re.Replace(s,\"><\")
Loop

End If
re.Pattern=\"(]*)>)\"
s=re.Replace(s,\"\")
re.Pattern=\"<\\/p>\\x0d?\\x0a

\"
s= re.Replace(s,\"

\")
re.Pattern=\"([^\\x0d])\\x0a((?!s= re.Replace(s,\"$1
$2\")
re.Pattern=\"\\x0d\\x0a([^\\x0d]*)\"
s= re.Replace(s,\"

$1

\")
re.Pattern=\"(]*)>)\"
s=re.Replace(s,\"\")
re.Pattern=\"(<\\!(.[^>]*)>)\"
s=re.Replace(s,\"<$2>\")
re.Pattern=\"(<\\!)\"
s=re.Replace(s,\"re.Pattern=\"(-->)\"
s=re.Replace(s,\"-->\")
re.Pattern=\"(javascript:)\"
s=re.Replace(s,\"javascript:\")
re.Pattern=\"(
\\s*){10,}\"
s=re.Replace(s,\"
\")
If Board_Setting(5)=\"0\" Then
re.Pattern =\"<(\\/?(i|b|p))>\"
s=re.Replace(s,Chr(1)&\"$1\"&Chr(2))
re.Pattern=\"(>)(\"&vbNewLine&\"){1,2}(<)\"
s=re.Replace(s,\"$1$3\")
\'re.Global=False
re.Pattern=\"(
)((.|\\n)*?)(<\\/div>)\"
Do While re.Test(s)
s=re.Replace(s,\"

QUOTE:
$2
\")
Loop
\'re.Global=True
re.Pattern = \"(<\\/tr>)\"
s = re.Replace(s,\"
\")
re.Pattern = \"(
)\"
s = re.Replace(s,\"
\")
re.Pattern = \"<(\\/?s(ub|up|trike))>\"
s = re.Replace(s,\"[$1]\")
re.Pattern = \"(<)(\\/?font[^>]*)(>)\"
s = re.Replace(s,CHR(1)&\"$2\"&CHR(2))
re.Pattern=\"<([^<>]*?)>\"
Do while re.Test(s)
s=re.Replace(s,\"\")
Loop
re.Pattern = \"(\\x01)(\\/?font[^\\x02]*)(\\x02)\"
s = re.Replace(s,\"<$2>\")
re.Pattern = \"\\[(\\/?s(ub|up|trike))\\]\"
s = re.Replace(s,\"<$1>\")
\'re.Global=False
re.Pattern=\"(\\[quote\\])((.|\\n)*?)(\\[\\/quote\\])\"
Do While re.Test(s)
s=re.Replace(s,\"
$2
\")
Loop
\'re.Global=True
re.Pattern=\"\\x01(\\/?(i|b|p))\\x02\"
s=re.Replace(s,\"<$1>\")
re.Pattern = \"(\\[br\\])\"
s = re.Replace(s,\"
\")

If PostType=1 Then
re.Pattern=\",39,\"
\'If re.Test(Ubblists&\"\") Then
If Dv_FilterJS(s) Then
re.Pattern=\"\\[(br)\\]\"
s=re.Replace(s,\"<$1>\")
re.Pattern = \"(
)\"
s = re.Replace(s,vbNewLine)
re.Pattern = \"(

)\"
s = re.Replace(s,\"\")
re.Pattern = \"(<\\/p>)\"
s = re.Replace(s,vbNewLine)
s=server.htmlencode(s)
s=\"

class=tableborder2 cellSpacing=1 cellPadding=3 width=\"\"100%\"\" align=center border=\"\"0\"\">

以下内容含脚本,或可

能导致页面不正常的代码

align=\"\"middle\"\" width=\"\"98%\"\">说明:上面显示的是代码内容。您可以先检查过代码没问题,或修改之后再运

行.

onclick=\"\"Dvbbs_ViewCode(\"&replyid&\");\"\">

\"
s = Replace(s, vbNewLine, \"\")
s = Replace(s, CHR(10), \"\")
s = Replace(s, CHR(13), \"\")
Dv_UbbCode=s
Exit Function
End If
\'End If
End If
re.Pattern=\"<((asp|\\!|%))\"
s=re.Replace(s,\"<$1\")


3、1027找到
re.Pattern=\"\\[upload=(\\w{3})(,|)([^\\]]*)\\]viewFile\\.asp\\?id=([0-9]*)\\x01\\/UPLOAD\\]\"

,修改为:
s=Dv_UbbCode_Upload(s,PostUserGroup,Flag,MaxLoopCount,abgcolor)

三、修改inc/Upload_Class.asp:

1、368行找到:
Private Function FormatName(Byval FileExt,Byval FileName)

改为:
Private Function FormatName(Byval FileExt, Byval FileType, Byval OrigFileName)


2、376行找到:
TempStr = Year(now) & Month(now) & Day(now) & Hour(now) & Minute(now) & Second(now) & RanNum & \".\" & FileExt
下边添加:
If FileType=1 Or FileType=2 Then
Else
TempStr = OrigFileName & \"___\" & TempStr
End If

3、找到(一共四处都要改):546-547行 621-622行 690-691行 766-767行
FileName = FormatName(FileExt,File.FileName)
FileType = CheckFiletype(FileExt)


改为:
FileType = CheckFiletype(FileExt)
FileName = FormatName(FileExt, FileType, Replace(File.FileName,Chr(0),\"\"))


四、修改viewfile.asp:


1、找到:
109-122行 If Dvbbs.Forum_Setting(75)=\"0\" Then
Dvbbs.Execute(\"Update dv_upfile Set F_DownNum=F_DownNum+1 Where F_ID=\"&DownID)
If Rs(\"F_OldName\") = \"\" Or IsNull(Rs(\"F_OldName\")) Then
Response.Redirect uploadpath&rs(\"F_filename\")
Else
downloadFile Server.MapPath(uploadpath&rs(\"F_filename\")),Rs(\"F_OldName\")
End If
Else
filename=Replace(rs(\"F_filename\"),\"..\",\"\")&\"\"
If Request.ServerVariables(\"HTTP_REFERER\")=\"\" Or InStr(Request.ServerVariables

(\"HTTP_REFERER\"),Request.ServerVariables(\"SERVER_NAME\"))=0 Or filename=\"\" Then
Response.Redirect \"index.asp\"
Else
downloadFile Server.MapPath(Dvbbs.Forum_Setting(76)&filename),Rs(\"F_OldName\")
End If


改为:
If Dvbbs.Forum_Setting(75)=\"0\" Then
If Dvbbs.UserID<>0 Then
Call UpdateDownUser(rs(\"f_downuser\"),Dvbbs.MemberName)
Else
Dvbbs.Execute(\"Update dv_upfile Set F_DownNum=F_DownNum+1 Where F_ID=\"&DownID)

End If
Response.Redirect uploadpath&rs(\"F_filename\")
Else
filename=Replace(rs(\"F_filename\"),\"..\",\"\")&\"\"
If Request.ServerVariables(\"HTTP_REFERER\")=\"\" Or InStr(Request.ServerVariables

(\"HTTP_REFERER\"),Request.ServerVariables(\"SERVER_NAME\"))=0 Or filename=\"\" Then
Response.Redirect \"index.asp\"
Else
If Dvbbs.UserID<>0 Then
Call UpdateDownUser(rs(\"f_downuser\"),Dvbbs.MemberName)
Else
Dvbbs.Execute(\"Update dv_upfile Set F_DownNum=F_DownNum+1 Where F_ID=\"&DownID)

End If

Call downloadFile(Server.MapPath(Dvbbs.Forum_Setting(76)&filename))
End If

2、找到:129-163行
Sub downloadFile(strFile,FileOldName)
On error resume next
Server.ScriptTimeOut=999999
Dim S,fso,f,intFilelength,strFilename,DownFileName
strFilename = strFile
Response.Clear
Set s = Server.CreateObject(\"ADODB.Stream\")
s.Open
s.Type = 1
Set fso = Server.CreateObject(\"Scripting.FileSystemObject\")
If Not fso.FileExists(strFilename) Then
Response.Write(\"

错误:


系统找不到指定文件\")
Exit Sub
End If
Set f = fso.GetFile(strFilename)
intFilelength = f.size
s.LoadFromFile(strFilename)
If err Then
Response.Write(\"

错误:

\" & err.Description & \"

\")
Response.End
End If
Set fso=Nothing
Dim Data
Data=s.Read
s.Close
Set s=Nothing
If FileOldName=\"\" Or IsNull(FileOldName) Then DownFileName=f.name Else DownFileName=FileOldName
If Response.IsClientConnected Then
Response.AddHeader \"Content-Disposition\", \"attachment; filename=\" & DownFileName
Response.AddHeader \"Content-Length\", intFilelength
Response.CharSet = \"UTF-8\"
Response.ContentType = \"application/octet-stream\"
Response.BinaryWrite Data
Response.Flush
End If

改为:
Sub downloadFile(strFile)
On error resume next
Server.ScriptTimeOut=999999
Dim S,fso,f,intFilelength,strFilename
strFilename = strFile
Response.Clear
Set s = Server.CreateObject(\"ADODB.Stream\")
s.Open
s.Type = 1
Set fso = Server.CreateObject(\"Scripting.FileSystemObject\")
If Not fso.FileExists(strFilename) Then
Response.Write(\"

错误:


系统找不到指定文件\")
Exit Sub
End If
Set f = fso.GetFile(strFilename)
intFilelength = f.size
s.LoadFromFile(strFilename)
If err Then
Response.Write(\"

错误:

\" & err.Description & \"

\")
Response.End
End If
Set fso=Nothing
Dim Data
Data=s.Read
s.Close
Set s=Nothing
If Response.IsClientConnected Then
Dim TruePos
Dim TrueFileName

TruePos=InStrRev(f.name,\"___\")
If TruePos>0 Then
TrueFileName=Left(f.name,TruePos-1)
Else
TrueFileName=f.name
End If
TruePos=InStrRev(TrueFileName,\"/\")
If TruePos>0 Then
TrueFileName=Right(TrueFileName,Len(TrueFileName)-TruePos)
End If
Response.AddHeader \"Content-Disposition\", \"attachment; filename=\" & TrueFileName
Response.AddHeader \"Content-Length\", intFilelength
Response.CharSet = \"UTF-8\"
Response.ContentType = \"application/octet-stream\"
Response.BinaryWrite Data
Response.Flush
End If
End Sub
Sub UpdateDownUser(DownUser,UserName)
If Not Instr(1,\"|\"&DownUser&\"|\",\"|\"&UserName&\"|\")>0 Then
If IsNull(DownUser) Or DownUser=\"\" Then
Dvbbs.Execute(\"Update dv_upfile Set F_DownNum=F_DownNum+1,F_DownUser=\'\"&UserName&\"\'

Where F_ID=\"&DownID)
Else
Dvbbs.Execute(\"Update dv_upfile Set

F_DownNum=F_DownNum+1,F_DownUser=\'\"&DownUser&\"|\"&UserName&\"\' Where F_ID=\"&DownID)
End If
End If


3、在文件最后End If
End Sub
%>
之前添加:
Sub UpdateDownUser(DownUser,UserName)
If Not Instr(1,\"|\"&DownUser&\"|\",\"|\"&UserName&\"|\")>0 Then
If IsNull(DownUser) Or DownUser=\"\" Then
Dvbbs.Execute(\"Update dv_upfile Set F_DownNum=F_DownNum+1,F_DownUser=\'\"&UserName&\"\'

Where F_ID=\"&DownID)
Else
Dvbbs.Execute(\"Update dv_upfile Set

F_DownNum=F_DownNum+1,F_DownUser=\'\"&DownUser&\"|\"&UserName&\"\' Where F_ID=\"&DownID)
End If
End If
End Sub

五、修改Dispbbs.asp

14行找到:\"Dim PostBuyUser,abgcolor,bgcolor,UserName,PostUserName\",后面增加一个新变量定义pUserName

Dim PostBuyUser,abgcolor,bgcolor,UserName,PostUserName,pUserName


六、修改post.asp
11行找到\"Dim MyPost,UserName\",后面增加一个新变量定义pusername

Dim MyPost,UserName,pusername

游客,如果您要查看本帖隐藏内容请回复
出售国内或美国高性能虚拟空间,高速VPS以及服务器! 同时承接各种类型的网站制作,网站维护,支付宝交易安全放心!    联系QQ:6102031
hnabv 该用户已被删除
发表于 2007-7-24 17:55:00 | 显示全部楼层
提示: 作者被禁止或删除 内容自动屏蔽
hnabv 该用户已被删除
发表于 2007-7-24 18:02:00 | 显示全部楼层
提示: 作者被禁止或删除 内容自动屏蔽
hnabv 该用户已被删除
发表于 2007-7-24 18:15:00 | 显示全部楼层
提示: 作者被禁止或删除 内容自动屏蔽
wyc007 该用户已被删除
发表于 2007-7-24 18:38:00 | 显示全部楼层
提示: 作者被禁止或删除 内容自动屏蔽
懒得打字嘛,点击右侧快捷回复
您需要登录后才可以回帖 登录 | 注册

本版积分规则

关闭

网站公告上一条 /2 下一条

GMT+8, 2024-3-29 21:15 , Processed in 0.140625 second(s), 33 queries , Gzip On.

© 2006-2022 Powered by Discuz! X3.4

快速回复 返回顶部 返回列表