用VBS脚本删除指定以外的文件或文件夹

option explicit

''''''''''''''说明''''''''''''
'网盟-黑火制作，送给需要的朋友。
'配置文件“listfile.ini”的格式如下：
'要删除什么(文件|目录)=要执行删除的文件夹=排除1;排除2;排除3............
'配置文件可以有多行，以便对多个目录进行操作。
'配置文件里以“/”开头的行为注释行。
'排除多个内容时，使用分号“;”进行分隔。
'↓↓↓ 配置文件例子：↓↓↓
'/配置文件开始
'目录=d:\=system volume information;网络游戏;单机游戏;小游戏
'目录=c:\program files=qq;winrar
'文件=d:\网络游戏=文件1.exe;文件2.exe
'/配置文件结束
'''''''''''''说明完''''''''''''

dim fso,listfile,objlistfile
listfile = ""           '设置配置文件路径,如果配置文件和脚本放在一起，请保持原样

if listfile = "" then listfile = "listfile.ini"
set fso = createobject("scripting.filesystemobject")
on error resume next
set objlistfile = fso.opentextfile(listfile,1)
if err then
     err.clear
     msgbox "没有找到配置文件 "&listfile,16,"错误"
     wscript.quit
end if
on error goto 0

dim flnum,fdnum,t1,t2,tm
flnum=0
fdnum=0
t1 = timer()

dim myline,linearr,listarr
do while objlistfile.atendofstream <> true
     myline = lcase(replace(objlistfile.readline,"==","="))
     if left(myline,1) = "/" then
     'objlistfile.skipline
     elseif checkline(myline) = 2 then
         linearr = split(myline,"=")
         'dofolder = linearr(1)
         listarr = split(linearr(2),";")
   'msgbox linearr(0)
         if linearr(0) = "目录" then delfolder linearr(1),listarr
         if linearr(0) = "文件" then delfile linearr(1),listarr
     end if
loop

t2 = timer()
tm=cstr(int(( (t2-t1)*10000 )+0.5)/10)

msgbox "扫描完毕，共删除 "&fdnum&" 个目录, "&flnum& "个文件。"& vbcrlf &"耗时 "&tm&" 毫秒",64,"执行完毕"
'不需要显示报告的话，注释掉上面这一行

set fso=nothing
wscript.quit

sub delfolder(folder,listarr)
dim objfolder,subfolders,subfolder
     set objfolder=fso.getfolder(folder)
     set subfolders=objfolder.subfolders
     for each subfolder in subfolders
     if not inarray(listarr,lcase(subfolder.name)) then
     on error resume next
         subfolder.delete(true)
         if err then
             err.clear
             msgbox "不能删除目录，请检查 "&subfolder,16,"错误"
         else
         fdnum = fdnum + 1
         end if
         on error goto 0
     end if
     next
end sub

sub delfile(folder,listarr)
dim objfolder,files,file
     set objfolder=fso.getfolder(folder)
     set files=objfolder.files
     for each file in files
     if not inarray(listarr,lcase(file.name)) then
     on error resume next
         file.delete(true)
         if err then
             err.clear
             msgbox "不能删除文件，请检查 "&file,16,"错误"
         else 
         flnum = flnum + 1
         end if
         on error goto 0
     end if
     next
end sub

function checkline(strline)
dim lineregexp,matches
set lineregexp = new regexp
lineregexp.pattern = ".=."
lineregexp.global = true
set matches = lineregexp.execute(strline)
checkline = matches.count
end function

function inarray(myarray,strin)
dim strtemp
inarray = true
for each strtemp in myarray
     if strin = strtemp then
         exit function
         exit for
     end if
next
inarray = false
end function