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