中国DOS联盟论坛

中国DOS联盟

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

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

游客:  注册 | 登录 | 命令行 | 会员 | 搜索 | 上传 | 帮助 »
作者:
标题: 删除缩略图临时文件→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 点积分         点击查看详情   
评分人:【 jmz573515 分数: +8  时间:2007-3-18 08:38
评分人:【 baomaboy 分数: +2  时间:2007-3-18 10:00


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
查看资料  发短消息 网志   编辑帖子  回复  引用回复

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


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



论坛跳转: