Board logo

标题: [原创] VBS找出本地磁盘中空的东西并删除它们 [打印本页]

作者: ZeroX    时间: 2014-11-7 17:28     标题: VBS找出本地磁盘中空的东西并删除它们

你是不是在磁盘中建立了很多空的文件或文件夹?
你是不是在搜索它们并删除而在发愁?

有了以下这个小程序就可以帮助你解决!

请将以下代码用记事本保存为SearchAndDelete.vbs 文件! 请(不)注(要)意(说)扩(不)展(会)名哦!
  1. '//////////////////////////////
  2. 'Description:这是一个能够删除本地磁盘中空文件夹和空文件的小程序!
  3. 'Author: Zero
  4. '时间: 2014/11/6
  5. '/////////////////////////////
  6. '/// 主程序部分
  7. Dim objfso, WshShell, ext
  8. Set objfso = WScript.CreateObject("Scripting.Filesystemobject")
  9. Set WshShell = CreateObject("Wscript.Shell")
  10. choices =  "1.删除空的文档" & vbCr & "2.删除空的文件夹" & vbCr  & "3.退出"
  11. prompt =  "日志文档保存在 " & "C:\EmptyDelete.log" & vbCrLf & vbCrLf & "单击是(开始),否(退出)!" & vbCrLf & vbCrLf &_
  12.   "(c) Zero 2014"
  13. confirm = MsgBox("本小工具将在本地磁盘上搜索空的东西(文件夹和文件)!"  & vbCr & prompt, vbYesNo +vbInformation + vbdefaultbutton1,"欢迎使用!")
  14. If confirm = vbyes Then
  15. MsgBox "不建议在C盘和D盘使用,错误删除与本作者无关" , vbOKOnly +  vbExclamation ,"提示"
  16. do
  17. getchoice = InputBox ("请输入需要处理的事项:" & vbCr & choices)
  18. if isnumeric(getchoice) then
  19. exit do
  20. else
  21. msgbox "请输入数字"
  22. end If
  23. Loop
  24. getchoice = CInt(getchoice)
  25. Select Case getchoice
  26. Case 1: '搜索空文件
  27. getdrv = InputBox("请输入需要处理的盘符"& "格式如下:  E:\","盘符","E")
  28. getdrv = getdrv & ":\"
  29.    ext = InputBox("请输入需要搜索的文件扩展名"& "比如:txt","扩展名","txt")
  30.   
  31. logfile = "C:\EmptyDelete.log"
  32. set logbook = objfso.OpenTextFile(logfile, 8, true)
  33. Call CheckDiskFile(getdrv,ext)
  34. logbook.Close
  35. WshShell.Popup "检查完毕!" & vbCrLf & "(c) Zero 2014",5, "谢谢使用",vbInformation+vbokOnly
  36. Case 2: '搜索空文件夹
  37. getdrv = InputBox("请输入需要处理的盘符"& "格式如下:  E","盘符","E")
  38. getdrv = getdrv & ":\"
  39. logfile = "C:\EmptyDelete.log"
  40. set logbook = objfso.OpenTextFile(logfile, 8, true)
  41. set drive = objfso.GetDrive(getdrv)
  42. CheckFolder drive.RootFolder
  43. logbook.Close
  44. WshShell.Popup "检查完毕!" & vbCrLf & "(c) Zero 2014",5, "谢谢使用",vbInformation+vbokOnly
  45. End select
  46.      Else If confirm  = vbno Then
  47. MsgBox "你会回来的!" & vbCrLf & "(c) Zero 2014" , vbOKOnly+ vbError,"提示"
  48. WScript.Quit
  49. End If
  50. End If
  51. '/// 主程序部分结束
  52. '/// /////////////////////////////////////////////检查空文件部分开始////////////////////////
  53.   
  54. Function CheckDiskFile(drv,ext)
  55. extTemp = ext
  56. On Error Resume Next
  57.    Dim fso
  58.     Set fso = WScript.CreateObject("Scripting.Filesystemobject")
  59.    
  60.     Set drvRootFiles = fso.GetFolder(drv)
  61.    
  62.     Set files = drvRootFiles.Files
  63.    
  64.     For Each file In files
  65.    
  66.    IsEmptyFile file,extTemp
  67.   
  68. Next
  69. Set subfoldertemp = fso.GetFolder(drv)
  70. Set subfolders = subfoldertemp.SubFolders
  71. For Each subfolder In subfolders
  72. CheckDiskFile subfolder,extTemp '递归
  73. Next
  74.    
  75. End Function
  76. '/// 测试是否为空文件
  77. Sub IsEmptyFile(file,ext)
  78.     On  Error Resume Next
  79.    
  80.     Set fso = CreateObject("Scripting.FileSystemObject")
  81. extFile = fso.GetExtensionName(file)
  82. If file.Size = 0 And extFile = ext  Then
  83. ReportEmpty file
  84. End If
  85. End Sub
  86. '/// 写入日志文件
  87. Function  ReportEmpty(file)
  88.     On Error Resume Next
  89.     response = MsgBox("我们在" & vbCr & file.Path & "发现了空文件," &_
  90. "你想删除吗?", vbYesNo + vbDefaultButton1,"提示")
  91. If vbyes = response Then
  92. logbook.WriteLine vbCrLf
  93. logbook.WriteLine "[文件:]"
  94. logbook.WriteLine  file.Path & vbCrlf & " 在 " & Now & " 被删除"
  95. objfso.DeleteFile file, True
  96. end If
  97. End Function
  98. '/// /////////////////////////////////////////////检查空文件部分结束////////////////////////
  99. '/// /////////////////////////////////////////////检查空文件夹部分开始//////////////////////
  100. sub CheckFolder(folderobj)
  101. on error resume Next
  102. isEmptyFolder folderobj
  103. for each subfolder in folderobj.subfolders
  104. CheckFolder subfolder
  105. Next
  106. end Sub
  107. sub isEmptyFolder(folderobj)
  108. on error resume Next
  109. if folderobj.Size=0 and err.Number=0 then
  110. if folderobj.subfolders.Count=0 Then
  111. ReportEmptyFolder folderobj
  112. end If
  113. end If
  114. end Sub
  115. sub ReportEmptyFolder(folderobj)
  116. on error resume next
  117. lastaccessed = folderobj.DateLastAccessed
  118. on error goto 0
  119. response = MsgBox("我们在:" & vbCr _
  120. & folderobj.path & vbCr & "发现了空文件夹 " & "文件夹最后访问时间:" _
  121. & vbCr & lastaccessed & vbCr _
  122. & "你想删除这个文件夹么?", _
  123. vbYesNoCancel + vbDefaultButton2)
  124. if response = vbYes Then
  125. logbook.WriteLine "[文件夹:]"
  126. logbook.WriteLine  folderobj.path & vbCrlf & " 在 " & Now & " 被删除"
  127. folderobj.delete
  128. elseif response=vbCancel Then
  129. MsgBox "你选择了退出!谢谢使用" & vbCrLf & "(c) Zero 2014"
  130. WScript.Quit
  131. end If
  132. end Sub
  133. '/// /////////////////////////////////////////////检查空文件夹部分结束//////////////////////
复制代码
欢迎大虾给我指出bugs! 谢谢!
作者: shelluserwlb    时间: 2014-11-21 21:02

本帖最后由 shelluserwlb 于 2014-11-21 21:18 编辑

为了阅读程序方便,建议多加些注释以节省看代码和研究代码的时间。
复杂的程序一定要有大量的注释。




欢迎光临 批处理之家 (http://www.bathome.net/) Powered by Discuz! 7.2