上传附件显示详细信息for8.2.0
安装办法：一、将压缩包中的z_Upload.asp上传至论坛根目录
二、修改inc/dv_ubbcode.asp：
1、在第一行之前添加：
<!--#include file=\"../z_Upload.asp\"-->
2、41行找到
Public Re,reed,isgetreed,Board_Setting,WapPushUrl,xml,isxhtml,pageReload
增加一个新变量定义abgcolor
Public Re,reed,isgetreed,Board_Setting,WapPushUrl,xml,isxhtml,pageReload,abgcolor
、168-174行 找到
If Not xml.loadxml(\"<div>\" & replace(s,\"&\",\"&\") &\"</div>\") Then
If NOScript = 1 Then
If Dv_FilterJS(s) Then
re.Pattern = \"()\"
s = re.Replace(s,Chr(9))
re.Pattern = \"(<br/>)\"
s = re.Replace(s,vbNewLine)
改成
re.Pattern=\"(<s+cript(.[^>]*)>)\"
s=re.Replace(s,\"<Script$2>\")
re.Pattern=\"(<\\/s+cript>)\"
s=re.Replace(s,\"</Script>\")
re.Pattern=\"<\\/p>\\x0d?\\x0a<p>\"
s= re.Replace(s,\"<p></p>\")
re.Pattern=\"([^\\x0d])\\x0a((?!<td|<tr))\"
s= re.Replace(s,\"$1<br>$2\")
re.Pattern=\"\\x0d\\x0a([^\\x0d]*)\"
s= re.Replace(s,\"<p>$1</p>\")
re.Pattern=\"(<body(.[^>]*)>)\"
s=re.Replace(s,\"<body>\")
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,\"<i>javascript</i>:\")
re.Pattern=\"(<br>\\s*){10,}\"
s=re.Replace(s,\"<br>\")
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.Pattern=\"(<div class=quote>)((.|\\n)*?)(<\\/div>)\"
Do While re.Test(s)
s=re.Replace(s,\"
$2
\")
Loop
re.Pattern = \"(<\\/tr>)\"
s = re.Replace(s,\"
\")
re.Pattern = \"(<br>)\"
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.Pattern=\"(\\)((.|\\n)*?)(\\[\\/quote\\])\"
Do While re.Test(s)
s=re.Replace(s,\"<div class=quote>$2</div>\")
Loop
re.Pattern=\"\\x01(\\/?(i|b|p))\\x02\"
s=re.Replace(s,\"<$1>\")
re.Pattern = \"(\\)\"
s = re.Replace(s,\"<br>\")
If PostType=1 Then
re.Pattern=\",39,\"
If Dv_FilterJS(s) Then
re.Pattern=\"\\[(br)\\]\"
s=re.Replace(s,\"<$1>\")
4、1051找到
re.Pattern=\"\\]*)\\]viewFile\\.asp\\?id=(*)\\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
改成：
TempStr = Dvbbs.membername & 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行 692-693行768-769行
FileName = FormatName(FileExt,File.FileName)
FileType = CheckFiletype(FileExt)
改为：
FileType = CheckFiletype(FileExt)
FileName = FormatName(FileExt, FileType, Replace(File.FileName,Chr(0),\"\"))
四、修改viewfile.asp：
1、找到：
121-133行
Dvbbs.Execute(\"Update dv_upfile Set F_DownNum=F_DownNum+1 Where F_ID=\"&DownID)
If Dvbbs.Forum_Setting(75)=\"0\" Then
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\")
改为：
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))
2、150行
Sub downloadFile(strFile,FileOldName)
改为;
Sub downloadFile(strFile)
3、找到：168-170行
If FileOldName=\"\" Or IsNull(FileOldName) Then DownFileName=f.name Else DownFileName=FileOldName
If Response.IsClientConnected Then
Response.AddHeader \"Content-Disposition\", \"attachment; filename=\" &DownFileName
改为：
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
3、在文件最后
%>
之前添加：
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
页:
[1]
2