中国DOS联盟论坛 - Powered by Discuz! Board

标题: 删除缩略图临时文件→VBS版 [打印本页]

作者: baomaboy 时间: 2007-3-18 06:49 标题: 删除缩略图临时文件→VBS版

本来是用来删除缩略图查看方式生成的Thumbs.db文件的，改了下，可以手工输入名称来实现搜索删除指定文件如病毒衍生物_desktop.ini

注意：
文件右键菜单执行的是搜索当前目录及子目录。
文件夹右键菜单执行的是搜索目标目录及子目录。

http://zhenlove.com.cn/cndos/fileup/files/Del_Thumbs.rar

作者: slore 时间: 2007-3-18 07:13
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

作者: electronixtar 时间: 2007-3-18 12:43
总觉得代码复杂了点……还是不错啦，顶

作者: 6622186 时间: 2007-4-16 09:50
Thumbs.db 原来就缩图文件, 怪不得每个图片文件夹都有, 原来是这么回事.