中国DOS联盟论坛

China DOS Union

-- Unite DOS · Advance DOS · Grow DOS --
Union site: www.cn-dos.net Forum site: www.cn-dos.net/forum
Guest | Log in | Register | Members | Search | China DOS Union
中国DOS联盟论坛
The time now is 2026-09-15 13:35
47,812 topics / 349,917 posts / today 0 new / 48,268 members
DOS批处理 & 脚本技术(批处理室) » Delete thumbnail temporary files → VBS version
Printable Version  1,404 / 3
Floor1 baomaboy Posted 2007-03-18 06:49
银牌会员 Posts 554 Credits 1,513
Originally intended to delete Thumbs.db files generated by the thumbnail viewing method, but modified to allow manually entering the name to search and delete specified files such as virus derivatives_desktop.ini

Note:
Right-clicking on a file performs a search in the current directory and its subdirectories.
Right-clicking on a folder performs a search in the target directory and its subdirectories.

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


Floor2 slore Posted 2007-03-18 07:13
铂金会员 Posts 2,478 Credits 5,212
```vb
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
```
Floor3 electronixtar Posted 2007-03-18 12:43
铂金会员 Posts 2,672 Credits 7,493
I always feel the code is a bit complicated... But it's still good, thumbs up
Floor4 6622186 Posted 2007-04-16 09:50
高级用户 Posts 411 Credits 894
Thumbs.db is originally a thumbnail file, no wonder there is one in each picture folder, so that's how it is.
[ Contact the Union admin team - 中国DOS联盟 - Standard version ]
Sponsored by ifanr Inc | © 2001–2023