VBScript 壓縮、解壓縮 範例程式 (使用 Windows 內建壓縮、解壓縮功能)

本文將提供以 VBScript 呼叫 Windows 內建檔案壓縮、解壓縮功能的範例程式供讀者參考。
P.S. Windows XP (含 XP) 以後的版本方適用。


NOTE 欲複製程式碼的讀者，先將滑鼠指標移至程式碼區，雙擊 (Double-Click) 滑鼠左鍵，此時該區程式碼應會呈現 Highlight 狀態；再按下滑鼠右鍵，於出現的選單中選擇複製。若程式碼未出現 Highlight 狀態，請重整 (Refresh) 本網頁後，再重複上述動作。

建立測試環境

(1).建立目錄 C:\ZIP_TEST
(2).建立目錄 C:\ZIP_TEST\Target
(3).將欲測試的檔案存放至 C:\ZIP_TEST (假設該檔案名稱為 TEST.TXT)

壓縮程式

(1).將以下程式碼儲存為 C:\ZIP_TEST\MyZIP.vbs
(2).於 DOS 模式中，執行 cscript C:\ZIP_TEST\MyZIP.vbs 。
(3).待執行完畢後，可至 C:\ZIP_TEST 目錄中找到被壓縮的 TEST.ZIP 檔案。

Option Explicit

Dim Counter, CTF, objFileSys, objShell, SourceFile, TranBinary, TranHex, ZipFile

' 初始化 ------------------------------------------------------------
SourceFile = "C:\ZIP_TEST\TEST.TXT"
ZipFile    = "C:\ZIP_TEST\TEST.ZIP"

Set objFileSys = CreateObject("Scripting.FileSystemObject")
Set CTF        = objFileSys.CreateTextFile(ZipFile, True)
Set objShell   = CreateObject("Shell.Application")

TranHex = Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)

For Counter = 0 To UBound(TranHex)
   TranBinary = TranBinary & Chr(TranHex(Counter))
Next
'--------------------------------------------------------------------


' 建立空白 ZIP 檔案 -------------------------------------------------
CTF.Write TranBinary
CTF.Close
'--------------------------------------------------------------------


' 加入欲壓縮資料至 ZIP 檔案 -----------------------------------------
objShell.NameSpace(ZipFile).CopyHere SourceFile
'--------------------------------------------------------------------


Set CTF        = Nothing
Set objFileSys = Nothing
Set objShell   = Nothing

Wscript.Sleep(6000)

解壓縮程式

(1).將以下程式碼儲存為 C:\ZIP_TEST\MyUNZIP.vbs
(2).於 DOS 模式中，執行 cscript C:\ZIP_TEST\MyUNZIP.vbs 。
(3).待執行完畢後，可至 C:\ZIP_TEST\Target 目錄中找到被解壓縮的 TEST.TXT 檔案。

Option Explicit

Dim DestPath objFile, objFileSys, objShell, SourceFolder, SourcePath, TargetFolder

SourceFolder = "C:\ZIP_TEST\"
TargetFolder = "C:\ZIP_TEST\Target"

Set objFileSys = CreateObject("Scripting.FileSystemObject")
Set objShell   = CreateObject("WScript.Shell")


For Each objFile In objFileSys.GetFolder(SourceFolder).Files
 If Right(UCase(objFile.Name), 4) = ".ZIP" Then
  SourcePath = objFile.Path
  DestPath   = TargetFolder
 
  Expand SourcePath, DestPath
 End If
Next

Set objFileSys = Nothing
Set objShell   = Nothing

 

Sub Expand(ByVal prmZipFile, ByVal prmDestPath)
 Dim sobjFileSys
 Dim sobjShell, ZipSource, ZipItems, ZipDestPath

 Set sobjFileSys = CreateObject("Scripting.FileSystemObject")

 If NOT sobjFileSys.FolderExists(prmDestPath) Then
    sobjFileSys.CreateFolder(prmDestPath)
 End If

 Set sobjShell   = CreateObject("Shell.Application")
 Set ZipSource   = sobjShell.NameSpace(prmZipFile)
 Set ZipItems    = ZipSource.Items()
 Set ZipDestPath = sobjShell.NameSpace(prmDestPath)

 ZipDestPath.CopyHere ZipItems, 16

 Set sobjFileSys = Nothing
 Set sobjShell   = Nothing
End Sub