FoosunCMS-删除下载

来自站长百科
跳转至： 导航、​ 搜索

导航：返回上一页



补丁运用[ ]

  1. 备份相应文件
  2. 替换目录inc\Function.asp中的文件
  3. 替换目录Admin\Info中的文件DelContent.asp

这些文件中可能包含其它补丁，如查直接替换有问题请参照下列修改方法去修改。


修改方法分三大步[ ]

一、在文件Inc\Const.asp中增加一句

Const Delpic="yes" '新闻与下载删除的同时，是否删除远程保存的图片(仅删BeyondPicDir中的)。yes:删除，其它不删除。

二、在文件Admin\Info\DelContent.asp中 

(1)在
If MyFile.FileExists(Server.Mappath
(DelNewsSysRootDir&DelNewsClassFileObj
("SaveFilePath")&"/"&DelNewsClassFileObj
("ClassEName"))&"/"&DelNewsFileObj("FileName")
&"."&DelNewsFileObj("FileExtName")) then
   MyFile.DeleteFile(Server.Mappath
(DelNewsSysRootDir&DelNewsClassFileObj
("SaveFilePath")&"/"&DelNewsClassFileObj
("ClassEName"))&"/"&DelNewsFileObj("FileName")&
"."&DelNewsFileObj("FileExtName"))
End if
后插入
'------------删除远程存图的图片--doudou888--------
If LCase(Delpic)="yes" Then
Call DelLocalFile(replace(DelNewsFileObj
("Content"),DelNewsSysRootDir,"
http://127.0.0.1"&DelNewsSysRootDir))
Dim timPic,timPicPath
timPic=DelNewsFileObj("PicPath")
If InStr(LCase(timPic),LCase(UpFilesZn))>0 Then '站内
  timPicPath=DelNewsSysRootDir&Mid(timPic,1,InstrRev(timPic,"/")-1)
Else '站外
  timPicPath=Mid(timPic,1,InstrRev(timPic,"/")-1)
End If
'Call DelFilesFolder(timPicPath,"",Mid(timPic,InstrRev(timPic,"/")+1))
Call DelFilesFolder(timPicPath,"",DelNewsFileObj("NewsID")&"_")
End if
'-------------------------------------------------
(2)在
if MyFile.FileExists(Server.MapPath(DelNewsSysRootDir & 
DelDownClassObj("SaveFilePath") & "/"& 
DelDownClassObj("ClassEName")) & "/" & 
DelDownloadObj("FileName") & "." & 
DelDownloadObj("FileExtName")) then
MyFile.DeleteFile (Server.MapPath(DelNewsSysRootDir & 
DelDownClassObj("SaveFilePath") & "/"& 
DelDownClassObj("ClassEName")) & "/" & 
DelDownloadObj("FileName") & "." & 
DelDownloadObj("FileExtName"))
end if 
后插入
'-----------------删除远程存图的图片---------------
If LCase(Delpic)="yes" Then
Call DelLocalFile(replace(DelDownloadObj
("Description"),DelNewsSysRootDir,"
http://127.0.0.1"&DelNewsSysRootDir))
Dim timPic,timPicPath
timPic=DelDownloadObj("Pic")
If InStr(LCase(timPic),LCase(UpFilesZn))>0 Then '站内
timPicPath=DelNewsSysRootDir&Mid(timPic,1,InstrRev(timPic,"/")-1)
Else '站外
timPicPath=Mid(timPic,1,InstrRev(timPic,"/")-1)
End If
'Call DelFilesFolder(timPicPath,"",Mid(timPic,InstrRev(timPic,"/")+1))
Call DelFilesFolder(timPicPath,"",DelDownloadObj("DownLoadID")&"_")
End if
'-------------------------------------------------
(3)在
Set MyFile=nothing
Set Conn = Nothing
前插入
'**************************************************
'过程名：DelLocalFile(NewsContent)
'作  用：取出NewsContent中所含的文件路径temDelLocalFilePath与
名称DelLocalFileName，提供给DelFilesFolder
'参  数：NewsContent
'设  计：doudou888 QQ：280106330 主页：http://nhez.chinese.cn.com
'**************************************************
Function DelLocalFile(NewsContent)
Dim re1
Set re1 = New RegExp
re1.IgnoreCase = True
re1.Global=True
re1.Pattern = "((http|https|ftp|rtsp|mms):
(\/\/|\\\\){1}((\w)+[.]){1,}(net|com|cn|org|cc|tv|
[0-9]{1,3})(\S*\/)((\S)+[.]{1}(gif|jpg|png|bmp)))"
Set DelLocalFile = re1.Execute(NewsContent)
Set re1 = Nothing
For Each DelLocalFileurl in DelLocalFile
  dim temDelLocalFilePath,DelLocalFileName
  DelLocalFileName = Mid(DelLocalFileurl,InstrRev(DelLocalFileurl,"/")+1)
  dim temDelLocalFileurl
  temDelLocalFileurl=replace(DelLocalFileurl,"://","")
  temDelLocalFilePath=Mid(temDelLocalFileurl, 
Instr(temDelLocalFileurl,"/"),
InstrRev(temDelLocalFileurl,"/")-Instr(temDelLocalFileurl,"/"))
  Call DelFilesFolder(temDelLocalFilePath,"",DelLocalFileName) 
Next
End Function
'**************************************************
'过程名：DelFilesFolder(Path,ClassEName,FileName)
'作  用：删除文件。删除Path、ClassEName下的有文件名FileName的文件
'参  数：Path,ClassEName,FileName
'设  计：doudou888 QQ：280106330 主页：http://nhez.chinese.cn.com
'**************************************************
Sub DelFilesFolder(Path,ClassEName,FileName)  '删除文件、目录
'远程图片保存目录内的图片
  'If InStr(LCase(Path),LCase(BeyondPicDir))>0 and 
((InStr(LCase(Path),LCase("http://"))>0 and 
(InStr(LCase(Path),LCase(GetLoginUrl()))>0 or 
InStr(LCase(Path),LCase(RsNewsConfigObj("DoMain")))>0)) or 
InStr(LCase(Path),LCase("http://"))=0) Then 
  If InStr(LCase(Path),LCase(BeyondPicDir))>0 and 
((InStr(LCase(Path),LCase("http://"))>0 and 
(InStr(LCase(Path),LCase(GetLoginUrl()))>0 )) or 
InStr(LCase(Path),LCase("http://"))=0) Then 
Dim FSOObj,TempPath,FolderObj,FileObj,ItemObj
Set FSOObj = Server.CreateObject("Scripting.FileSystemObject")
'Path="/fx/Files/BeyondPic/2005/8-21"
'FileName="15-Water.jpg"
TempPath = Server.MapPath(Path)
if ClassEName <> "" then
  TempPath = TempPath & "\" & ClassEName
End If
Set FolderObj = FSOObj.GetFolder(TempPath)
Set FileObj = FolderObj.Files
for Each ItemObj in FileObj
  if InStr(LCase(ItemObj.name),LCase(FileName))>0 then
  'if LCase(ItemObj.name)=LCase(FileName) then
   FSOObj.DeleteFile TempPath & "/" & ItemObj.name
  end if
Next
Set FSOObj = Nothing
  End If 
End Sub

三、在Inc\Function.asp中 添加函数GetLoginUrl() (有添加的此步可以绕过) 

'**************************************************
'过程名：GetLoginUrl()
'作  用：取得当前服务器IP 如：http://127.0.0.1
'参  数：无
'设  计：doudou888 QQ：280106330 主页：http://nhez.chinese.cn.com
'**************************************************
Function GetLoginUrl()
dim temLoginUrl
if Request.ServerVariables("SERVER_PORT")<>"80" then
  temLoginUrl = "http://"
&Request.ServerVariables("LOCAL_ADDR")& ":" & 
Request.ServerVariables("SERVER_PORT")
else
  temLoginUrl = "http://"&Request.ServerVariables("LOCAL_ADDR")
end if
GetLoginUrl=temLoginUrl
End Function

参考来源[ ]

取自“https://www.zzbaike.com/wiki/FoosunCMS-删除下载?oldid=49701”