Skip navigation links
IT services and product development
Menu
TwoLogs
IT services and product development

Source code for VB_ZIP

Download

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.

Description

The ZIP VBScript module provides easy ZIP support for your VB Script files.

Information

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.

Files

Each file belonging to this source code module is listed below.

ZIP.vbs

'*******************************************************************************
'
' 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