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: 4
' 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 csZipAppPath = """C:\Program Files\7-Zip\7z.exe"""

' Makes a new empty zip file
Sub MakeNewZipFile(sZipFilePath)
  ' Open the new zip file
  Dim oFSO
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  Dim oZipFile
  Set oZipFile = oFSO.CreateTextFile(sZipFilePath, True)

  ' And write out empty content
  Call oZipFile.Write(Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0))
  Call oZipFile.Close
End Sub

' Removes the given file
Private Function KillFile(sFilePath)
  Dim oFSO
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  KillFile = True
  If oFSO.FileExists(sFilePath) Then
    On Error Resume Next
    Call oFSO.DeleteFile(sFilePath, 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(sFilePath, sZipFilePath, bClearArchiveFirst)
  AddFileToZip = True
  If bClearArchiveFirst Then
    AddFileToZip = KillFile(sZipFilePath)
  End If
  If AddFileToZip Then
    Set oShell = CreateObject("WScript.Shell")
    AddFileToZip = 0 = oShell.Run( _
      csZipAppPath + " a -tzip """ + sZipFilePath + """ """ + sFilePath + """", _
      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(sFolderPath, sZipFilePath, bOnlyContents, bClearArchiveFirst)
  AddFolderToZip = True
  If bClearArchiveFirst Then
    AddFolderToZip = KillFile(sZipFilePath)
  End If
  If AddFolderToZip Then
    Set oShell = CreateObject("WScript.Shell")
    Dim sCmdLine
    sCmdLine = csZipAppPath + " a -tzip "
    If bOnlyContents Then
      sCmdLine = sCmdLine + "-r "
    End If
    sCmdLine = sCmdLine + """" + sZipFilePath + """ """ + sFolderPath
    If bOnlyContents Then
      sCmdLine = sCmdLine + "\*.*"
    End If
    sCmdLine = sCmdLine + """"
    AddFolderToZip = 0 = oShell.Run(sCmdLine, 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(sFilePath)
  Dim nStartExt
  nStartExt = InStrRev(sFilePath, ".")
  If nStartExt = 0 Then
    nStartExt = Len(sFilePath)
  Else
    nStartExt = nStartExt - 1
  End If
  GetZipPathForFile = Left(sFilePath, nStartExt) + ".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(sFolderPath)
  Dim oFSO
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  Dim sParentFolderPath
  sParentFolderPath = oFSO.GetParentFolderName(sFolderPath)
  If Right(sParentFolderPath, 1) = "\" Then
    sParentFolderPath = Left(sParentFolderPath, Len(sParentFolderPath) - 1)
  End If
  Dim sFolderName
  sFolderName = Mid(sFolderPath, Len(sParentFolderPath) + 2)
  Dim nStartExt
  nStartExt = InStrRev(sFolderName, ".")
  If nStartExt = 0 Then
    nStartExt = Len(sFolderName)
  Else
    nStartExt = nStartExt - 1
  End If
  GetZipPathForFolder = sParentFolderPath + "\" + _
                        Left(sFolderName, nStartExt) + ".zip"
End Function