精华..VBS脚本，删除指定以外的文件，文件夹
Option Explicit* C5 m/ Z3 e' o g( F, w
''''''''''''''说明'''''''''''') p4 e6 X( g; n' G- \9 ~& T
'菊花-mfknui制作，送给需要的朋友。
/ _3 O8 F. r5 p4 g% K'配置文件“Listfile.ini”的格式如下：& F: l* Q: H. j' |! O7 A
'要删除什么(文件|目录)=要执行删除的文件夹=排除1;排除2;排除3............2 q5 w6 X) W+ x. h- P! {# N
'配置文件可以有多行，以便对多个目录进行操作。5 Z" Y! k: h& x
'配置文件里以“/”开头的行为注释行。( ~$ {1 m% T$ x, Z) T( K
'排除多个内容时，使用分号“;”进行分隔。+ P4 D- f$ S8 U5 R
'↓↓↓ 配置文件例子：↓↓↓7 P6 _: A7 [9 R8 [" B4 P9 L9 G9 W
'/配置文件开始
6 \5 |: r' Q# i# x+ \* ?! I4 l) Q'目录=D:\=System Volume Information;网络游戏;单机游戏;小游戏
+ p/ ^: u1 e4 C& {. U1 n1 m9 b'目录=C:\Program Files=qq;WinRAR
; c' _9 U8 l" b3 ?' c1 j'文件=D:\网络游戏=文件1.exe;文件2.exe
9 ~9 G+ X0 n* I' q'/配置文件结束
) A) S+ N1 g8 z" M1 x, C! O'''''''''''''说明完''''''''''''" O- R9 A1 k0 Z# E1 _4 Y# [
Dim Fso,Listfile,objListfile
* u% J+ o; b0 m8 p+ r* qListfile = "" '设置配置文件路径,如果配置文件和脚本放在一起，请保持原样) i) U" i2 s- m# a+ l: R/ x0 W
If Listfile = "" Then Listfile = "Listfile.ini"
1 T* H2 k/ h( a- y. [Set Fso = CreateObject("Scripting.FileSystemObject"): M9 J2 }6 l: \0 g% a w
On Error Resume Next' Q$ H( b% ^. J4 l% w1 P: L
Set objListfile = Fso.OpenTextFile(Listfile,1)
( y: O+ J( u7 E) {4 l# \* ]If Err Then2 w0 D0 i j7 Z- W- D
err.Clear
2 }6 f# m2 i9 K' S Msgbox "没有找到配置文件 "&Listfile,16,"错误"4 m0 O% u# W+ x
WScript.quit7 [' e# F) }. L+ @9 T
End If
5 b* R$ V6 u0 W# S/ oOn Error GoTo 0
* a# l" E8 D8 t, A# HDim flnum,fdnum,t1,t2,tm2 a/ b5 ~3 X7 y5 t
flnum=0
7 k1 x" m5 j: Wfdnum=01 {7 O9 a1 E+ @& Y" L8 x9 m* L2 s
t1 = timer()) N* N% A3 Z9 p0 M- Q% ~* o+ V
Dim Myline,LineArr,ListArr
2 O$ L5 z% P: p: }Do While objListfile.AtEndOfStream <> True
7 F' J @ N: Z% V0 l# | Myline = LCase(Replace(objListfile.ReadLine,"==","="))( i4 }% d3 E# w+ I. i1 Q* g
If Left(Myline,1) = "/" Then
" M$ Y! x3 i) g: x* ^; W4 \ 'objListfile.SkipLine+ C0 g4 E/ ?% l" _0 t
ElseIf CheckLine(Myline) = 2 Then k. W* O% ^) {# X5 _* N
LineArr = Split(Myline,"=")" S% W1 s( d, D' e# }
'DoFolder = LineArr(1)
( G* Q+ C9 v9 U/ w# f ListArr = Split(LineArr(2),";")
7 O. Q( {; X% N8 e% x5 P; X: e 'MsgBox LineArr(0)
6 A6 l6 w- k' s, u If LineArr(0) = "目录" Then DelFolder LineArr(1),ListArr
& c! H% k+ [( O, Z# y If LineArr(0) = "文件" Then DelFile LineArr(1),ListArr( o6 o. N2 _& a6 }3 o6 L
End If
- d, X. n. [, Q6 j& D6 qLoop
( K+ C( T" W( ~+ Q) jt2 = timer()
& k9 @) Z3 k* stm=cstr(int(( (t2-t1)*10000 )+0.5)/10)
. r9 i5 e& n+ P5 k6 F; _+ o: q6 FMsgBox "扫描完毕，共删除 "&fdnum&" 个目录, "&flnum& "个文件。"& vbCrLf &"耗时 "&tm&" 毫秒",64,"执行完毕"$ o; c& M; Y0 A5 v
'不需要显示报告的话，注释掉上面这一行
# e0 V- f9 y( V& B- b$ |Set Fso=NoThing' F) q! C2 j. \" w' y: U1 Z2 T
WScript.quit+ {7 h# Z c& o# N6 h
Sub DelFolder(Folder,ListArr)
" z7 I3 e8 U3 A5 n* RDim objFolder,subFolders,subFolder
4 R* a" c; H8 ]( J. l7 h) Y Set objFolder=Fso.Getfolder(Folder)
) v9 B3 {5 C8 i3 y5 X3 y6 P" R6 J Set subFolders=objFolder.subFolders! n( C9 D e0 U8 O/ V
For Each subFolder In subFolders+ Q8 \. Z D" D
If Not InArray(LIstArr,LCase(subFolder.name)) Then1 v+ `3 N% m. i0 L, F6 ^+ O) U1 y
On Error Resume Next
# n5 {4 }4 `+ s- d/ j% ` subfolder.Delete(True)
2 I4 A7 X) e% _1 D5 w% a- \ If Err Then
& }& ~6 X4 q+ M% C# R2 C- } err.Clear; T. w+ ?5 E& D( p( B, i- m! \. z
Msgbox "不能删除目录，请检查 "&subFolder,16,"错误"
& F- y( U) }" N2 S( L3 z9 K Else
9 A+ e8 a( {$ p7 x1 o- }* ? fdnum = fdnum + 1( V6 u6 a6 P5 h
End If
% P B6 i6 z0 y. E On Error GoTo 0
- T1 h# }0 Z$ U0 ^3 H End If a5 l8 z+ O2 ?3 N- ]
Next9 }# A$ G5 U' W' a. X- M7 ]
End Sub, X P' S2 _3 a" h% { Z
Sub DelFile(Folder,ListArr). H5 L6 t$ U) M
Dim objFolder,Files,File! t$ T, h$ ]2 a P7 n8 g
Set objFolder=Fso.Getfolder(Folder)" q4 G O. O. S
Set Files=objFolder.Files! F- {! D# n. J4 h- F0 }
For Each File In Files
1 T3 D. T3 u; I" y# i+ S3 ?6 f$ I If Not InArray(LIstArr,LCase(File.name)) Then
% Z. ^& ^( F% m3 @0 W On Error Resume Next
# ]% Z$ ]# j! N, M, z$ [% \ File.Delete(True)
$ G. F* d' B7 ?: t: D If Err Then
! G: R0 E. @* W& \# q* T5 z err.Clear
- T1 M5 r. j& d) ^/ ~! f Msgbox "不能删除文件，请检查 "&File,16,"错误"# u4 t& C+ o' q l4 f- ^
Else
" w: V: N2 W. M5 ?. n flnum = flnum + 1
$ f! @2 a: [: Q* w3 i6 i) ?$ i4 @ End If
4 U n' s; X/ A& k2 z( [7 E On Error GoTo 0
1 R% x0 _* ?7 l3 b, J% L( M% C End If, D1 n3 b. A' p' H
Next
+ h: G; ~1 K1 k6 a# \* yEnd Sub, y5 U8 N" \+ A8 |$ ]
Function CheckLine(strLine): ]- a# q0 G& L1 G' K( [
Dim LineRegExp,Matches) c! C; T3 J% ]" e6 W* s
Set LineRegExp = New RegExp
1 p: C& e5 T, j& ?- BLineRegExp.Pattern = ".=."4 n, z: Y) n+ i2 D& p8 `" g" W/ N
LineRegExp.Global = True1 C) R8 ? @5 J$ a* l T
Set Matches = LineRegExp.Execute(strLine)$ o! g7 @0 B+ s
CheckLine = Matches.count/ s0 n6 E% Z2 [: e. F
End Function5 d, c* C- `: @" w
Function InArray(Myarray,StrIn)2 s, U* E1 ~/ m7 `: L
Dim StrTemp
$ e; N1 y, g6 G2 M5 A/ A7 ?4 {InArray = True
6 `4 v) Q+ o$ p- z% [For Each StrTemp In Myarray
; i c) [( E8 L8 r If StrIn = StrTemp Then7 i" ]7 x! B" Z3 [4 u( {
Exit Function
% d0 ~+ x) @* c Exit For
& p w8 e8 q0 F: t `. }1 q End If f# R/ f* W! \0 o$ R" W
Next
: \2 x8 e) t4 z" G2 IInArray = False
" T% i t! i& fEnd Function
搜索更多相关主题的帖子:
VBS 脚本 精华 文件 删除
