使用腳本自動壓縮指定目標下的所有文件的代碼

    為了解決這類問題，我使用Visual Basic Scripting設計了一個腳本，可以自動達到這個目標。在本腳本中，自動壓縮所有文件。為了避免將腳本自己也壓縮進去，使用了一些判斷。
    代碼如下:
    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)建文件對象。
    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)
    '創(chuàng)建文件對象。
    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)
    '創(chuàng)建文件對象。
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(foldername)
    Set fc = f.Files
    '創(chuàng)建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 '文件系統(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)建文件對象。
    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)
    '創(chuàng)建文件對象。
    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)
    '創(chuàng)建文件對象。
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(foldername)
    Set fc = f.Files
    '創(chuàng)建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