使用脚本自动压缩指定目标下的所有文件的代码

187 阅读 0 评论 124 点赞

我是靠谱客的博主单纯电灯胆，最近开发中收集的这篇文章主要介绍使用脚本自动压缩指定目标下的所有文件的代码，觉得挺不错的，现在分享给大家，希望可以做个参考。

概述

为了解决这类问题，我使用Visual Basic Scripting设计了一个脚本，可以自动达到这个目标。在本脚本中，自动压缩所有文件。为了避免将脚本自己也压缩进去，使用了一些判断。

复制代码代码如下:

 
call main() 
Sub main() 
Dim fs '文件系统。 
Dim f 'folder 
Dim fc 'files 
Dim s 'string 
Dim ws 'SHELL。 
Dim subfs 
Dim fi 
'创建SHELL。 
Set ws = CreateObject("WScript.Shell") 
'创建文件对象。 
Set fs = CreateObject("Scripting.FileSystemObject") 
Set f = fs.GetFolder(ws.currentdirectory) 
Handle_files(ws.currentdirectory) 
Set subfs = f.SubFolders 
'遍历每个子目录。 
For Each fi In subfs 
Call ListSub(fi.Path) 
Next 
End Sub 
Sub ListSub(filename) 
On Error Resume Next 
Dim subfs '子目录。 
'首先处理当前目录。 
Handle_Files(filename) 
'创建文件对象。 
Set fs = CreateObject("Scripting.FileSystemObject") 
Set f = fs.GetFolder(filename) 
Set subfs = f.SubFolders 
For Each fi In subfs 
Call ListSub(fi.Path) 
Next 
End Sub 
'处理每个目录下的文件。 
Sub Handle_Files(foldername) 
'创建文件对象。 
Set fs = CreateObject("Scripting.FileSystemObject") 
Set f = fs.GetFolder(foldername) 
Set fc = f.Files 
'创建SHELL。 
Set ws = CreateObject("WScript.Shell") 
'遍历文件对象。 
For Each fl In fc 
if ((instr(fl.Name,"vbs") = 0) and (instr(fl.Name,"rar") = 0)) then 
'进行压缩。 
s = "winrar M -ep " & fl.Path & ".rar " & fl.Path 
ws.Run s, 0, True 
End If 
Next 
End Sub 
sub output(string) 
wscript.echo string 
end sub 

一种更加巧妙的方法
对上个脚本稍加改动，使用正则表达式（Regular Expression ），可以方便我们的判断过程。修改后的脚本程序如下所示。注意我们这里排除的是不压缩的文件类型。

复制代码代码如下:

 
call main() 
Sub main() 
Dim fs '文件系统。 
Dim f 'folder 
Dim fc 'files 
Dim s 'string 
Dim ws 'SHELL。 
Dim subfs 
Dim fi 
'创建SHELL。 
Set ws = CreateObject("WScript.Shell") 
'创建文件对象。 
Set fs = CreateObject("Scripting.FileSystemObject") 
Set f = fs.GetFolder(ws.currentdirectory) 
Handle_files(ws.currentdirectory) 
Set subfs = f.SubFolders 
'遍历每个子目录。 
For Each fi In subfs 
Call ListSub(fi.Path) 
Next 
End Sub 
Sub ListSub(filename) 
On Error Resume Next 
Dim subfs '子目录。 
'首先处理当前目录。 
Handle_Files(filename) 
'创建文件对象。 
Set fs = CreateObject("Scripting.FileSystemObject") 
Set f = fs.GetFolder(filename) 
Set subfs = f.SubFolders 
For Each fi In subfs 
Call ListSub(fi.Path) 
Next 
End Sub 
'处理每个目录下的文件。 
Sub Handle_Files(foldername) 
'创建文件对象。 
Set fs = CreateObject("Scripting.FileSystemObject") 
Set f = fs.GetFolder(foldername) 
Set fc = f.Files 
'创建SHELL。 
Set ws = CreateObject("WScript.Shell") 
'遍历文件对象。 
For Each fl In fc 
if ( RegExpTest(".vbs|.rar|.zip",fl.name) = false) then 
'进行压缩。 
s = "winrar M -ep " & fl.Path & ".rar " & fl.Path 
output s 
ws.Run s, 0, True 
End If 
Next 
End Sub 
sub output(string) 
wscript.echo string 
end sub 
'使用正则表达式进行判断。 
Function RegExpTest(patrn, strng) 
Dim regEx, retVal ' Create variable. 
Set regEx = New RegExp ' Create regular expression. 
regEx.Pattern = patrn ' Set pattern. 
regEx.IgnoreCase = False ' Set case sensitivity. 
retVal = regEx.Test(strng) ' Execute the search test. 
If retVal Then 
RegExpTest = true 
Else 
RegExpTest = false 
End If 
End Function 