The source files for this module are listed below. You can also download the module VB_ZIP as a zip archive; this archive contains all the source files and documentation.
The ZIP VBScript module provides easy ZIP support for your VB Script files.
This script makes use of the freeware program 7-Zip for zip file manipulation. 7-Zip can be downloaded from http://www.7-zip.org/. Please make a donation to the developers of 7-Zip; 7-Zip is a very useful and qualitatively good program!
Once 7-Zip is installed, you have to specify the path to the 7-Zip executable (7z.exe) in the constant csZipAppPath at the top of this source file.
To start a new, empty zip file, use the MakeNewZipFile routine. If you want to add a file or a folder to an existing zip file, use the routines AddFileToZip and AddFolderToZip respectively. These routines can also be used to generate a new zip file; if the destination zip file is not present, it will be created first.
If you want to zip a file or folder into a like-named zip archive, you can use the routines GetZipPathForFile and GetZipPathForFolder. These routines take a file or folder file/path, and create a like-named zip file/path from them that is located in the same folder. The result of these routines can be passed as a second parameter to the AddFileToZip and AddFolderToZip routines.
The supported compression in this VB Script is limited to plain zip only, but this can be changed very easily by altering the used command line options.
Each file belonging to this source code module is listed below.
'*******************************************************************************
'
' Version: 5
' Author: Carl Colijn, TwoLogs
' Contact: c.colijn@twologs.com
' Source: https://www.twologs.com/sourcecode
'
' This code is freely distributable, as long as this comment remains intact.
' If you find this source useful, you may use this code in your own projects
' free of charge, but some acknowledgement to the author of this code is always
' appreciated :)
' The source is however distributed 'as is' without waranty and/or support, and
' may not be fit for each and every application. Use it at your own discretion
' and at your own risk.
' The source already has undergone testing. This doesn't mean however that all
' bugs are removed from this piece of code. If you find one of them, please
' contact me about it. I can however not guarantee when and if the bug will be
' fixed.
'
' More information about this module can be found in the accompanying HTML file.
'
'*******************************************************************************
' Path to the 7-Zip executable
Const zipAppPath = """C:\Program Files\7-Zip\7z.exe"""
' Makes a new empty zip file
Sub MakeNewZipFile(zipFilePath)
' Open the new zip file
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim zipFile
Set zipFile = fso.CreateTextFile(zipFilePath, True)
' And write out empty content
Call zipFile.Write(Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0))
Call zipFile.Close
End Sub
' Removes the given file
Private Function KillFile(filePath)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
KillFile = True
If fso.FileExists(filePath) Then
On Error Resume Next
Call fso.DeleteFile(filePath, True)
KillFile = err.Number = 0
On Error Goto 0
End If
End Function
' Adds the given file to the given zip archive
' You do not need to create an empty zip file first for the first file
' Returns if the operation completed successfully
Function AddFileToZip(filePath, zipFilePath, clearArchiveFirst)
AddFileToZip = True
If clearArchiveFirst Then
AddFileToZip = KillFile(zipFilePath)
End If
If AddFileToZip Then
Set wshell = CreateObject("WScript.Shell")
AddFileToZip = 0 = wshell.Run( _
zipAppPath + " a -tzip """ + zipFilePath + """ """ + filePath + """", _
1, _
True _
)
End If
End Function
' Adds the given folder to the given zip archive
' You do not need to create an empty zip file first for the first folder
' Returns if the operation completed successfully
Function AddFolderToZip(folderPath, zipFilePath, onlyContents, clearArchiveFirst)
AddFolderToZip = True
If clearArchiveFirst Then
AddFolderToZip = KillFile(zipFilePath)
End If
If AddFolderToZip Then
Set wshell = CreateObject("WScript.Shell")
Dim cmdLine
cmdLine = zipAppPath + " a -tzip "
If onlyContents Then
cmdLine = cmdLine + "-r "
End If
cmdLine = cmdLine + """" + zipFilePath + """ """ + folderPath
If onlyContents Then
cmdLine = cmdLine + "\*.*"
End If
cmdLine = cmdLine + """"
AddFolderToZip = 0 = wshell.Run(cmdLine, 1, True)
End If
End Function
' Gets a like-named file name in the same directory as the given file path for
' zipping the given file
Function GetZipPathForFile(filePath)
Dim startExtPos
startExtPos = InStrRev(filePath, ".")
If startExtPos = 0 Then
startExtPos = Len(filePath)
Else
startExtPos = startExtPos - 1
End If
GetZipPathForFile = Left(filePath, startExtPos) + ".zip"
End Function
' Gets a like-named file name in the same directory as the given file path for
' zipping the given file
Function GetZipPathForFolder(folderPath)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim parentFolderPath
parentFolderPath = fso.GetParentFolderName(folderPath)
If Right(parentFolderPath, 1) = "\" Then
parentFolderPath = Left(parentFolderPath, Len(parentFolderPath) - 1)
End If
Dim folderName
folderName = Mid(folderPath, Len(parentFolderPath) + 2)
Dim startExtPos
startExtPos = InStrRev(folderName, ".")
If startExtPos = 0 Then
startExtPos = Len(folderName)
Else
startExtPos = startExtPos - 1
End If
GetZipPathForFolder = _
parentFolderPath + "\" + _
Left(folderName, startExtPos) + ".zip"
End Function