```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
```
Recent Ratings for This Post
( 2 in total)
Click for details