[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