為了解決這類問題，我使用Visual Basic Scripting設(shè)計(jì)了一個(gè)腳本，可以自動(dòng)達(dá)到這個(gè)目標(biāo)。在本腳本中，自動(dòng)壓縮所有文件。為了避免將腳本自己也壓縮進(jìn)去，使用了一些判斷。

代碼如下:

call main()

Sub main()

Dim fs '文件系統(tǒng)。

Dim f 'folder

Dim fc 'files

Dim s 'string

Dim ws 'SHELL。

Dim subfs

Dim fi

'創(chuàng)建SHELL。

Set ws = CreateObject("WScript.Shell")

'創(chuàng)建文件對(duì)象。

Set fs = CreateObject("Scripting.FileSystemObject")

Set f = fs.GetFolder(ws.currentdirectory)

Handle_files(ws.currentdirectory)

Set subfs = f.SubFolders

'遍歷每個(gè)子目錄。

For Each fi In subfs

Call ListSub(fi.Path)

Next

End Sub

Sub ListSub(filename)

On Error Resume Next

Dim subfs '子目錄。

'首先處理當(dāng)前目錄。

Handle_Files(filename)

'創(chuàng)建文件對(duì)象。

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

'處理每個(gè)目錄下的文件。

Sub Handle_Files(foldername)

'創(chuàng)建文件對(duì)象。

Set fs = CreateObject("Scripting.FileSystemObject")

Set f = fs.GetFolder(foldername)

Set fc = f.Files

'創(chuàng)建SHELL。

Set ws = CreateObject("WScript.Shell")

'遍歷文件對(duì)象。

For Each fl In fc

if ((instr(fl.Name,"vbs") = 0) and (instr(fl.Name,"rar") = 0)) then

'進(jìn)行壓縮。

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

一種更加巧妙的方法

對(duì)上個(gè)腳本稍加改動(dòng)，使用正則表達(dá)式（Regular Expression ），可以方便我們的判斷過程。修改后的腳本程序如下所示。注意我們這里排除的是不壓縮的文件類型。

代碼如下:

call main()

Sub main()

Dim fs '文件系統(tǒng)。

Dim f 'folder

Dim fc 'files

Dim s 'string

Dim ws 'SHELL。

Dim subfs

Dim fi

'創(chuàng)建SHELL。

Set ws = CreateObject("WScript.Shell")

'創(chuàng)建文件對(duì)象。

Set fs = CreateObject("Scripting.FileSystemObject")

Set f = fs.GetFolder(ws.currentdirectory)

Handle_files(ws.currentdirectory)

Set subfs = f.SubFolders

'遍歷每個(gè)子目錄。

For Each fi In subfs

Call ListSub(fi.Path)

Next

End Sub

Sub ListSub(filename)

On Error Resume Next

Dim subfs '子目錄。

'首先處理當(dāng)前目錄。

Handle_Files(filename)

'創(chuàng)建文件對(duì)象。

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

'處理每個(gè)目錄下的文件。

Sub Handle_Files(foldername)

'創(chuàng)建文件對(duì)象。

Set fs = CreateObject("Scripting.FileSystemObject")

Set f = fs.GetFolder(foldername)

Set fc = f.Files

'創(chuàng)建SHELL。

Set ws = CreateObject("WScript.Shell")

'遍歷文件對(duì)象。

For Each fl In fc

if ( RegExpTest(".vbs|.rar|.zip",fl.name) = false) then

'進(jìn)行壓縮。

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

'使用正則表達(dá)式進(jìn)行判斷。

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