[UMU WSH 教程](42) FSO 应用实例 - 批量删除文件

[UMU WSH 教程](41) 利用 WinHttp.WinHttpRequest.5.1 对象下载文件

UMU WSH 教程代码下载： http://sdrv.ms/ZpPPaS

UMU WSH Git：http://git.oschina.net/umu618/umu-wsh

 

　　使用 VS 的程序员应该都知道，VS 会产生大量临时文件，不少人打包时，经常连这些垃圾都打包进去，导致不必要的增大压缩包……UMU 大学时就写了这个脚本，经历了 VS6 到 VS2012 的变迁，目前还偶尔会用一下这个脚本。

' 42_DelVBVCTempFile.VBS
' UMU @ 0:00 2012/10/14
' [UMU WSH 教程](42) FSO 应用实例 - 批量删除文件
Option Explicit

On Error Resume Next

Const NUM = 20
Const APP_TITLE = "UMU.Script.Tools.DelVBVCTempFiles"

Dim objArgs, objFSO

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objArgs = WScript.Arguments

If objArgs.Count = 0 Then
    MsgBox "本程序用来删除 VB & VC 产生无关代码的记录文件。" & vbCrLf & _
        "请把要处理的文件夹拖放到本程序的图标上！", 4160, APP_TITLE
    Set objArgs = Nothing

    Dim objWSH
    Dim szSendto, szCopyTo

    Set objWSH = CreateObject( "WScript.Shell" )
    szSendto = objWSH.SpecialFolders("SendTo")
    szCopyTo = szSendto & "\DelVBVCTempFiles_1.1.4.VBE"

    If Not objFSO.FileExists(szCopyTo) Then
        If vbOK = MsgBox("提示：您可以把此文件放在 Sendto 目录里，然后使用右键菜单的“发送到”。" & vbCrLf & _
            "您的 Sendto 目录是 " & szSendto & vbCrLf & "按“确定”执行复制操作。", _
            vbOKCancel + vbInformation, APP_TITLE) Then
            
            objFSO.CopyFile WScript.ScriptFullName, szCopyTo

            If vbYes = MsgBox("是否查看 Sendto 目录？", vbQuestion + vbYesNo, APP_TITLE) Then
                objWSH.Run "%SystemRoot%\explorer.exe /n, /select," & szCopyTo
            End If
        End If
    End If

    Set objFSO = Nothing
    Set objWSH = Nothing

    WScript.Quit
End If

Dim ar, i, nCount, g_szExt(20), szErrDel

g_szExt(0) = ".ncb"
g_szExt(1) = ".plg"
g_szExt(2) = ".opt"
g_szExt(3) = ".dep"
g_szExt(4) = ".mak"
g_szExt(5) = ".obj"
g_szExt(6) = ".pch"
g_szExt(7) = ".idb"
g_szExt(8) = ".ilk"
g_szExt(9) = ".pdb"
g_szExt(10) = ".res"
g_szExt(11) = ".aps"
g_szExt(12) = ".GID"
g_szExt(13) = ".suo"
g_szExt(14) = ".scc"
g_szExt(15) = ".sbr"
g_szExt(16) = ".user"
g_szExt(17) = ".intermediate.manifest"
g_szExt(18) = ".exp"
g_szExt(19) = ".embed.manifest"
g_szExt(20) = ".old"

szErrDel = "BuildLog.htm、Thumbs.db 和" & vbCrLf & "下面后缀名的文件将被删除：" & vbCrLf & vbCrLf

For i = 0 To NUM
    szErrDel = szErrDel & g_szExt(i) & vbCrLf
Next

szErrDel = szErrDel & vbCrLf & "确定吗？"

If vbCancel = MsgBox(szErrDel, vbOKCancel + vbSystemModal + vbQuestion, APP_TITLE) Then
    Set objArgs = Nothing
    WScript.Quit
End If

nCount = 0
szErrDel = ""

For Each ar In objArgs
    If objFSO.FolderExists(ar) Then
        Call DeleteUseless(ar)
    ElseIf objFSO.FileExists(ar) Then
        If IsRubbish(objFSO.GetFileName(ar)) Then
            objFSO.DeleteFile ar, 1
            nCount = nCount + 1
        End If
    End If
Next
MsgBox "总共删除文件 " & nCount & " 个！" & vbCrLf & "下面是没删除的文件：" & szErrDel, 4160, "整个世界清净了！"

Private Function IsRubbish( ByVal szFileName )
    If StrComp(szFileName, "Thumbs.db", 1) = 0 Then
        IsRubbish = True
        Exit Function
    End If

    If StrComp(szFileName, "BuildLog.htm", 1) = 0 Then
        IsRubbish = True
        Exit Function
    End If

    Dim szExt, i, nLen

    For i = 0 To NUM
        nLen = Len(g_szExt(i))
        If Len(szFileName) > nLen Then
            szExt = Right( szFileName, nLen )
            If StrComp(szExt, g_szExt(i), 1) = 0 Then
                IsRubbish = True
                Exit Function
            End If
        End If
    Next

    IsRubbish = False
End Function

Private Sub DeleteUseless( ByVal fd )
    On Error Resume Next

    Dim rfd, fs, f, fds, p, nf

    Set rfd = objFSO.GetFolder(fd)
    Set fs = rfd.Files

    For Each f In fs
        If IsRubbish(f.Name) Then
            f.Delete 1
            If Err.Number Then
                szErrDel = szErrDel & vbCrLf & f.Path
                Err.Clear
            Else
                nCount = nCount + 1
            End If
        End If
    Next

    Set fds = rfd.SubFolders

    For Each fd In fds
        DeleteUseless fd.Path
    Next
End Sub