Zip and Unzip with Progress Monitoring

Download Chilkat Zip ActiveX (includes objects for .zip, .gz, .bz2, and .Z)

This Visual Basic example program shows how to Zip and Unzip with progress monitoring.

' VB Example Program showing Zip and Unzip with progress monitoring.
Option Explicit
Dim WithEvents ZipFile As ChilkatZip2

' VB to Unzip a Zip archive with progress monitoring
Private Sub Unzip_Click()
    
    Text1.Text = ""
    
    Dim success As Long
    
    ' Create a ChilkatZip object
    Set ZipFile = New ChilkatZip2
    
    ZipFile.UnlockComponent UnlockCodeText.Text
    success = ZipFile.OpenZip(OutputZip.Text)
    If (success = 0) Then
        MsgBox ZipFile.LastErrorText
        Exit Sub
    End If
        
    UnzipStatus.Caption = "Unzipping " + Str(ZipFile.NumEntries) + " files"
    UnzipStatus.Refresh
    
    ' Unzip the entire archive into the specified directory, creating the
    ' the subdirectories (if any) automatically.
    UnzipProgressBar.Value = 0
    
    ' Do the unzip.
    Dim count As Long
    
    count = ZipFile.Unzip(DestDir.Text)
    If (count = -1) Then
        ' The unzip failed
        MsgBox ZipFile.LastErrorText
        ZipFile.CloseZip
        Exit Sub
    End If
        
    ZipFile.SaveLastError "unzipLog.xml"
    
    UnzipStatus.Caption = "Success!"
        
    ZipFile.CloseZip
    
End Sub

Private Sub Zip_Click()

    Text1.Text = ""
    
    ' Create a ChilkatZip object
    Set ZipFile = New ChilkatZip2
    
    ZipFile.UnlockComponent UnlockCodeText.Text
    ZipFile.NewZip OutputZip.Text
    
    ' Add the directory and all files recursively to the Zip object
    Dim success As Long
    success = ZipFile.AppendFiles(SourceDir.Text, 1)
    If (success = 0) Then
        MsgBox ZipFile.LastErrorText
        Exit Sub
    End If
    
    ' See if anything was added.
    If (ZipFile.NumEntries = 0) Then
        ZipStatus.Caption = "Error, no files added to the Zip archive."
        Exit Sub
    End If
    
    Dim savedN As Integer
    savedN = ZipFile.NumEntries
    
    ' Compress and write to disk.
    ZipProgressBar.Value = 0
    success = ZipFile.WriteZipAndClose()
    If (success = 0) Then
        MsgBox ZipFile.LastErrorText
        Exit Sub
    End If
    
    ZipStatus.Caption = "Success. " + Str(savedN) + " files zipped"
               
End Sub

Private Sub Form_Load()
    OutputZip.Text = CurDir$ + "\progress.zip"
    DestDir.Text = CurDir$
    
End Sub

' Called once just before files are added.
Private Sub ZipFile_AddFilesBegin()
    Text1.Text = Text1.Text & "AddFilesBegin" & vbCrLf
End Sub

' Called once after all files have been added.
Private Sub ZipFile_AddFilesEnd()
    Text1.Text = Text1.Text & "AddFilesEnd" & vbCrLf
End Sub

' Called once after each file is added to the Zip.
Private Sub ZipFile_FileAdded(ByVal filename As String, ByVal fileSize As Long, abort As Long)
    Text1.Text = Text1.Text & "FileAdded: " & filename & " (size = " & Str(fileSize) & ")" & vbCrLf

End Sub

' Called once after each file is unzipped.
Private Sub ZipFile_FileUnzipped(ByVal filename As String, ByVal compressedSize As Long, ByVal uncompressedSize As Long, abort As Long)
    Text1.Text = Text1.Text & "FileUnzipped: " & filename & "(compressed = " & Str(compressedSize) & ", uncompressed = " & Str(uncompressedSize) & ")" & vbCrLf

    ' Set abort to 1 if you want the Unzipping to stop at this file.
    'If InStr(filename, "SOUND") Then
    '    abort = 1
    'End If
    
End Sub

' Called once after each file is Zipped.
Private Sub ZipFile_FileZipped(ByVal filename As String, ByVal fileSize As Long, ByVal compressedSize As Long, abort As Long)
    Text1.Text = Text1.Text & "FileZipped: " & filename & "(size = " & Str(fileSize) & ", compressed size = " & Str(compressedSize) & ")" & vbCrLf
End Sub

' Called once before each file is to be added.  Individual files can be excluded
' by setting "exclude" to 1.
Private Sub ZipFile_ToBeAdded(ByVal filename As String, ByVal fileSize As Long, exclude As Long)

    Text1.Text = Text1.Text & "ToBeAdded: " & filename & "(size = " & Str(fileSize) & ")" & vbCrLf
    
    ' Exclude anything files where the filename contains "OLE"
    'If InStr(filename, "OLE") Then
    '    exclude = 1
    'End If
    
End Sub

' Called once before each file is to be Unzipped.
Private Sub ZipFile_ToBeUnzipped(ByVal filename As String, ByVal compressedSize As Long, ByVal uncompressedSize As Long, exclude As Long)
    Text1.Text = Text1.Text & "ToBeUnzipped: " & filename & "(compressed = " & Str(compressedSize) & ", uncompressed = " & Str(uncompressedSize) & ")" & vbCrLf
    
    ' Exclude anything files where the filename contains "SOUND"
    'If InStr(filename, "SOUND") Then
    '    exclude = 1
    'End If

End Sub

' Called once before each file is to be Zipped.
Private Sub ZipFile_ToBeZipped(ByVal filename As String, ByVal fileSize As Long, exclude As Long)
    Text1.Text = Text1.Text & "ToBeZipped: " & filename & "(size = " & Str(fileSize) & ")" & vbCrLf
    
    ' Exclude anything files where the filename contains "SOUND"
    'If InStr(filename, "SOUND") Then
    '    exclude = 1
    'End If
    
End Sub

' Called once when Unzipping begins
Private Sub ZipFile_UnzipBegin()
    Text1.Text = Text1.Text & "UnzipBegin" & vbCrLf
End Sub

' Called once when Unzipping ends.
Private Sub ZipFile_UnzipEnd()
    Text1.Text = Text1.Text & "UnzipEnd" & vbCrLf
End Sub

' Called periodically during the Unzip
Private Sub ZipFile_UnzipPercentDone(ByVal percentComplete As Long, abort As Long)
    UnzipProgressBar.Value = percentComplete
    Text1.Text = Text1.Text & "UnzipPercentDone: " & Str(percentComplete) & vbCrLf
    ' Set abort = 1 to abort the Unzip
End Sub

' Called once when zipping begins
Private Sub ZipFile_WriteZipBegin()
    Text1.Text = Text1.Text & "WriteZipBegin" & vbCrLf
End Sub

' Called once when zipping is finished.
Private Sub ZipFile_WriteZipEnd()
    Text1.Text = Text1.Text & "WriteZipEnd" & vbCrLf
End Sub

' Called periodically during the creation of the Zip file.
Private Sub ZipFile_WriteZipPercentDone(ByVal percentDone As Long, abort As Long)
    ZipProgressBar.Value = percentDone
    Text1.Text = Text1.Text & "WriteZipPercentDone: " & Str(percentDone) & vbCrLf
    ' Set abort = 1 to abort the WriteZip
End Sub