'//////////////////////////////
'Description:这是一个能够删除本地磁盘中空文件夹和空文件的小程序！
'Author: Zero
'时间: 2014/11/6
'/////////////////////////////

'/// 主程序部分
Dim objfso, WshShell, ext
Set objfso = WScript.CreateObject("Scripting.Filesystemobject")
Set WshShell = CreateObject("Wscript.Shell")

choices =  "1.删除空的文档" & vbCr & "2.删除空的文件夹" & vbCr  & "3.退出"
prompt =  "日志文档保存在 " & "C:\EmptyDelete.log" & vbCrLf & vbCrLf & "单击是(开始)，否(退出)！" & vbCrLf & vbCrLf &_
		  "(c) Zero 2014"


confirm = MsgBox("本小工具将在本地磁盘上搜索空的东西(文件夹和文件)!"  & vbCr & prompt, vbYesNo +vbInformation + vbdefaultbutton1,"欢迎使用！")
If confirm = vbyes Then

	MsgBox "不建议在C盘和D盘使用，错误删除与本作者无关" , vbOKOnly +  vbExclamation ,"提示"

 	 	
 	
 	
 	
 	do
	getchoice = InputBox ("请输入需要处理的事项:" & vbCr & choices)
	
	if isnumeric(getchoice) then
		exit do
	else
		msgbox "请输入数字"
	end If
	
	Loop
	
	getchoice = CInt(getchoice)
	
	Select Case getchoice
	
	Case 1: '搜索空文件
	
		getdrv = InputBox("请输入需要处理的盘符"& "格式如下:  E:\","盘符","E")
		getdrv = getdrv & ":\"
  		ext = InputBox("请输入需要搜索的文件扩展名"& "比如：txt","扩展名","txt")
  		
		logfile = "C:\EmptyDelete.log"
		
		set logbook = objfso.OpenTextFile(logfile, 8, true)

		Call CheckDiskFile(getdrv,ext)
	
		logbook.Close
		
		WshShell.Popup "检查完毕！" & vbCrLf & "(c) Zero 2014",5, "谢谢使用",vbInformation+vbokOnly
		
	Case 2: '搜索空文件夹
	
	getdrv = InputBox("请输入需要处理的盘符"& "格式如下:  E","盘符","E")
	getdrv = getdrv & ":\"
	logfile = "C:\EmptyDelete.log"
	set logbook = objfso.OpenTextFile(logfile, 8, true)

	set drive = objfso.GetDrive(getdrv)

	CheckFolder drive.RootFolder 
	
	logbook.Close

		WshShell.Popup "检查完毕！" & vbCrLf & "(c) Zero 2014",5, "谢谢使用",vbInformation+vbokOnly
		
		
	
	End select
 
 	
		

     Else If confirm  = vbno Then
 		MsgBox "你会回来的！" & vbCrLf & "(c) Zero 2014" , vbOKOnly+ vbError,"提示"
 		
 		WScript.Quit
 	
 		End If
 	
 	End If
 	
 	
'/// 主程序部分结束

'/// /////////////////////////////////////////////检查空文件部分开始////////////////////////
  	
Function CheckDiskFile(drv,ext)
	extTemp = ext

	On Error Resume Next 
  	Dim fso
   	Set fso = WScript.CreateObject("Scripting.Filesystemobject")
   	
   	Set drvRootFiles = fso.GetFolder(drv)
   	
   	Set files = drvRootFiles.Files
   	
   		For Each file In files
   	
  			IsEmptyFile file,extTemp
  	
 		Next
 		
 	Set subfoldertemp = fso.GetFolder(drv)
 		
 	Set subfolders = subfoldertemp.SubFolders
 		
 	For Each subfolder In subfolders 
 		
 	CheckDiskFile subfolder,extTemp '递归
 		
 		Next 
   	
 	
End Function

'/// 测试是否为空文件
Sub IsEmptyFile(file,ext)

    On  Error Resume Next
    
    Set fso = CreateObject("Scripting.FileSystemObject")

	extFile = fso.GetExtensionName(file)
	
	If file.Size = 0 And extFile = ext  Then
	
	ReportEmpty file

	End If
	
	
End Sub 

'/// 写入日志文件
Function  ReportEmpty(file)
    On Error Resume Next

    response = MsgBox("我们在" & vbCr & file.Path & "发现了空文件," &_
					"你想删除吗？", vbYesNo + vbDefaultButton1,"提示")
					
	If vbyes = response Then
	
		logbook.WriteLine vbCrLf
		logbook.WriteLine "[文件:]"
		
		logbook.WriteLine  file.Path & vbCrlf & " 在 " & Now & " 被删除"
		objfso.DeleteFile file, True
	

	end If
 	
End Function

'/// /////////////////////////////////////////////检查空文件部分结束////////////////////////
 	

'/// /////////////////////////////////////////////检查空文件夹部分开始//////////////////////

sub CheckFolder(folderobj)

	on error resume Next

	isEmptyFolder folderobj

	for each subfolder in folderobj.subfolders

	CheckFolder subfolder
	
		Next

end Sub

sub isEmptyFolder(folderobj)

on error resume Next

if folderobj.Size=0 and err.Number=0 then

	if folderobj.subfolders.Count=0 Then

	ReportEmptyFolder folderobj

	end If
	
end If

end Sub



sub ReportEmptyFolder(folderobj)

on error resume next

lastaccessed = folderobj.DateLastAccessed

on error goto 0

response = MsgBox("我们在:" & vbCr _
& folderobj.path & vbCr & "发现了空文件夹 " & "文件夹最后访问时间:" _
& vbCr & lastaccessed & vbCr _
& "你想删除这个文件夹么?", _
vbYesNoCancel + vbDefaultButton2)

if response = vbYes Then

	
	logbook.WriteLine "[文件夹:]"
	
	
	logbook.WriteLine  folderobj.path & vbCrlf & " 在 " & Now & " 被删除"


	folderobj.delete

elseif response=vbCancel Then

	MsgBox "你选择了退出！谢谢使用" & vbCrLf & "(c) Zero 2014"
	
WScript.Quit

end If

end Sub

'/// /////////////////////////////////////////////检查空文件夹部分结束//////////////////////
复制代码