打印

[原创] 根据文件名列表,删除文件的VBS脚本

本主题由 mwpq 于 2007-11-7 08:58 关闭

根据文件名列表,删除文件的VBS脚本

由于这几天上班都比较轻松,没事的时候写的这个。不知道有没有朋友需要& [1 Q8 v3 S5 u/ i' C$ f% E1 Q7 ~

! W! h' Q- L, F+ F; k7 ]7 R3 m5 a
* Z+ h3 o: W3 t1 C例如要删除D盘所有.exe文件的话,先执行命令“dir /a /s /b d:\*.exe > D:\文件列表.txt”,就在D盘得到了一个列表文件,然后运行下面的脚本。; Y* Y, k+ ], T; X% ?$ H) m7 w) l
5 l4 }: N" {; }/ K; h, e8 {/ h% X
dim strExecFile,oShell,objFSO& P9 F* n8 @# v6 i* `" F1 e& T6 x! _
Set oShell = WScript.CreateObject("WScript.Shell")/ h# B: G1 w; Y, r- X: M9 n
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")4 j! q9 t Z# @0 R
Set objListFile = objFSO.OpenTextFile("D:\文件列表.txt",1)
# q! r# I9 k3 Y* y. _: c7 NDo While objListFile.AtEndOfStream <> True
4 p5 D$ R, N K. bstrtemp = objListFile.ReadLine
$ J0 o. a0 S* zIf tempstr <> "" Then
b/ O& h6 @* `$ Y If objFSO.FileExists(strtemp) Then
0 f- n( A3 q3 F3 i+ Y objFSO.DeleteFile(strtemp) D' k' F6 s0 q0 [* L% B3 i: L
End If) x1 K% `7 r8 K- ]$ d1 F$ Q& g
End If
) {) n( X, p5 }; ALoop9 N' B+ ?6 O) a5 ]" v; P6 `
Set objFSO=NoThing:Set oShell=NoThing:WScript.Quit
我可以接受失败,但我不能接受放弃.

TOP

根据磁盘空间删除指定文件夹的VBS脚本

