DevX Home    Today's Headlines   Articles Archive   Tip Bank   Forums   

Results 1 to 4 of 4

Thread: How to zip the files With WinZip in VB?

  1. #1
    Join Date
    Aug 2004
    Posts
    43,023

    How to zip the files With WinZip in VB?

    [Originally posted by Surinder]

    How to Zip the files with WinZip through Visual Basic Programming?

  2. #2
    Join Date
    Aug 2004
    Posts
    43,023

    Re:How to zip the files With WinZip in VB?

    [Originally posted by Larry Asher]

    I am not sure how comfortable you are working with Dll's but I created a dll to work with WinZip and the command line aurgument. You will need to download the beta version of Release 1.1 of the WinZip Command Line Support Add-On (requires WinZip 8.1) at http://www.winzip.com/other.htm

    Also, I can include most of the source code for the Dll. I won't include all of it because some of it is propriatery, the ClassError handler. The heart of the code came form input on this site.

    There is a private class module and a public class module that make up the Dll. In addition to get a better understanding of the code you will want to look throught the documentation with the WinZip Command Line Option software.

    Best of luck and if you have any questions let me know. I'll see what I can do.

    '************************************************
    '************************************************
    'First class module - clsWinZipCLO
    'Instancing Private

    Option Explicit

    Private wzWinZipExePath As String
    Private mvarSourceDir As String
    Private mvarSourceFileName As String
    Private mvarDestinationDir As String
    Private mvarDestFileName As String

    ' Declare Win 32 API Functions
    Private Declare Function GetShortPathName Lib "kernel32" _
    Alias "GetShortPathNameA" (ByVal lpszLongPath As String, _
    ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long

    Private Sub ClassError(ByVal lError As Long, ByVal strError As String, _
    ByVal strWho As String, Optional ByVal LogOnly As Boolean = False)
    ' This will handle errors for the class module
    ' You'll have to complete this part of the prop. code

    End Sub

    Public Property Get SourceDir() As String

    SourceDir = mvarSourceDir

    End Property

    Public Property Let SourceDir(ByVal vNewValue As String)

    mvarSourceDir = vNewValue

    End Property

    Public Property Get SourceFileName() As String

    SourceFileName = mvarSourceFileName

    End Property

    Public Property Let SourceFileName(ByVal vNewValue As String)

    mvarSourceFileName = vNewValue

    End Property

    Public Property Get DestinationDir() As String

    DestinationDir = mvarDestinationDir

    End Property

    Public Property Let DestinationDir(ByVal vNewValue As String)

    mvarDestinationDir = vNewValue

    End Property

    Public Property Get DestFileName() As String

    DestFileName = mvarDestFileName

    End Property

    Public Property Let DestFileName(ByVal vNewValue As String)

    mvarDestFileName = vNewValue

    End Property

    Private Function RunAndWait(ByVal Arg As String, _
    Optional Focus As VbAppWinStyle = vbMinimizedNoFocus, _
    Optional CloseWindow As Boolean = True) As Long

    Dim wShell As IWshShell_Class
    Dim lError As Long
    Dim strError As String

    On Error GoTo ErrorHandler

    ' Create objects
    Set wShell = New IWshShell_Class
    ' Test to see if we are supposed to close the window
    If CloseWindow = True Then
    ' Run the command prompt window closed
    Arg = "COMMAND.COM /C " & Arg
    Else
    ' Run the command prompt window open
    Arg = "COMMAND.COM " & Arg
    End If
    ' Log command line argument
    LogMessage App.Title & "\RunAndWait Command Line Argument: " & Arg
    ' Execute command line argument
    lError = wShell.Run(Arg, Focus, True)
    ' Test for errors
    If lError <> 0 Then
    ' Error
    Err.Raise lError
    End If
    ' Return 0
    RunAndWait = 0

    Exit Function

    ErrorHandler:

    ' Capture error
    lError = Err.Number
    strError = Err.Description
    ' Return error
    RunAndWait = lError
    ' Log error
    ClassError lError, strError, "RunAndWait"

    End Function

    Private Function ShortPathName(ByVal FileName As String) As String
    ' Convert a long file and or path name to a short 8.3 name
    ' The path and file must exist

    Const MAX_PATH = 260
    Dim lLength As Long
    Dim strRetVal As String

    On Error GoTo ErrorHandler

    ' Clean string
    FileName = Trim(FileName)
    ' Prepare a string to hold the return value
    strRetVal = String(MAX_PATH, 0)
    ' Let the API function get the short path name
    lLength = GetShortPathName(FileName, strRetVal, Len(strRetVal))
    ' Test for a returned value
    If lLength > 0 Then
    ' A value was returned
    ShortPathName = Left(strRetVal, lLength)
    Else
    ' No value was return, use the original file name
    ShortPathName = FileName
    End If

    Exit Function

    ErrorHandler:

    ' Log error
    ClassError Err.Number, Err.Description, "ShortPathName"

    End Function

    Private Function GetFSOPath(ByVal SourceDir As String, ByVal FileName As String, _
    ByRef FullPath As String, Optional ByVal MakeZipFile As Boolean = False) As Long

    Dim lError As String
    Dim strError As String
    Dim FSO As FileSystemObject

    On Error GoTo ErrorHandler

    ' Create objects
    Set FSO = New FileSystemObject
    ' Have the file system object build the full path
    FullPath = FSO.BuildPath(SourceDir, FileName)
    ' Test to see if we are making this a zip file
    If MakeZipFile = True Then
    ' Return the file name with the .zip extension
    FullPath = FullPath & ".zip"
    End If
    ' Release objects
    Set FSO = Nothing
    ' Return 0
    GetFSOPath = 0

    Exit Function

    ErrorHandler:

    ' Capture error
    lError = Err.Number
    strError = Err.Description
    ' Return error
    GetFSOPath = lError
    ' Log error
    ClassError lError, strError, "GetFSOPath"

    End Function

    Private Function GetFileName(ByVal FileName As String) As String
    ' This procedure will look at the file name and parse off the
    ' file name returning only the file name less the file extension

    On Error GoTo ErrorHandler

    ' Clean the string
    FileName = Trim(FileName)
    ' Parse off the file name
    GetFileName = Left(FileName, GetLastPeriod(FileName) - 1)

    Exit Function

    ErrorHandler:

    ' Return error
    ClassError Err.Number, Err.Description, "GetFileName"

    End Function

    Private Function GetFileExtension(ByVal FileName As String) As String
    ' This procedure will look at the file name and parse off the
    ' file extension

    On Error GoTo ErrorHandler

    ' Clean the string
    FileName = Trim(FileName)
    ' Parse off the file extension
    GetFileExtension = Mid(FileName, GetLastPeriod(FileName) + 1)

    Exit Function

    ErrorHandler:

    ' Return error
    ClassError Err.Number, Err.Description, "GetFileExtension"

    End Function

    Private Function GetLastPeriod(ByVal FileName As String) As Long
    ' This function will return the position of the last "." in a string

    ' Contrary to popular believe
    ' This function cannot tell if a woman is pregnant

    Dim lPOS As Long
    Dim lStart As Long
    Dim lError As Long
    Dim strError As String

    On Error GoTo ErorrHandler

    ' Initialize start pos
    lStart = 1
    Do While lStart <> 0
    ' Get the position of the "."
    lPOS = lStart
    ' Start at the first character
    ' If lstart = 0 we know that we have found the last position
    lStart = InStr(lStart + 1, FileName, ".", vbTextCompare)
    Loop
    ' Return the position of the file extension
    GetLastPeriod = lPOS

    Exit Function

    ErorrHandler:

    ' Get error number and description
    lError = Err.Number
    strError = Err.Description
    ' Log error
    ClassError Err.Number, Err.Description, "GetLastPeriod", True
    ' Return Error
    GetLastPeriod = lError

    End Function

    Private Sub CheckForBackSlash(ByRef RetVal As String)
    ' This function will check for a backslash
    ' If not found it will append one

    Dim strLastChar As String

    ' Test for a backlslash "\" at the end of the source dir
    strLastChar = Mid(RetVal, Len(RetVal), Len(RetVal))
    If strLastChar <> "\" Then
    ' Not found append backslash
    RetVal = RetVal & "\"
    Else
    ' Backslash found
    RetVal = RetVal
    End If

    End Sub

    Public Function wzZipFile(Optional ByVal AsBatch As Boolean = False) As Long

    Dim strArg As String
    Dim lError As Long
    Dim strError As String
    Dim strZipExeLocation As String
    Dim strWinZipExe As String
    Dim strOptions As String
    Dim strFullZipPath As String
    Dim strSourceDir As String
    Dim strDestDir As String
    Dim strSourceFileName As String

    On Error GoTo ErrorHandler

    ' Build the path to the win zip exe
    strZipExeLocation = wzWinZipExePath & "wzzip.exe"
    ' Return the short path name for the executable file
    strWinZipExe = ShortPathName(strZipExeLocation)
    ' Set win zip options
    ' Test to see if this is a batch operation or individual file
    ' -ee extra (enhanced deflate - smallest file).
    ' -o Change the Zip file's file date to the same as the newest file in the Zip file.
    ' -jhrs Do not store hidden, read only, and system attributes in the Zip file.
    ' -yb[c] Automatic, non-interactive ("batch" mode) handling of prompts.
    ' If a prompt is issued, the operation terminate with error level 250.
    ' Use the optional c suffix to automatically continue with a "yes",
    ' "ok" response instead of terminating.
    If AsBatch = True Then
    ' This is a batch operation
    strOptions = "-ee -o -jhrs -ybc"
    Else
    ' We are zipping an individual file
    strOptions = "-ee -o -jhrs"
    End If
    ' Get the short path name to the destination file and append the .zip extension
    lError = GetFSOPath(mvarDestinationDir, mvarDestFileName, strFullZipPath, True)
    ' Test for errors
    If lError <> 0 Then
    ' Error
    Err.Raise lError
    End If
    ' Set the full path to the destination file
    ' Enclose in double quoatation marks
    strFullZipPath = Chr(34) & ShortPathName(strFullZipPath) & Chr(34)
    ' Get the short path name to the source directory
    strSourceDir = ShortPathName(mvarSourceDir)
    ' Ensure the destination path string has a backslash
    CheckForBackSlash strSourceDir
    ' Get the file name for file to zip
    strSourceFileName = mvarSourceFileName
    ' Build the command line argument
    strArg = strWinZipExe & " " & strOptions & " " & strFullZipPath _
    & " " & strSourceDir & strSourceFileName
    ' Execute command line argument
    ' Read Note at wzUnZipFile
    lError = RunAndWait(strArg, vbNormalFocus)
    ' Test for errors
    If lError <> 0 Then
    ' Error
    Err.Raise lError
    End If
    ' Return 0
    wzZipFile = 0

    Exit Function

    ErrorHandler:

    ' Capture error
    lError = Err.Number
    strError = Err.Description
    ' Return error
    wzZipFile = lError
    ' Log error
    ClassError lError, strError, "wzZipFile"

    End Function

    Public Function wzUnZipFile(Optional ByVal AsBatch As Boolean = False) As Long

    Dim strArg As String
    Dim lError As Long
    Dim strError As String
    Dim strZipExeLocation As String
    Dim strWinZipExe As String
    Dim strOptions As String
    Dim strFullZipPath As String
    Dim strSourceDir As String
    Dim strSourceFileName As String
    Dim strDestDir As String
    Dim strDestFile As String

    ' Build the path to the win unzip exe
    strZipExeLocation = wzWinZipExePath & "wzunzip.exe"
    ' Return the short path name for the executable file
    strWinZipExe = ShortPathName(strZipExeLocation)
    ' Set win zip options
    ' Test to see if this is a batch operation or individual file
    ' -o Change the Zip file's file date to the same as the newest file in the Zip file.
    ' -jhrs Do not store hidden, read only, and system attributes in the Zip file.
    ' -yb[c] Automatic, non-interactive ("batch" mode) handling of prompts.
    ' If a prompt is issued, the operation terminate with error level 250.
    ' Use the optional c suffix to automatically continue with a "yes",
    ' "ok" response instead of terminating.
    If AsBatch = True Then
    ' This is a batch operation
    strOptions = "-o -jhrs -ybc"
    Else
    ' We are zipping an individual file
    strOptions = "-o -jhrs"
    End If
    ' Get the short path name to the file to unzip, append the .zip extension
    lError = GetFSOPath(mvarSourceDir, mvarSourceFileName, strFullZipPath, True)
    ' Test for errors
    If lError <> 0 Then
    ' Error
    Err.Raise lError
    End If
    ' Set the full path to the file to unzip
    strFullZipPath = Chr(34) & ShortPathName(strFullZipPath) & Chr(34)
    ' Get the short path name to the destination directory
    strDestDir = ShortPathName(mvarDestinationDir)
    ' Ensure the source dir path has a backslash
    CheckForBackSlash strDestDir
    ' Get the file name for the unzipped file
    strDestFile = mvarDestFileName
    ' Build the command line argument
    strArg = strWinZipExe & " " & strOptions & " " & strFullZipPath & " " _
    & strDestDir & " " & strDestFile
    ' Execute command line argument
    ' You will probably want to change vbNormalFocus
    ' to vbMinimizedNoFocus after purchasing
    ' the WinZip Command Line Option software
    lError = RunAndWait(strArg, vbNormalFocus)
    ' Test for errors
    If lError <> 0 Then
    ' Error
    Err.Raise lError
    End If
    ' Return 0
    wzUnZipFile = 0

    Exit Function

    ErrorHandler:

    ' Capture error
    lError = Err.Number
    strError = Err.Description
    ' Return error
    wzUnZipFile = lError
    ' Log error
    ClassError lError, strError, "wzUnZipFile"

    End Function

    Private Sub Class_Initialize()

    ' Get the location of the win zip exe
    wzWinZipExePath = "C:\Program Files\WinZip\")
    CheckForBackSlash (wzWinZipExePath)

    End Sub

    '************************************************
    '************************************************
    ' Second class module - clsWinZipFC
    ' Instancing Multiuse

    Option Explicit

    Public Function UnZipFile(ByVal SourceDir As String, ByVal ZipFileName As String, _
    ByVal DestDir As String, ByRef FilesToUnZip() As String, _
    Optional ByVal AsBatch As Boolean = False) As Long
    ' This function will unzip the files named in the FilesToUnZip() array
    ' The array can contain wild cards

    Dim lError As Long
    Dim strError As String
    Dim wzZip As clsWinZipCLO
    Dim lCount As Long

    On Error GoTo ErrorHandler

    ' Determine if we are performing the operation as a batch
    ' or as individual files
    If AsBatch = True Then
    ' We will perform a batch operation
    ' There should only be one file named
    For lCount = LBound(FilesToUnZip) To UBound(FilesToUnZip)
    ' Create objects
    Set wzZip = New clsWinZipCLO
    ' Set parameters
    With wzZip
    .SourceDir = SourceDir
    .SourceFileName = ZipFileName
    .DestinationDir = DestDir
    .DestFileName = FilesToUnZip(lCount)
    End With
    ' Execute win unzip
    lError = wzZip.wzUnZipFile(True)
    ' Test for errors
    If lError <> 0 Then
    ' Error
    Err.Raise lError
    End If
    Next lCount
    Else
    ' We are unzipping the files individually
    ' Loop through each file name in the array
    ' Determine how many files are to be unzipped
    For lCount = LBound(FilesToUnZip) To UBound(FilesToUnZip)
    ' Create objects
    Set wzZip = New clsWinZipCLO
    ' Set parameters
    With wzZip
    .SourceDir = SourceDir
    .SourceFileName = ZipFileName
    .DestinationDir = DestDir
    .DestFileName = FilesToUnZip(lCount)
    End With
    ' Execute win unzip
    lError = wzZip.wzUnZipFile(False)
    ' Test for errors
    If lError <> 0 Then
    ' Error
    Err.Raise lError
    End If
    Next lCount
    End If
    ' Return 0
    UnZipFile = 0

    Exit Function

    ErrorHandler:

    ' Capture error
    lError = Err.Number
    strError = Err.Description
    ' Return error
    UnZipFile = lError
    ' Log error
    ClassError lError, strError, "UnZipFile"


    End Function

    Public Function ZipFile(ByVal SourceDir As String, ByRef FilesToZip() As String, _
    ByVal DestDir As String, ByVal DestFileName As String, _
    Optional ByVal AsBatch As Boolean = False) As Long
    ' This function will zip the files named in the FileToZip() array
    ' The array can contain wild cards

    Dim lError As Long
    Dim strError As String
    Dim wzZip As clsWinZipCLO
    Dim lCount As Long

    On Error GoTo ErrorHandler


    ' Determine if we are performing the operation as a batch
    ' or as individual files
    If AsBatch = True Then
    ' We will perform a batch operation
    ' There should only be one file named
    For lCount = LBound(FilesToZip) To UBound(FilesToZip)
    ' Create objects
    Set wzZip = New clsWinZipCLO
    ' Set parameters
    With wzZip
    .SourceDir = SourceDir
    .SourceFileName = FilesToZip(lCount)
    .DestinationDir = DestDir
    .DestFileName = DestFileName
    End With
    ' Execute win zip
    lError = wzZip.wzZipFile(True)
    ' Test for errors
    If lError <> 0 Then
    ' Error
    Err.Raise lError
    End If
    Next lCount
    Else
    ' We are zipping the files individually
    ' Loop through each file name in the array
    ' Determine how many files are to be zipped
    For lCount = LBound(FilesToZip) To UBound(FilesToZip)
    ' Create objects
    Set wzZip = New clsWinZipCLO
    ' Set parameters
    With wzZip
    .SourceDir = SourceDir
    .SourceFileName = FilesToZip(lCount)
    .DestinationDir = DestDir
    .DestFileName = DestFileName
    End With
    ' Execute win zip
    lError = wzZip.wzZipFile(False)
    ' Test for errors
    If lError <> 0 Then
    ' Error
    Err.Raise lError
    End If
    Next lCount
    End If
    ' Return 0
    ZipFile = 0

    Exit Function

    ErrorHandler:

    ' Capture error
    lError = Err.Number
    strError = Err.Description
    ' Return error
    ZipFile = lError
    ' Log error
    ClassError lError, strError, "ZipFile"

    End Function

    Private Sub ClassError(ByVal lError As Long, ByVal strError As String, _
    ByVal strWho As String, Optional ByVal LogOnly As Boolean = False)
    ' This will handle errors for the class module
    ' Same as above, prop code

    End Sub


  3. #3
    Join Date
    Aug 2004
    Posts
    43,023

    Re:Re:How to zip the files With WinZip in VB?

    [Originally posted by FreeVBCode.com]

    Do you mind if I post this on the site under your name as the author?

  4. #4
    Join Date
    Aug 2004
    Posts
    43,023

    Re:Re:Re:How to zip the files With WinZip in VB?

    [Originally posted by Larry Asher]

    No that would be fine. If anything needs more clarification I would be happy to that also.

    Thanks.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
HTML5 Development Center
 
 
FAQ
Latest Articles
Java
.NET
XML
Database
Enterprise
Questions? Contact us.
C++
Web Development
Wireless
Latest Tips
Open Source


   Development Centers

   -- Android Development Center
   -- Cloud Development Project Center
   -- HTML5 Development Center
   -- Windows Mobile Development Center