<!--#include file="conn.asp"-->
<!--#include file="check.asp"-->

<% 
 '===========================================================================================
	'软件名称：126 cms 视频影视管理系统
	'程序版权：126电影               '咨询QQ：479025
	'开发作者：magicblack(479025)    '官方网站：http://www.126oo.com/
	'Copyright (C) 2009 - ... 126oo.com  All Rights Reserved.
	'郑重声明:
	'    1、免费版本请在程序首页保留版权信息，并做上本站LOGO友情连接,商业版本无此要求;
	'    2、任何个人或组织不得以盈利为目的发布,修改,本软件及其他副本上一切关于版权的信息；
	'    3、126电影保留此软件的法律追究权利；
'==========================================================================================
%>

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3c.org/TR/1999/REC-html401-19991224/loose.dtd">
<HTML xmlns="http://www.w3.org/1999/xhtml">
<HEAD>
<TITLE>无效图片管理 - 后台管理中心 - 126电影程序CMS</TITLE>
<META http-equiv=Content-Type content="text/html; charset=gb2312">
<LINK href="images/css_body.css" type=text/css rel=stylesheet>
<script language="javascript" src="images/admin.js"></script>
</HEAD>
<BODY>
<DIV class=bodytitle>
<DIV class=bodytitleleft></DIV>
<DIV class=bodytitletxt>无效图片管理</DIV>
<DIV class=bodytitletxt2></DIV>
</DIV>
<%
response.Charset="GBK"
dim action
action = SafeData("RQ","action",0)

Select case action
	case "edit" : edit
	case else : main
End Select

sub main
%>
<TABLE width="96%" border=0 align=center cellpadding="5" cellSpacing=1 class=tbtitle style="BACKGROUND: #cad9ea;">
<form method=POST action="?action=edit" >
<TBODY>
  <TR bgColor="#f5fafe">
   <td width="105" height="89" style="padding-left:25px;font-weight:bold;">
   	<strong>检测说明：</strong>
   </td>
   <td  style="padding-left:20px;line-height:180%;">
   <strong>
    （1）本功能用于检测上传图片存放文件夹的安全，防止多余图片占用空间和ASP木马文件隐藏；<br>
    （2）根据是否在数据库中有记录表明该图片是否多余占用空间；<br>
    （3）读取判断文件内容，防止ASP木马隐藏在此文件夹中。
   </strong>
   </td>
  </tr>
  <TR bgColor="#f5fafe">
   <td height="39" align="right" class="hback"> </td>
   <td >
      &nbsp;&nbsp; &nbsp;
      <input name="Submit"  type="submit" class="STYLE1" value="开始检测拉圾图片">   </td>
  </tr>
  </TBODY>
</form>
</table>
<BR>
<%
end sub

sub edit
	ListFolderContents Server.mappath("../uploadimg/")
end sub

sub ListFolderContents(path)
dim fs,folder,Item,url,urll,fstream,tempurl

set fs = CreateObject("Scripting.FileSystemObject")
set folder = fs.GetFolder(path)
'显示目标文件夹信息
response.Write "<b>&nbsp;<font color='#ff0000'>" & folder.Name & " >> 共&nbsp;" & folder.Files.Count & " 个文件 >> 大小:"
response.flush
if folder.SubFolders.Count > 0 then
  response.Write folder.SubFolders.Count & " 文件夹, "
  response.flush
end if
response.Write Round(folder.Size / 1024) & " KB "
response.Write "</b></font>" 
response.Write "</br>" 
response.flush

'显示子文件夹
for each item in folder.SubFolders
  ListFolderContents(item.Path)
next
'显示文件
for each item in folder.Files
  url = MapURL(item.path)
 	
	if app_installdir <> "/" then
		tempurl = Replace(url,app_installdir, "")
	else
		tempurl = Right(url, Len(url)-1)
	end if

	
	Dim rs : Set rs = Database.GetRecordDetail("Tbl_Datas","D_Pic like '%" & tempurl &"%'")  
	  fstream = (instr(LoadFiles(url),"server")>0 or instr(LoadFiles(url),"file")>0)
	  if fstream then
	   response.Write "&nbsp;<a href="""&url&""" target=_blank>"&item.Name&"</a> - " & item.Size & " 字节,修改时间 " & item.DateLastModified & ""
	   response.flush
	   response.write " - <font color=blue>该文件为非正常图片数据，已经删除</font><br>"
	   DeleteFiles url
	  end if
	  
	  if rs.eof then
	   Response.Write "&nbsp;<a href="""&url&""" target=_blank>"&item.Name&"</a> - " & item.Size & " 字节,修改时间 " & item.DateLastModified & ""
	   response.flush
	   response.write " - <font color=red>数据库中不存在，已经删除</font><br>"
	   DeleteFiles url
	  end if
	Database.C(rs)
	response.flush
next

response.flush
end sub

'转换物理地址成超链地址
function MapURL(path)
	dim rootPath,url
	rootPath = Server.MapPath("/")
	url = Right(path, Len(path) - Len(rootPath))
	MapURL = Replace(url, "\", "/")

end function 

Function LoadFiles(ByVal File)
    Dim objStream
    On Error Resume Next
    Set objStream = Server.CreateObject("ADODB.Stream")
    If Err.Number=-2147221005 Then 
        Response.Write "<div align='center'>非常遗憾,您的主机不支持ADODB.Stream,不能使用本程序</div>"
        Err.Clear
        Response.End
    End If
    With objStream
        .Type = 2
        .Mode = 3
        .Open
        .LoadFromFile Server.MapPath(File)
        If Err.Number<>0 Then
    Response.Write "<div align='center'>文件<font color='#ff0000'>"&File&"</font>无法被打开，请检查是否存在!</font></div>"
    Err.Clear
    Response.End
        End If
        .Charset = "GB2312"
        .Position = 2
        LoadFiles = .ReadText
        .Close
    End With
    Set objStream = Nothing
End Function

function DeleteFiles(ByVal File)
	dim fso,path,source,destination
	set fso=server.createObject("scripting.fileSystemObject")
	path=server.mapPath(File)
	
	if fso.fileExists(path) then
	  fso.deleteFile(path)
	end if 
	set fso=nothing
end function
%>
</body>
</html>
