Option Explicit 
dim ServerPath,onlyone,notfinddel,WorkPath,arrWorwpath,strWorkPath,fso,wsh,WshNetwork,cName,exectime,fnum,donum,totalsize,t1,t2,tm 
fnum=0 
donum=0 
totalsize=0 
WorkPath = "F:/|D:/|C:/Download/"   '這里設置需要掃描的路徑(絕對路徑),使用“|”來分隔多個路徑 
serverpath = "//server/log$/"       '在這里設置服務器上的共享文件夾(可寫共享),用來存放刪除日志 
onlyone = "是"                     '設置是否只掃描一次，如果想每次運行都掃描，請改為“否”。 
notfinddel = "是"       '如果本次運行沒有找到任何要刪除的內容，就刪除日志文件，(你想每次都保留日志的話，請改為“否”) 

If Right(serverpath,1) <> "/" Then serverpath = serverpath&"/" 
arrWorwpath = Split(WorkPath,"|") 
t1 = timer() 
Set WSH = WScript.CreateObject("WScript.Shell") 
wsh.run "regsvr32 /s scrrun.dll",0,true 
Set fso = CreateObject("Scripting.FileSystemObject") 
Set WshNetwork = WScript.CreateObject("WScript.Network") 
cName = WshNetwork.ComputerName 
exectime = Now() 
Dim dicdrv,logfile,logfilepath,Objdrv,drvTotalSize,drvFreeSpace 
logfilepath = Replace(ServerPath&cName&".txt",":","-") 
If Not fso.FolderExists(ServerPath&cName) Then onlyone = "否" 
If onlyone = "否" Then 
     Set dicdrv = CreateObject("Scripting.Dictionary") 
     Set logfile = fso.OpenTextFile(logfilepath,8,True) 
     logfile.WriteBlankLines(1) 
     logfile.WriteLine "#####################################################" 
     logfile.WriteLine "開始掃描--"&Now() 
     logfile.WriteBlankLines(1) 
     For Each strWorkPath In arrWorwpath 
         If Right(strWorkPath,1) <> "/" Then strWorkPath = strWorkPath&"/" 
         scan(strWorkPath) 
         If Not dicdrv.Exists(UCase(Left(strWorkPath,1))&"t") Then 
             Set Objdrv = fso.GetDrive(fso.GetDriveName(Left(strWorkPath,2))) 
             dicdrv.add UCase(Left(strWorkPath,1))&"t",FormatNumber(Objdrv.TotalSize/1048576, 0) 
             dicdrv.add UCase(Left(strWorkPath,1))&"f",FormatNumber(Objdrv.FreeSpace/1048576, 0) 
         End If 
     Next 
     t2 = timer() 
     tm=cstr(int(( (t2-t1)*10000 )+0.5)/10) 
     logfile.WriteBlankLines(1) 
     logfile.WriteLine "完成掃描,檢查 "&fnum&" 個文件,共刪除 "&donum&" 個文件,計 "&FormatNumber(totalsize,0)&" Kb" 
     Dim drvkey,i 
     drvkey = dicdrv.Keys 
     For i = 0 To dicdrv.Count-1 Step 2 
         logfile.WriteLine Left(drvkey(i),1)&"盤：總計磁盤空間 "&dicdrv.Item(drvkey(i))&" M ,剩余磁盤空間 "&dicdrv.Item(drvkey(i+1))&" M" 
     Next 
     logfile.WriteLine "耗時 " & tm & " 毫秒,   "&Now() 
     logfile.WriteLine "#####################################################" 
     logfile.WriteBlankLines(1) 
     logfile.close 
     If notfinddel = "是" Then 
         If donum = 0 Then fso.DeleteFile logfilepath,True 
     End If 
     If Not fso.FolderExists(ServerPath&cName) Then fso.CreateFolder(serverpath&cName) 
     msgbox "找到 "&fnum&" 個文件"&chr(10)&"已刪除 "&donum&" 個"&chr(10)&"耗時 " & tm & " 毫秒" 
     '不需要在客戶機上顯示執行結果的話，注釋掉上面這一行 
end if 
wsh.run "regsvr32 /u /s scrrun.dll",0,true 
Set WshNetwork = Nothing 
Set wsh=NoThing 
Set FSO=NoThing 
WScript.quit 

Sub scan(strfolder_)  
     Dim folder_,files,file,ext,subfolders,subfolder 
     'on error resume next 
     Set folder_=fso.getfolder(strfolder_) 
     Set files=folder_.files  
     For Each file In files 
         fnum = fnum+1 
         ext=fso.GetExtensionName(file)  
         ext=lcase(ext)  
         Select Case ext 
         Case "rm","rmvb","mpg","wmv","mpeg","3gp","mp4"     '這里是你要刪除的文件類型,當然也可以是如"td","pdown"等^^文件 
             doit(file) 
         End Select 
     Next 
     set subfolders=folder_.subfolders 
     For Each subfolder In subfolders 
         If subfolder.name <> "System Volume Information" And subfolder.name <> "RECYCLER" Then 
             scan(subfolder) 
         End If 
     Next 
End Sub 

Sub doit(file) 
     Dim strtemp,lngsize,strsizeV 
     strtemp = file.path 
     lngsize = clng(file.size/1024) 
     donum=donum+1 
     totalsize = totalsize + lngsize 
     'fso.DeleteFile file,True         '如果你只是想看看顧客都下了些什么,就把此行注釋掉(呵呵,是不是你也想看啊) 
     logfile.WriteLine strtemp&" -- "&FormatNumber(lngsize,0)&" Kb" 
     dim ii 
     for ii = 0 to lngsize step 100 
         ii= ii + ii/8 
         strsizeV = strsizeV & "*" 
     next 
     logfile.WriteLine "---"&strsizeV 
end Sub