本来是用来删除缩略图查看方式生成的Thumbs.db文件的，改了下，可以手工输入名称来实现搜索删除指定文件如病毒衍生物_desktop.ini 注意： 文件右键菜单执行的是搜索当前目录及子目录。 文件夹右键菜单执行的是搜索目标目录及子目录。 zhenlove.com.cn/cndos/fileup/f ...

Dim WshSHell,FSO, keyWord, DirTotal, TimeSpend, FileTotal, delFile, txtResult, txtPath On Error Resume Next Set WshSHell = WScript.Createobject("WScript.Shell") Set FSO = Createobject("Scripting.Filesystemobject") Set WinVer = WshSHell.Environment("Process") Set Args = WScript.Arguments CloseTime = 5 FileName = WScript.ScriptName FileFullName = WScript.ScriptFullName FilePath = FSO.GetParentFolderName(FileFullName) InsPath = FSO.GetSpecialFolder(1) InsFullName = FSO.BuildPath(InsPath ,FileName) LnkPathNT = WshSHell.SpecialFolders(2) LnkPath9X = WshSHell.SpecialFolders(14) LnkPathAll = WshSHell.SpecialFolders("StartMenu") OtherFileName="Thumbs.db" OtherFilePath=FSO.GetSpecialFolder(1) TemFileName = "PathCopyEx.reg" TemFilePath = FSO.GetSpecialFolder(1) Copyright="玲珑科技" QQ="QQ:25926183" Email="Email:fty1995@163.com" InsTitle="删除缩略图临时文件" InsAnswer="删除缩略图临时文件" RegPath1="HKEY_CLASSES_ROOT\Directory\shell\Del_Thumbs\" RegValue1="删除缩略图临时文件" RegForm1="REG_SZ" RegPath2="HKEY_CLASSES_ROOT\Directory\shell\Del_Thumbs\command\" RegValue2="wscript.exe " & Chr(34) & InsFullName & Chr(34) & " " & Chr(34) & "%L" & Chr(34) RegForm2="REG_SZ" RegPath3="HKEY_CLASSES_ROOT\*\shell\Del_Thumbs\" RegPath4="HKEY_CLASSES_ROOT\*\shell\Del_Thumbs\command\" If FileFullName <> InsFullName Then intAnswer = Msgbox("【是】将“"+ InsAnswer +"”加入到右键菜单，"&Chr(10)&Chr(10)&"【否】将“"+ InsAnswer +"”从右键菜单删除。 ", vbQuestion + vbYesNoCancel, "安装 - "+ InsTitle +" - "+ Copyright) If intAnswer = vbYes Then WshSHell.RegWrite RegPath1,RegValue1,RegForm1 WshSHell.RegWrite RegPath2,RegValue2,RegForm2 WshSHell.RegWrite RegPath3,RegValue1,RegForm1 WshSHell.RegWrite RegPath4,RegValue2,RegForm2 FSO.GetFile(FileFullName).Copy(InsFullName) WshSHell.popup "添加脚本文件："+Chr(10)+InsFullName+Chr(10)+Chr(10)+ "添加注册表项："+Chr(10)+Chr(34)+ RegPath3 +Chr(34)+Chr(10)+Chr(34)+ RegPath1 +Chr(34)+Chr(10)+ Chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" +Chr(10)+Chr(10)+ Chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email , CloseTime, "安装成功 - "+ InsTitle +" - "+ Copyright, 0 + 64 End If If intAnswer = vbNo Then WshSHell.RegDelete RegPath4 WshSHell.RegDelete RegPath3 WshSHell.RegDelete RegPath2 WshSHell.RegDelete RegPath1 FSO.DeleteFile InsFullName WshSHell.popup "删除脚本文件："+Chr(10)+InsFullName+Chr(10)+Chr(10)+ "删除注册表项："+Chr(10)+Chr(34)+ RegPath3 +Chr(34)+Chr(10)+Chr(34)+ RegPath1 +Chr(34)+Chr(10)+ Chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" +Chr(10)+Chr(10)+ Chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email , CloseTime, "卸载成功 - "+ InsTitle +" - "+ Copyright, 0 + 64 End If If intAnswer = vbCancel Then End If Else If Args.count="0" Then:WScript.Quit(0):End If FileTotal = 0 DirTotal = 0 If FSO.GetFile(Args(0)).attributes And 16 Then txtPath = Trim(Args(0)) Else txtPath = Trim(FSO.GetParentFolderName(Args(0))) End If 'keyWord = LCase(OtherFileName) keyWord = Lcase(Inputbox("请输入欲删文件名:","文件删除","Thumbs.db")) If keyWord ="" Then WScript.Quit(0) TimeSpend = Timer myFind txtPath TimeSpend = Round(Timer - TimeSpend,2) txtResult = "搜索完成!(用时:" & TimeSpend & "秒.)" & vbCrLf & vbCrLf &"共搜索目录：" & DirTotal & "个." & vbCrLf & "删除Thumbs：" & FileTotal & "个." WshShell.popup Chr(10) & txtResult & Chr(10)+Chr(10)+ Chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" +Chr(10)+Chr(10)+ Chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email , CloseTime, "删除"&OtherFileName&"文件 - "+ InsTitle +" - "+ Copyright, 0 + 64 End If Set WshSHell = Nothing Set FSO = Nothing Set Args = Nothing WScript.Quit(0) Sub myFind(Byval thePath) Dim fso, myFolder, myFile, curFolder Set FSO = Createobject("Scripting.Filesystemobject") Set curFolders = fso.getfolder(thePath) DirTotal = DirTotal + 1 If curFolders.Files.Count > 0 Then For Each myFile In curFolders.Files If Instr(1, Lcase(myFile.Name), keyWord) > 0 Then If FSO.GetFile(FormatPath(thePath) & "\" & myFile.Name).attributes And 1 Then FSO.GetFile(FormatPath(thePath) & "\" & myFile.Name).attributes = FSO.GetFile(FormatPath(thePath) & "\" & myFile.Name).attributes - 1 End If FSO.DeleteFile FormatPath(thePath) & "\" & myFile.Name FileTotal = FileTotal + 1 End If Next End If If curFolders.subfolders.Count > 0 Then For Each myFolder In curFolders.subfolders myFind FormatPath(thePath) & "\" & myFolder.Name Next End If End Sub Function FormatPath(Byval thePath) thePath = Trim(thePath) FormatPath = thePath If Right(thePath, 1) = "\" Then FormatPath = Mid(thePath, 1, Len(thePath) - 1) End Function

总觉得代码复杂了点……还是不错啦，顶

Thumbs.db 原来就缩图文件, 怪不得每个图片文件夹都有, 原来是这么回事.