admin_uploadlist.asp

功能强大的bbs

	<%=formatdatetime(rs("F_AddTime"),1)%>/
	<FONT COLOR=RED><%=rs("F_ViewNum")%></FONT>/
	<%=rs("F_DownNum")%>
</td>
<td class="forumRowHighlight" align=center><%=filetypename(rs("F_Type"))%></td>
<td class="forumRow" width=20><input type="checkbox" name="delid" value="<%=rs("F_ID")%>" ></td>
</tr>
<%		page_count = page_count + 1
		rs.movenext
		wend
		Pcount=rs.PageCount
	end if 
	rs.close
	if Request("FileSearch")=1 then sql=""
	if Request("FileSearch")=7 and sqlstr="" then sql=""
%>
<input type=hidden value="<%=sql%>" name="delsql">
<tr><th height=25 align=left colspan=8>文件记录库清理操作</th></tr>
<tr>
<td colspan=5 height=25 class="forumRowHighlight"><LI>请选取要删除的文件，然后执行删除操作，<font color=red>附件将直接从服务器上删除并不能恢复！</font></td>
<td colspan=3 height=25 class="forumRowHighlight"><input type="submit" name="Submit" value="执行删除所选文件"></td></tr>
<tr>
<td colspan=5 height=25 class="forumRow"><LI>清理同时是否直接从服务器上删除文件，<font color=red>删除的文件将不能恢复 ！</font></td>
<td colspan=3 height=25 class="forumRow">
<input type=radio name=delfile value=1 >是&nbsp;
<input type=radio name=delfile value=2 checked>否
</td></tr>
<tr>
<td colspan=5 height=25 class="forumRowHighlight"><li>根据当前列表数据进行清理，清除其中所属的帖子已删改的附件。</td>
<td colspan=3 height=25 class="forumRowHighlight">
<input type="submit" name="Submit" value="清理当前列表记录">
</td></tr>
<tr>
<td colspan=5 height=25 class="forumRow"><li>从上传记录中，根据相关发表的帖子内容进行清除所有已删改的附件。</td>
<td colspan=3 height=25 class="forumRow">
<input type="submit" name="Submit" value="清理所有上传记录">
</td></tr>
<tr><th height=25 align=left colspan=8>空间附件清理操作</th></tr>
<tr><td height=25 colspan=8 class="forumRowHighlight">
<li>清除存在服务器空间而没有记录到上传库中的所有上传附件。
<li>请填写清理的上传目录，默认根目录为：“UploadFile”。
<li>目录格式规定：年－月（如：2003-8)。
</td></tr>
<tr><td colspan=5 height=25 class="forumRow">需要清理的上传目录：
<INPUT TYPE="text" NAME="path" Id="path" value="<%=path%>">
<select onchange="Changepath(this.options[this.selectedIndex].value)">
<option value="UploadFile">选取需要清理的目录</option>
<%
Dim uploadpath,ii
for ii=0 to datediff("m","2003-8",now())
uploadpath=DateAdd("m",-ii,now())
uploadpath=year(uploadpath)&"-"&month(uploadpath)
response.write "<option value="""&uploadpath&""">"&uploadpath&"</option>"
next
%>
</select>
</td>
<td colspan=3 height=25 class="forumRow">
<input type="submit" name="Submit" value="清除未记录文件" onclick="{if(confirm('您确定执行的操作吗?将删除所以未有记录的上传文件,并不能恢复。')){this.document.formpost.submit();return true;}return false;}">
</td></tr>
</form>
<SCRIPT LANGUAGE="JavaScript">
<!--
function Changepath(addTitle) {
document.getElementById("path").value=addTitle; 
document.getElementById("path").focus(); 
return; }
//-->
</SCRIPT>
<%
Response.Write "<tr><td class=""forumRowHighlight"" align=center colspan=8>"
call list()
Response.Write "</td></tr></table>"

end sub

SUB LIST()
'分页代码
If totalrec="" Then totalrec=0:Pcount=0
response.write "<table cellspacing=0 cellpadding=0 align=center width=""100%""><form method=post action=""?action=FileSearch"&seachstr&""" ><tr><td width=35% class=""forumRowHighlight"">共<b>"&totalrec&"</b>个文件，共分<b><font color=red>"&Pcount&"</font></b>页：</td><td width=* valign=middle align=right nowrap class=""forumRowHighlight"">"

