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

2020-07-26 11:49:39

字體：大中小

來源：轉載

供稿：網友

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