软件开发培训班 >> 编程开发 >> VbScript


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

　　本文标签：自动压缩

为了解决这类问题，我使用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