if currentpage > 4 then
	response.write "<a href=""?action=FileSearch&currentpage=1"&seachstr&""">[1]</a> ..."
end if
if Pcount>currentpage+3 then
	endpage=currentpage+3
else
	endpage=Pcount
end if
for i=currentpage-3 to endpage
	if not i<1 then
		if i = clng(currentpage) then
        response.write " <font color=red><b>["&i&"]</b></font>"
		else
        response.write " <a href=""?action=FileSearch&currentpage="&i&seachstr&""">["&i&"]</a>"
		end if
	end if
next
if currentpage+3 < Pcount then 
	response.write "... <a href=""?action=FileSearch&currentpage="&Pcount&seachstr&""">["&Pcount&"]</a>"
end if
response.write " 转到:<input type=text name=currentpage size=3 maxlength=10  value='"& currentpage &"'><input type=submit value=Go  id=button1 name=button1 >"     
response.write "</td></tr></form></table>"
END SUB

SUB delfiles()
Dim delid,F_filename
if instrRev(path,"/")=0 then path=path&"/"
response.write "<table cellspacing=1 cellpadding=3 align=center class=tableBorder width=""95%""><tr><td>"
delid=replace(Request.form("delid"),"'","")
if delid="" then 
response.write "请选择要删除的文件！"
else
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set rs= Server.CreateObject("ADODB.Recordset")
	sql="select F_id,F_Filename from DV_Upfile where F_ID in ("&delid&")"
	rs.open sql,conn,1
	if not rs.eof then
	response.write "总共删除记录和文件"&rs.recordcount&"个。<br>"
	do while not rs.eof
		if InStr(rs(1),":")=0 or InStr(rs(1),"//")=0 then '判断文件是否本论坛，若不是则采用表中的记录．
			F_filename=path&rs(1)
		else
			F_filename=rs(1)
		end if
		if objFSO.fileExists(Server.MapPath(F_filename)) then
		objFSO.DeleteFile(Server.MapPath(F_filename))
		end if
		Dvbbs.Execute("delete from DV_Upfile where F_ID="&rs(0))
		response.write "已经删除文件"&F_filename&" ！<br>"
	rs.movenext
	loop
	end if
	rs.close
	set rs=nothing
set objFSO=nothing
end if
response.write "</td></tr></table>"
END SUB

'清理所有记录
sub delall()
Server.ScriptTimeout=9999999
response.write "<table cellspacing=1 cellpadding=3 align=center class=tableBorder width=""95%""><tr><td>"
Dim TempFileName
Dim F_ID,F_AnnounceID,F_boardid,F_filename
Dim S_AnnounceID,s_Rootid
Dim drs,delfile
Dim delinfo
delfile=trim(Request.form("delfile"))
if cint(delfile)=1 then
delinfo="已被删除！"
else
delinfo="未被删除！"
end if

if Request.form("delsql")<>"" then
	If Dvbbs.chkpost=False Then
		Dvbbs.AddErrmsg "您提交的数据不合法，请不要从外部提交发言。"
		exit sub
		else
		delsql=Request.form("delsql")
	End If
end if
i=0
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
if delsql="" then
set rs=Dvbbs.Execute("select F_ID,F_AnnounceID,F_BoardID,F_Filename,F_Type from [DV_Upfile] where F_Flag=0 order by F_ID desc ")
else
set rs=Dvbbs.Execute(delsql)
end if
'response.write delsql
if rs.eof then
	response.write "还未有"
else
	do while not rs.eof
	F_ID=rs(0)
	F_boardid=rs(2)
	if InStr(rs(3),":")=0 or InStr(rs(3),"//")=0 then '判断文件是否本论坛，若不是则采用表中的记录．
		F_filename="UploadFile/"&rs(3)
	else
		F_filename=rs(3)
	end if
	'Response.Write Rs("F_Type")&"<br>"
	If Rs("F_Type")<>1 Then		'除图片文件外
		TempFileName="viewfile.asp?ID="&F_ID
	Else
		TempFileName=F_filename
	End If
	TempFileName=Lcase(TempFileName)
	if rs(1)="" or isnull(rs(1)) then
		if InStr(rs(3),":")=0 or InStr(rs(3),"//")=0 then '判断文件是否本论坛，若不是则采用表中的记录．
			if objFSO.fileExists(Server.MapPath(F_filename)) then
				if delfile=1 then
					Dvbbs.Execute("delete from DV_Upfile where F_ID="&F_ID)
					objFSO.DeleteFile(Server.MapPath(F_filename))
				end if
				response.write "文件未写帖子,<a href="&F_filename&" target=""_blank"">"&F_filename&"</a> "&delinfo&"<br>"
			else
				response.write "文件未写帖子,<a href="&F_filename&" target=""_blank"">"&F_filename&"</a> 已不存在！<br>"
			end if
		else
			response.write "外部文件<a href="&F_filename&" target=""_blank"">"&F_filename&"</a> "&delinfo&"<br>"
		end if
		i=i+1
	else
		if isnumeric(rs(1)) then
			S_AnnounceID=rs(1)
		else
			F_AnnounceID=split(rs(1),"|")
			s_Rootid=F_AnnounceID(0)
			S_AnnounceID=F_AnnounceID(1)
		end if
		'Response.Write rs(1)&"<br>"
		If S_AnnounceID="" Then
			Response.Write F_filename &"文件数据有问题<br>"
		Else
		'取出所属帖子表名
		Dim PostTablename
		set drs=Dvbbs.Execute("select PostTable from dv_topic where TopicID="&s_Rootid)
			if not drs.eof then
			PostTablename=drs(0)
			else
			PostTablename=AllPostTable(0)
			end if
		drs.close

		'找出相应的帖子进行判断文件是否存在帖子内容
		'Response.Write "select body from "&PostTablename&" where AnnounceID="&S_AnnounceID&"<br>"
		set drs=Dvbbs.Execute("select body from "&PostTablename&" where AnnounceID="&S_AnnounceID)
		if drs.eof then
			if delfile=1 then
			Dvbbs.Execute("delete from DV_Upfile where F_ID="&F_ID)
			end if
			if objFSO.fileExists(Server.MapPath(F_filename)) then
				if delfile=1 then
				objFSO.DeleteFile(Server.MapPath(F_filename))
				end if
				response.write "帖子未找到,<a href="&F_filename&" target=""_blank"">"&F_filename&"</a> "&delinfo&"<br>"
			else
				response.write "帖子未找到,<a href="&F_filename&" target=""_blank"">"&F_filename&"</a> 已不存在！<br>"
			end if
			i=i+1
		else
			'Response.Write TempFileName&"<br>"
			If Instr(Lcase(drs(0)),TempFileName)=0 Then
				if objFSO.fileExists(Server.MapPath(F_filename)) then
					if delfile=1 then
						objFSO.DeleteFile(Server.MapPath(F_filename))
						Dvbbs.Execute("delete from DV_Upfile where F_ID="&F_ID)
					end if
					response.write "帖子内容不符,<a href="&F_filename&" target=""_blank"">"&F_filename&"</a> "&delinfo&"[<a href=""dispbbs.asp?Boardid="&F_boardid&"&ID="&s_Rootid&"&replyID="&S_AnnounceID&"&skin=1"" target=""_blank"" title=""浏览相关帖子""><font color=red>查看相关讨论</font></a> | <a href=myfile.asp?action=edit&editid="&F_ID&" target=""_blank"" title=""编辑文件""><font color=red>编辑</font></a>]<br>"
				else
					response.write "帖子内容不符,<a href="&F_filename&" target=""_blank"">"&F_filename&"</a> 已不存在！[<a href=""dispbbs.asp?Boardid="&F_boardid&"&ID="&s_Rootid&"&replyID="&S_AnnounceID&"&skin=1"" target=""_blank"" title=""浏览相关帖子""><font color=red>查看相关讨论</font></a> | <a href=myfile.asp?action=edit&editid="&F_ID&" target=""_blank"" title=""编辑文件""><font color=red>编辑</font></a>]<br>"
				end if
				i=i+1
			end if
		end if
		drs.close
		End If
	End If
rs.movenext
loop
end if
rs.close
set drs=nothing
set rs=nothing
set objFSO=nothing

response.write"共清理　"&i&"　个无用文件 ［<a href=?path="&path&" >返回</a>］"
response.write "</td></tr></table>"
end sub


'删除所有未记录到上传库中的文件
sub delall1()
response.write "<table cellspacing=1 cellpadding=3 align=center class=tableBorder width=""95%""><tr><td>"
Dim delfile,delinfo,datepath
delfile=dvbbs.checkStr(trim(Request.form("delfile")))
if cint(delfile)=1 then
	delinfo="目前已被删除！"
else
	delinfo="目前未被删除！"
end if

if instrRev(path,"/")=0 then path=path&"/"
If instr(path,"UploadFile")=0 Then
datepath=path
path="UploadFile/"&path
End If

Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
if objFSO.FolderExists(Server.MapPath(path))=false then
	response.write "路径："&Path&"不存在！"
else
	Set uploadFolder=objFSO.GetFolder(Server.MapPath(path))
	Set uploadFiles=uploadFolder.Files
	i=0
	For Each Upname In uploadFiles
		upfilename=path&upname.name
		'Response.Write "select top 1 F_ID from DV_Upfile where F_Filename = '"&datepath&upname.name&"'<br>"
		set rs=Dvbbs.Execute("select top 1 F_ID from DV_Upfile where F_Filename = '"&datepath&upname.name&"'")
		if rs.eof then
			i=i+1
			if delfile=1 then
			objFSO.DeleteFile(Server.MapPath(upfilename))
			end if
			response.write "<a href="&upfilename&" target=""_blank"">"
			response.write upfilename&"</a>在库中没有记录！"&delinfo&"<br>"
		end if
		rs.close
		set rs=nothing
	next
	response.write"共删除　"&i&"　个无用文件 ［<a href=?path="&path&" >返回</a>］"
	set uploadFolder=nothing
	set uploadFiles=nothing
end if
set objFSO=nothing
response.write "</td></tr></table>"
end sub

function folder(path)
on error resume  next
       Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
          Set uploadFolder=objFSO.GetFolder(Server.MapPath(path))
		  if err.number<>"0" then
		  response.write Err.Description
		  response.end
		  end if
          For Each UpFolder In uploadFolder.SubFolders
            response.write "『<A HREF=?path="&path&"/"&upfolder.name&" >"&upfolder.name&"</a>』 | "
next
set uploadFolder=nothing
end function

function procGetFormat(sName)
 Dim str
 procGetFormat=0
 if instrRev(sName,".")=0 then exit function
 str=lcase(mid(sName,instrRev(sName,".")+1))
 for i=0 to uBound(sFor,1)
  if str=sFor(i,0) then 
    procGetFormat=sFor(i,1)
    exit for
  end if
 next
end function

function filetypename(stype)
if isempty(stype) or not isnumeric(stype) then exit function
select case cint(stype)
case 1
filetypename="图片集"
case 2
filetypename="FLASH集"
case 3
filetypename="音乐集"
case 4
filetypename="电影集"
case else
filetypename="文件集"
end select 
end function

function getsize(size)
if isEmpty(size) then exit function
	if size>1024 then
 		   size=(size\1024)
 		   getsize=size & "&nbsp;KB"
	else
		   getsize=size & "&nbsp;B"
 	end if
 	if size>1024 then
 		   size=(size/1024)
 		   getsize=formatnumber(size,2) & "&nbsp;MB"		
 	end if
 	if size>1024 then
 		   size=(size/1024)
 		   getsize=formatnumber(size,2) & "&nbsp;GB"	   
 	end if   
end function
%>