以下为引用的内容：
'''''''''''''''''''''''''''''''''说明''''''''''''''''''''''''''''''''''
'网盟-黑火 制作，送给需要的朋友。
'作用：检查磁盘剩余空间，如果低于某个数值就删除一些指定的文件夹。
'注意：并不是指定的文件夹将全部删除，而是顺序删除，如果空间够了就不删后面的。
''''''''''''''''''''''''''''''''说明完'''''''''''''''''''''''''''''''''
Option Explicit
Dim strChkPath,strDelFod,intLessthan,objFso
strDelFod = "c:\netgame\文件夹1|e:\netgame\文件夹1|f:\文件夹1|d:\文件夹2" '可以删除的文件夹组,用“|”分隔
intLessthan = 20000 '少于多少MB
Set objFso = CreateObject("Scripting.FileSystemObject")
Dim arrDelFod,dicDrvState
Set dicDrvState = CreateObject("Scripting.Dictionary")
arrDelFod = Split(strDelFod,"|",-1)
Dim DelFod,drvPath
For Each DelFod In arrDelFod
drvPath = UCase(objFso.GetDriveName(DelFod))
dicDrvState.Item(drvPath) = GetFreeSpace(drvPath)
If dicDrvState.Item(drvPath) < FormatNumber(intLessthan,0) Then
If Ask(drvPath&" 盘小于 "&FormatNumber(intLessthan,0)&" MB,是否要删除 “"&DelFod&"”") Then
On Error Resume Next
objFso.DeleteFolder DelFod,True
If Err Then
err.Clear
Msgbox "不能删除文件夹，请检查 “"&DelFod&"”"&vbCrLf&"按确定继续",16,"错误"
End If
On Error GoTo 0
End If
End If
Next
Dim strMmg,keyDrv,i
strMmg = "完成报告："&vbCrLf&vbCrLf
keyDrv = dicDrvState.Keys
For i = 0 To dicDrvState.Count -1
strMmg = strMmg & keyDrv(i)&" 盘剩余空间 "&dicDrvState(keyDrv(i))&" "
If dicDrvState(keyDrv(i)) < FormatNumber(intLessthan) Then strMmg = strMmg & "注意！"
strMmg = strMmg & vbCrLf
Next
MsgBox strMmg,64,"完成报告"
Set dicDrvState = NoThing
Set objFso = NoThing
WScript.quit
Function GetFreeSpace(drvPath)
Dim fso, d
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set d = fso.GetDrive(fso.GetDriveName(drvPath))
If Err Then
err.Clear
Msgbox "不能找到驱动器 “"&drvPath&"” 按确定继续",16,"错误"
GetFreeSpace = "Error"
Exit Function
End If
On Error GoTo 0
GetFreeSpace = FormatNumber(d.FreeSpace/1048576, 0)
Set fso = Nothing
End Function
Function Ask(strAction)
Dim intButton
intButton = MsgBox(strAction,vbQuestion + vbYesNo,"询问")
Ask = intButton = vbYes
End Function
|
