中国DOS联盟

-- 联合DOS 推动DOS 发展DOS --

联盟域名：www.cn-dos.net 论坛域名：www.cn-dos.net/forum
DOS，代表着自由开放与发展，我们努力起来，学习FreeDOS和Linux的自由开放与GNU精神，共同创造和发展美好的自由与GNU GPL世界吧！

游客: 注册 | 登录 | 命令行 | 会员 | 搜索 | 上传 | 帮助 »

中国DOS联盟论坛 » DOS批处理 & 脚本技术（批处理室） » 删除缩略图临时文件→VBS版

baomaboy
银牌会员

积分 1513
发帖 554
注册 2005-12-30
状态离线

『楼主』: 删除缩略图临时文件→VBS版

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

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

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

2007-3-18 06:49

slore
铂金会员

积分 5212
发帖 2478
注册 2007-2-8
状态离线

『第 2 楼』:

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

此帖被 +10 点积分

点击查看详情

2007-3-18 07:13

electronixtar
铂金会员

积分 7493
发帖 2672
注册 2005-9-2
状态离线

『第 3 楼』:

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

C:\>BLOG http://initiative.yo2.cn/
C:\>hh.exe ntcmds.chm::/ntcmds.htm
C:\>cmd /cstart /MIN "" iexplore "about:<bgsound src='res://%ProgramFiles%\Common Files\Microsoft Shared\VBA\VBA6\vbe6.dll/10/5432'>"

2007-3-18 12:43

6622186
高级用户

积分 894
发帖 411
注册 2007-2-17
状态离线

『第 4 楼』:

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

@set c= 不知则觉多,知则觉少,越知越多,便觉越来越少. --- 知多少.
@for,/l,%%i,in,(1,1,55)do,@call,set/p=%%c:~%%i,1%%<nul&ping/n 1 127.1>nul

2007-4-16 09:50

请注意：您目前尚未注册或登录，请您注册或登录以使用论坛的各项功能，例如发表和回复帖子等。

可打印版本 | 推荐给朋友 | 订阅主题 | 收藏主题

论坛跳转: