标题:
删除缩略图临时文件→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 原来就缩图文件, 怪不得每个图片文件夹都有, 原来是这么回事.
欢迎光临 中国DOS联盟论坛 (http://cndos.fam.cx/forum/)
Powered by Discuz! 2.5