纯萃是无聊之作,用的着的就看下吧!
. v7 U8 p' q: z2 ^/ o& l3 Y5 w% x5 S, g
根据磁盘空间删除指定文件夹的VBS脚本
: s* n m/ p4 Z: h1 J'''''''''''''''''''''''''''''''''说明''''''''''''''''''''''''''''''''''2 m! z: ^4 n4 Q! S
'菊花-mfknui 制作,送给需要的朋友。% x4 {, [ p5 z
'作用:检查磁盘剩余空间,如果低于某个数值就删除一些指定的文件夹。* |4 ?, c; Q; j
'注意:并不是指定的文件夹将全部删除,而是顺序删除,如果空间够了就不删后面的。: S0 n: d6 ~% A9 D, @8 @6 @
''''''''''''''''''''''''''''''''说明完'''''''''''''''''''''''''''''''''+ Z, |' K- D/ H) g- M& d
Option Explicit2 C: `0 j! @0 U5 r8 [
Dim strChkPath,strDelFod,intLessthan,objFso
: G1 Q% M- ]6 Q! \strDelFod = "c:\netgame\文件夹1|e:\netgame\文件夹1|f:\文件夹1|d:\文件夹2" '可以删除的文件夹组,用“|”分隔" l" u4 f! P$ z+ ]$ i. B4 G
intLessthan = 20000 '少于多少MB
m! {2 M2 l# _* ?Set objFso = CreateObject("Scripting.FileSystemObject")2 d# f3 ~& i7 k7 z/ C1 \
Dim arrDelFod,dicDrvState" I- h S. ~/ ^7 }
Set dicDrvState = CreateObject("Scripting.Dictionary")$ W* r! Q* p' j$ e; o# s
arrDelFod = Split(strDelFod,"|",-1)
4 a& Z% K5 P5 [/ _: wDim DelFod,drvPath
3 i5 B0 i& p6 ~0 Y3 eFor Each DelFod In arrDelFod0 v! B+ M4 A8 h2 P' e0 g# G
drvPath = UCase(objFso.GetDriveName(DelFod))
* R! h: t7 Q" \# ` dicDrvState.Item(drvPath) = GetFreeSpace(drvPath)+ ?& ?; l# R# L5 E6 K5 U
If dicDrvState.Item(drvPath) < FormatNumber(intLessthan,0) Then
1 e! K+ d7 @' B2 X0 n2 S& F If Ask(drvPath&" 盘小于 "&FormatNumber(intLessthan,0)&" MB,是否要删除 “"&DelFod&"”") Then8 ]4 N' F" f: ?3 c$ t+ G1 i8 O
On Error Resume Next
# _& T: T9 l, c0 N8 a- q2 p4 A+ X! s objFso.DeleteFolder DelFod,True
; F% x1 Z4 O$ ^' B. x" B( G If Err Then
8 [* P' k$ R5 O4 J( x! o err.Clear0 a$ b# J' Y9 Y2 ~
Msgbox "不能删除文件夹,请检查 “"&DelFod&"”"&vbCrLf&"按确定继续",16,"错误": d9 g% v$ ~. V# W, M3 P
End If
! }- E; J; N; r* I On Error GoTo 0
! J) t" a- Z. ?( v& `" b End If
8 U8 R- n) O; B( \ End If
" _$ M/ l0 c& {9 t4 _" ^& x" FNext
; L" \% L7 ^3 f% B* `- O) n/ `- H0 EDim strMmg,keyDrv,i
! G* O: W- d- AstrMmg = "完成报告:"&vbCrLf&vbCrLf
- p1 L& P4 b- g" [keyDrv = dicDrvState.Keys9 g/ r4 q9 x3 u+ `
For i = 0 To dicDrvState.Count -1
0 ]0 H) x0 d. ^1 @! t$ DstrMmg = strMmg & keyDrv(i)&" 盘剩余空间 "&dicDrvState(keyDrv(i))&" ", e1 u. ?9 J" H& q9 U H1 x
If dicDrvState(keyDrv(i)) < FormatNumber(intLessthan) Then strMmg = strMmg & "注意!"# Z8 R8 B; h, H+ Z1 D( }, {
strMmg = strMmg & vbCrLf. e8 T2 \& ~! a4 `# K! `- J. B
Next
* t* } i- [+ E; r; _$ VMsgBox strMmg,64,"完成报告"
! M0 U5 ?+ @, n6 M( _Set dicDrvState = NoThing
& X, {( C0 u% t" ?. A# N" x. t% MSet objFso = NoThing9 c0 i7 x$ ^5 w- `1 i3 z7 X" a
WScript.quit0 U! ]! ]2 h* x! v/ o S( m5 ]( R
, Q% `+ B" w1 }" U' ^- ?
Function GetFreeSpace(drvPath): Z' A" | e! V" K. g A$ \
Dim fso, d9 [& q6 x( \/ X0 m% W
Set fso = CreateObject("Scripting.FileSystemObject")
2 V5 O0 x4 q9 ] k: V2 Y On Error Resume Next
$ ]3 _! b! [ @7 r. r" T! x Set d = fso.GetDrive(fso.GetDriveName(drvPath))- |; k$ ]4 I# l: n( c
If Err Then
0 F! o" C* ~4 t4 ? f/ a err.Clear0 R8 M( J; Y' P0 M. b. V! @* e$ n
Msgbox "不能找到驱动器 “"&drvPath&"” 按确定继续",16,"错误"1 H; @" a% C2 h# U
GetFreeSpace = "Error"
2 o3 J# p# x0 M- S: G4 N Exit Function
0 u" u1 y/ x3 g7 w End If
0 u# o3 f I7 r) S! E% n On Error GoTo 0
l3 p4 }" C5 R! f# v X GetFreeSpace = FormatNumber(d.FreeSpace/1048576, 0)
- a* M, J9 T, O. D3 ? Set fso = Nothing
* Y3 A0 W& D4 j( A& ~/ w6 [End Function
2 _6 @3 Y2 j Y! s- S, q) |Function Ask(strAction)# q; n* c G3 ^2 g! [" f! P g
Dim intButton
3 e: b9 \: o s' L: D+ [ intButton = MsgBox(strAction,vbQuestion + vbYesNo,"询问")
9 C: B" F; o, H) S+ X6 A) e Ask = intButton = vbYes7 o; h4 \, U* Q A1 J$ {: q
End Function
我可以接受失败,但我不能接受放弃.

TOP