[VB6] modShellZipUnzip.bas

[Bonnie West]

The following code compresses/decompresses a file or folder to/from a zip file using the Microsoft Shell Controls And Automation library. It additionally tries to cleanup the mess Shell leaves behind when decompressing.

Option Explicit

'Asynchronously compresses a file or folder. Result differs if folder has a trailing backslash ("\").
Public Function ShellZip(ByRef Source As String, ByRef DestZip As String) As Boolean
    CreateNewZip DestZip

    On Error Resume Next
    With CreateObject("Shell.Application")  'Late-bound
   'With New Shell                          'Referenced
        If Right$(Source, 1&) = "\" Then
            .NameSpace(CVar(DestZip)).CopyHere .NameSpace(CVar(Source)).Items
        Else
            .NameSpace(CVar(DestZip)).CopyHere CVar(Source)
        End If
    End With

    ShellZip = (Err = 0&)
End Function

'Asynchronously decompresses the contents of SrcZip into the folder DestDir.
Public Function ShellUnzip(ByRef SrcZip As String, ByRef DestDir As String) As Boolean
    On Error Resume Next
    With CreateObject("Shell.Application")  'Late-bound
   'With New Shell                          'Referenced
        .NameSpace(CVar(DestDir)).CopyHere .NameSpace(CVar(SrcZip)).Items
    End With

    ShellUnzip = (Err = 0&)

    RemoveTempDir Right$(SrcZip, Len(SrcZip) - InStrRev(SrcZip, "\"))
End Function

'Creates a new empty Zip file only if it doesn't exist.
Private Function CreateNewZip(ByRef sFileName As String) As Boolean
    With CreateObject("Scripting.FileSystemObject")  'Late-bound
   'With New FileSystemObject                        'Referenced
        On Error GoTo 1
        With .CreateTextFile(sFileName, Overwrite:=False)
            .Write "PK" & Chr$(5&) & Chr$(6&) & String$(18&, vbNullChar)
            .Close
1       End With
    End With

    CreateNewZip = (Err = 0&)
End Function

'Schedules a temporary directory tree for deletion upon reboot.
Private Function RemoveTempDir(ByRef sFolderName As String) As Boolean
    Dim sPath As String, sTemp As String

    On Error Resume Next
    sTemp = Environ$("TEMP") & "\"
    sPath = Dir(sTemp & "Temporary Directory * for " & sFolderName, vbDirectory Or vbHidden)

    If LenB(sPath) Then
        With CreateObject("WScript.Shell")  'Late-bound
       'With New WshShell                   'Referenced
            Do: .RegWrite "HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce\*RD_" & _
                           Replace(sPath, " ", "_"), Environ$("ComSpec") & " /C " & _
                          "@TITLE Removing " & sPath & " ...&" & _
                          "@RD /S /Q """ & sTemp & sPath & """"
                 sPath = Dir
            Loop While LenB(sPath)
        End With
    End If

    RemoveTempDir = (Err = 0&)
End Function

[Bonnie West]

Updated the code - it now tries to cleanup the mess Shell left behind.

[couttsj]

The constant FOF_NOCONFIRMATION seems to have no impact at all. It still prompts me when I update an existing zip file. Is this normal?

J.A. Coutts

[Bonnie West]

Indeed, it has no effect at all. The Folder.CopyHere method notes that "in some cases, such as compressed (.zip) files, some option flags may be ignored by design". That flag may be left out.

[sergeos]

Indeed, it has no effect at all. The Folder.CopyHere method notes that "in some cases, such as compressed (.zip) files, some option flags may be ignored by design". That flag may be left out.

is there a way to still hide progress?

[Bonnie West]

is there a way to still hide progress?

FindWindow + ShowWindow might be able to do it.

[sergeos]

FindWindow + ShowWindow might be able to do it.

can you help write the example?

[Bonnie West]

There are plenty of examples of using both APIs here and elsewhere. If unsure about the parameters of either one, consult the given documentation link. They are pretty simple to use; I'm sure you will figure it out in no time!

[sergeos]

Thanks, but I'm weak in this matter

[Tomasek-TMK]

It is appropriate to use FOF_NOCONFIRMATION not bother Flask of the existence of the file.

module:
Public Const FOF_NOCONFIRMATION = & H10

Swap:
. Namespace (CVar (DestDir)). CopyHere. Namespace (CVar (SrcZip)). Items
The new code
. Namespace (CVar (DestDir)). CopyHere. Namespace (CVar (SrcZip)). Items, FOF_NOCONFIRMATION

[Bonnie West]

I've just tested that code again in Vista (it was originally developed in XP) and still, the Shell ignores the FOF_NOCONFIRMATION flag. So, whether you use that flag or not makes no difference.