Zip and Unzip with Progress Monitoring

Download Chilkat Zip ActiveX

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