看看这个代码谁有！

[dyii2005]

小弟有一个小站 用的是100M虚拟主机 现在由于无用附件过多（附件小而多）造成空间紧张，小弟手动清理很是麻烦！

请高手给个自动清理代码！


我自动清理是这样的


我有一个数据库 的 表是news 字段是fujian 里面记录了附件地址 例如 upfile/20080930111335.rar （每个字段就记录一个地址）



我的附件存放目录是 ../upfile


我现在想做到是 检测 表news 的字段 fujian 所有数据，与upfile文件夹内的文件做比较，upfile文件夹内多于的文件 全部自动删除了（我虚拟机支持FSO）


麻烦给个完整代码，我原先都是手动清理，太累了！ 谢谢大家了 祝1/10快乐！

[dyii2005]

看了看动易的清理代码，我不会提取


Sub Clear()
Response.Write "<br><table width='100%' border='0' cellspacing='1' cellpadding='2' class='border'>"
Response.Write " <tr class='title'>"
Response.Write " <td height='22' align='center'><strong>清理无用的上传文件</strong></td>"
Response.Write " </tr>"
Response.Write " <tr class='tdbg'>"
Response.Write " <td height='150'>"
Response.Write "<form name='form1' method='post' action='Admin_UploadFile_Clear.asp'>"
Response.Write "    在添加内容时，经常会出现上传了图片后但却最终没有使用的情况，时间一久，就会产生大量无用垃圾文件。所以需要定期使用本功能进行清理。"
Response.Write "<p>    如果上传文件很多，或者信息数量较多，执行本操作需要耗费相当长的时间，请在访问量少时执行本操作。</p>"
Response.Write "<p align='center'><input name='Action' type='hidden' id='Action' value='DoClear'><input name='ChannelID' type='hidden' id='ChannelID' value='" & ChannelID & "'>"
Response.Write "<input name='UploadDir' type='hidden' value='" & tUploadDir & "'><input name='CurrentDir' type='hidden' value='" & CurrentDir & "'><input type='submit' name='Submit3' value=' 开始清理 '></p>"
Response.Write "</form>"
Response.Write " </td>"
Response.Write " </tr>"
Response.Write "</table>"
End Sub


Dim rs, sql
Select Case ModuleType
Case 1
strDirName = ChannelName & "的上传文件"
sql = "select UploadFiles,Intro from PE_Article where ChannelID=" & ChannelID
Set rs = Conn.Execute(sql)
Do While Not rs.EOF
If rs(0) <> "" Then
strFiles = strFiles & "|" & rs(0)
End If
If rs(1) <> "" Then
ItemIntro = ItemIntro & "|" & rs(1)
End If
rs.MoveNext
Loop
Case 2
If tUploadDir = "UploadSoftPic" Then
UploadDir = "UploadSoftPic"
strDirName = ChannelName & "的软件图片"
sql = "select SoftPicUrl,SoftIntro from PE_Soft where ChannelID=" & ChannelID
Set rs = Conn.Execute(sql)
Do While Not rs.EOF
If rs(0) <> "" Then
strFiles = strFiles & "|" & rs(0)
End If
If rs(1) <> "" Then
ItemIntro = ItemIntro & "|" & rs(1)
End If
rs.MoveNext
Loop
Else
strDirName = ChannelName & "的上传软件"
sql = "select DownloadUrl from PE_Soft where ChannelID=" & ChannelID
Set rs = Conn.Execute(sql)
Do While Not rs.EOF
If rs(0) <> "" Then
strFiles = strFiles & "$$$" & rs(0)
End If
rs.MoveNext
Loop
End If
Case 3
strDirName = ChannelName & "的上传图片"
sql = "select PhotoThumb,PhotoUrl,PhotoIntro from PE_Photo"
Set rs = Conn.Execute(sql)
Do While Not rs.EOF
If rs(0) <> "" Then
strFiles = strFiles & "$$$" & rs(0)
End If
If rs(1) <> "" Then
strFiles = strFiles & "$$$" & rs(1)
End If
If rs(2) <> "" Then
ItemIntro = ItemIntro & "|" & rs(2)
End If
rs.MoveNext
Loop
Case 5
strDirName = ChannelName & "的上传图片"
sql = "select UploadFiles from PE_Product where ChannelID=" & ChannelID
Set rs = Conn.Execute(sql)
Do While Not rs.EOF
If rs(0) <> "" Then
strFiles = strFiles & "|" & rs(0)
End If
rs.MoveNext
Loop

**************省去


strFiles = LCase(strFiles)

RootDir = InstallDir & ChannelDir & "/" & UploadDir
strPath = RootDir
strPath2 = UploadDir
strPath3 = ""
If ParentDir <> "" Then
strPath = strPath & "/" & ParentDir
strPath2 = strPath2 & "/" & ParentDir
strPath3 = ParentDir
End If
If CurrentDir <> "" Then
strPath = strPath & "/" & CurrentDir
strPath2 = strPath2 & "/" & CurrentDir
If ParentDir <> "" Then
strPath3 = strPath3 & "/" & CurrentDir & "/"
Else
strPath3 = CurrentDir & "/"
End If
End If
strPath = Replace(strPath, "//", "/")
strPath2 = Replace(strPath2, "//", "/")
TruePath = Server.MapPath(strPath)

i = 0
If fso.FolderExists(Server.MapPath(InstallDir & ChannelDir & "/" & UploadDir)) = False Then
FoundErr = True
ErrMsg = ErrMsg & "<li>找不到文件夹！请上传文件后再进行管理！</li>"
Exit Sub
End If

