中文字幕免费精品_亚洲视频自拍_亚洲综合国产激情另类一区_色综合咪咪久久

為了解決這類問題，我使用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