Set theFolder = fso.GetFolder(Server.MapPath(InstallDir & ChannelDir & "/" & UploadDir))
For Each theFile In theFolder.Files
If InStr(strFiles, LCase(theFile.name)) <= 0 Then
theFile.Delete True
i = i + 1
End If
Next
For Each theSubFolder In theFolder.SubFolders
For Each theFile In theSubFolder.Files
If InStr(strFiles, LCase(theSubFolder.name & "/" & theFile.name)) <= 0 Then
theFile.Delete True
i = i + 1
End If
Next
Next

Call WriteSuccessMsg("清理无用文件成功！共删除了 <font color=red><b>" & i & "</b></font> 个无用的文件。", ComeUrl)
End Sub
%>

最好我们也能来个，计算清理了多少文件的功能！ 呵呵

[Anlige]

原理都明白你不是写代码？？？？？
fso+adodb

[dyii2005]

我知道原理，可是我写的总有错误！

语法我不会， 麻烦大家了！

[iasky]

慢慢就会了。

[dyii2005]

嗯 应该买本书看看了！

可是在这之前，能帮忙写下这个吗？

表 News

附件字段 fujian

要是存在数据 值的格式：upfile/20080930111335.rar

附件存放目录： 根目录的 upfile 文件夹

我想做到 fujian 字段文件名upfile/后的 与 upfile文件夹内 存在的文件对比

没有记录就删除了！

最好给个计算删除了几个！ 呵呵

麻烦大家了，10/1过后买本书 好好看看！ 可是现在……

[dyii2005]

高手都放假了？ 呵呵！

[dyii2005]

[Quote=引用 4 楼 iasky 的回复:]
慢慢就会了。
[/Quote]


看了看你别的帖子的回复 发现你真能混！

说的都是废话，没有用的！ 佩服

[zanbije]

把你的代码改改,就行了,没必要叫别人写:L

我不是高手,自己用的程序都是向人家买呢?/今天跟别人买了一个笑话站...嘻嘻;L

[dyii2005]

LS的，我不知道说你什么好！

我的代码改改？ 改哪个？ 你看明白那个代码了？

哎，一会结帖吧 这现在真……

[13617650029]

<%

sub DeleteOneFile (FilePathName)
'删除一个文件(文件路径)-----------------------------------
FilePathName=Server.Mappath(FilePathName)
dim fs
Set fs = server.CreateObject("Scripting.FileSystemObject")
if trim(FilePathName)<>"" and fs.FileExists(FilePathName) then
fs.DeleteFile FilePathName
end if
set fs=nothing
end Sub

set fso = server.createobject("scripting.filesystemobject")
path = server.mappath("upfile")
set fod = fso.getfolder(path)
del = 0
Set files = fod.files
for each file in fod.files
Set Rs = Server.Createobject("Adodb.recordset")
sql = "Select count(*) From News Where fujian='upfile/"&file.name&"'"
rs.open sql,conn,1,1
If rs(0) = 0 Then
DeleteOneFile("upfile/"&file.name)
del = del + 1
End If
rs.close
Set rs = nothing
next
response.write "文件清理完毕！<br> 共删除了 "&del&" 个文件"
set fod=nothing
set fso=nothing
%>

[13617650029]

<%

sub DeleteOneFile (FilePathName)
'删除一个文件(文件路径)-----------------------------------
FilePathName=Server.Mappath(FilePathName)
dim fs
Set fs = server.CreateObject("Scripting.FileSystemObject")
if trim(FilePathName)<>"" and fs.FileExists(FilePathName) then
fs.DeleteFile FilePathName
end if
set fs=nothing
end Sub

set fso = server.createobject("scripting.filesystemobject")
path = server.mappath("upfile")
set fod = fso.getfolder(path)
del = 0
i = 0
Set files = fod.files
for each file in fod.files
i = i + 1
if i=100 then exit for
Set Rs = Server.Createobject("Adodb.recordset")
sql = "Select count(*) From News Where fujian='upfile/"&file.name&"'"
rs.open sql,conn,1,1
If rs(0) = 0 Then
DeleteOneFile("upfile/"&file.name)
del = del + 1
End If
rs.close
Set rs = nothing
next
response.write "文件清理完毕！<br> 共删除了 "&del&" 个文件"
set fod=nothing
set fso=nothing
%>

[13617650029]

忽略了一点，后面给你的这个是每次只检查100个文件，但这样如果前面超过100个文件有用，就不行了，稍微改一下就好了

[13617650029]

<%

sub DeleteOneFile (FilePathName)
'删除一个文件(文件路径)-----------------------------------
	FilePathName=Server.Mappath(FilePathName)
	dim fs
	Set fs = server.CreateObject("Scripting.FileSystemObject")
	if trim(FilePathName)<>"" and fs.FileExists(FilePathName) then
		fs.DeleteFile FilePathName
	end if
	set fs=nothing
end Sub

set fso   = server.createobject("scripting.filesystemobject") 
path      = server.mappath("upfile")
set fod   = fso.getfolder(path) 
del       = 0
Set files = fod.files
for each file in fod.files 
        if del=100 then exit for
	Set Rs = Server.Createobject("Adodb.recordset")
	sql    = "Select count(*) From News Where fujian='upfile/"&file.name&"'"
	rs.open sql,conn,1,1
	If rs(0) = 0 Then
		DeleteOneFile("upfile/"&file.name)
		del = del + 1
	End If 
	rs.close
	Set rs = nothing
next 
response.write "文件清理完毕！<br> 共删除了 "&del&" 个文件"
set fod=nothing 
set fso=nothing 
%>

用这个吧，给你改好了，每次只删除100个文件，多执行几次，什么时候提示你删除0个文件，就是清理完毕了，考虑一次执行所有文件可能会超时，所以帮你改了一下

[dyii2005]

呵呵。谢谢LS的兄弟了。

太感谢您了。不知道说什么好！


CSDN多几位您这样的就好了，结帖加分！