vb6 - Zipping and Unzipping using Shell32

I found this code in a c# site and decided to use it in vb6. I've seen other ways to zip and unzip, but most all required 3rd party dlls. This one requires a reference to shell32.dll.

Basically it creates an empty zip file, then uses shell32 to copy files to/from it. Adds single zip file, zips a folder or directory, unzips.

Code:

---

Option Explicit

'//source was in C# from urls:
'//http://www.codeproject.com/csharp/CompressWithWinShellAPICS.asp
'//http://www.codeproject.com/csharp/DecompressWinShellAPICS.asp

'//set reference to "Microsoft Shell Controls and Automation"


'http://forums.microsoft.com/MSDN/ShowPost.aspx?PostID=1090552&SiteID=1
'Be aware when using the shell automation interface to unzip files as it
'leaves copies of the zip files in the temp directory (defined by %TEMP%).
'Folders named "Temporary Directory X for demo.zip" are generated where X
'is a sequential number from 1 - 99.  When it reaches 99 you will then get
'a error dialog saying "The file exists" and it will not continue.
'I 've no idea why Windows doesn't clean up after itself when unzipping files,
'but it is most annoying...


'//CopyHere options
'0 Default. No options specified.
'4 Do not display a progress dialog box.
'8 Rename the target file if a file exists at the target location with the same name.
'16 Click "Yes to All" in any dialog box displayed.
'64 Preserve undo information, if possible.
'128 Perform the operation only if a wildcard file name (*.*) is specified.
'256 Display a progress dialog box but do not show the file names.
'512 Do not confirm the creation of a new directory if the operation requires one to be created.
'1024 Do not display a user interface if an error occurs.
'4096 Disable recursion.
'9182 Do not copy connected files as a group. Only copy the specified files.

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub Zip_Activity(Action As String, sFileSource As String, sFileDest As String)

    '//copies contents of folder to zip file
    Dim ShellClass  As Shell32.Shell
    Dim Filesource  As Shell32.Folder
    Dim Filedest    As Shell32.Folder
    Dim Folderitems As Shell32.Folderitems
   
    If sFileSource = "" Or sFileDest = "" Then GoTo EH
               
    Select Case UCase$(Action)
       
        Case "ZIPFILE"
           
            If Right$(UCase$(sFileDest), 4) <> ".ZIP" Then
                sFileDest = sFileDest & ".ZIP"
            End If
           
            If Not Create_Empty_Zip(sFileDest) Then
                GoTo EH
            End If
       
            Set ShellClass = New Shell32.Shell
            Set Filedest = ShellClass.NameSpace(sFileDest)
           
            Call Filedest.CopyHere(sFileSource, 20)
               
        Case "ZIPFOLDER"
           
            If Right$(UCase$(sFileDest), 4) <> ".ZIP" Then
                sFileDest = sFileDest & ".ZIP"
            End If
           
            If Not Create_Empty_Zip(sFileDest) Then
                GoTo EH
            End If
       
            '//Copy a folder and its contents into the newly created zip file
            Set ShellClass = New Shell32.Shell
            Set Filesource = ShellClass.NameSpace(sFileSource)
            Set Filedest = ShellClass.NameSpace(sFileDest)
            Set Folderitems = Filesource.Items
           
            Call Filedest.CopyHere(Folderitems, 20)
       
        Case "UNZIP"
           
            If Right$(UCase$(sFileSource), 4) <> ".ZIP" Then
                sFileSource = sFileSource & ".ZIP"
            End If
           
            Set ShellClass = New Shell32.Shell
            Set Filesource = ShellClass.NameSpace(sFileSource)      '//should be zip file
            Set Filedest = ShellClass.NameSpace(sFileDest)          '//should be directory
            Set Folderitems = Filesource.Items                      '//copy zipped items to directory
           
            Call Filedest.CopyHere(Folderitems, 20)
       
        Case Else
       
    End Select
           
    '//Ziping a file using the Windows Shell API creates another thread where the zipping is executed.
    '//This means that it is possible that this console app would end before the zipping thread
    '//starts to execute which would cause the zip to never occur and you will end up with just
    '//an empty zip file. So wait a second and give the zipping thread time to get started.

    Call Sleep(1000)
   
EH:

    If Err.Number <> 0 Then
        MsgBox Err.Description, vbExclamation, "error"
    End If

    Set ShellClass = Nothing
    Set Filesource = Nothing
    Set Filedest = Nothing
    Set Folderitems = Nothing

End Sub

Private Function Create_Empty_Zip(sFileName As String) As Boolean

    Dim EmptyZip()  As Byte
    Dim J          As Integer

    On Error GoTo EH
    Create_Empty_Zip = False

    '//create zip header
    ReDim EmptyZip(1 To 22)

    EmptyZip(1) = 80
    EmptyZip(2) = 75
    EmptyZip(3) = 5
    EmptyZip(4) = 6
   
    For J = 5 To UBound(EmptyZip)
        EmptyZip(J) = 0
    Next

    '//create empty zip file with header
    Open sFileName For Binary Access Write As #1

    For J = LBound(EmptyZip) To UBound(EmptyZip)
        Put #1, , EmptyZip(J)
    Next
   
    Close #1

    Create_Empty_Zip = True

EH:
   
    If Err.Number <> 0 Then
        MsgBox Err.Description, vbExclamation, "Error"
    End If
   
End Function

---

Hey Sweeve !!! for beginners like me can u please attach the project file along?????plz.....do that.....


thanx in advance,
wiz....

Thanx...

thanks

thanks sweeve!! u da MAN!:). I used this routine in an application where I was installing 200 flag icons and was not looking forward to writing 200 lines for the setup program to install them one by one. It worked great once i created the zip file using xp send to zip folder command rather than the zip file created by some obscure zip app which created a zip that wasn't recognized by shell, and added the reference to shell dll from vb project references mnu.

thanks once again, it was a KISSS (keep it short simple sweet) solution. The best kind!!

cheers!

good one, thanks...

http://www.img-host.at-zone.net/?di=1613133004262

facing this error while trying to unzip .txt or picture file from a zip file.Need solution

Quote:

---

Originally Posted by l0cal_h0st

http://www.vbforums.com/

facing this error while trying to unzip .txt or picture file from a zip file.Need solution

---

Try to compile the project and test it on a virtual machine with windows xp installed if it works you know that it is possible that its only for windows xp.
Or it needs te be rewritten..

~NiTrOwow

This code is amazingly helpful. My only problem is that the CopyHere statement opens another window and the calling application continues processing. I tried putting in a few SLEEP statements but that's not the right solution because sometimes it isn't long enough and sometimes too long.

I've used the Shell statement in another application (not Shell32) and grabbed the program handle so that I could wait until that new window is complete. It would be great if I could do that here.

Any suggestions how I could do that or some other foolproof way to wait for the copy to complete?

Thank you!

Sweeve - I have'nt tested your code so will not comment on that specifically however;
1. This technique is only good for Windows XP and later. Albiet pre XP systems are pretty much out of fashion now!
2. The zip produced is a little larger than can be achieved using third party tools.

Edit: Sorry I omitted to notice that this thread is also pretty much out of fashion as well!

Yup you can better use winrar.dll now within your project. Because that would work in Windows Vista/7 and 8 too!

Quote:

---

Originally Posted by NiTrOwow

Yup you can better use winrar.dll now within your project. Because that would work in Windows Vista/7 and 8 too!

---

I was trying to avoid using other people's software and use Windows functions.

I decided to use the software supplied in this post, create my own executable with parameters for action, source and destination, return code and return message. Then I can call the executable and use the WaitForSingleObject dll to wait until the zipping is done.

Thanks for the great post.

This code has been working well for me except for one problem. What I'm doing is zipping up 500 image files plus a text file which is like a directory of the images. Sometimes all the files get zipped and sometimes it stops after most but not all the images are zipped. I'm using the ZIPFOLDER option to zip all files in a particular folder.

Is there a size constraint? A count constraint? A timing issue?

Please advise and thanks again!

Quote:

---

Originally Posted by JudyKamber

This code has been working well for me except for one problem. What I'm doing is zipping up 500 image files plus a text file which is like a directory of the images. Sometimes all the files get zipped and sometimes it stops after most but not all the images are zipped. I'm using the ZIPFOLDER option to zip all files in a particular folder.

---

Not sure if this would help but there is a list of values commented out in the code. Try changing the "20" below to a different number.

vb Code:

Call Filedest.CopyHere(Folderitems, 20)

Thanks for that idea about the CopyHere parameter. I don't see any of them which, by their description, might cause my symptoms. Why would the copy just stop part way through the directory? Do you think changing a dialog box display or those other choices might affect the completion of the copying?

Thanks for any assistance!

I was using the shell32 to unzip folder but now i need unzip rar folders and it give me an error with the shell how can i solve this???

Quote:

---

Originally Posted by JudyKamber

Thanks for that idea about the CopyHere parameter. I don't see any of them which, by their description, might cause my symptoms. Why would the copy just stop part way through the directory? Do you think changing a dialog box display or those other choices might affect the completion of the copying?

Thanks for any assistance!

---

Worth a shot since I haven't actually used this before I wouldn't know.

Quote:

---

Originally Posted by sory

I was using the shell32 to unzip folder but now i need unzip rar folders and it give me an error with the shell how can i solve this???

---

What is the exact error you are receiving?

thnx for the code. but i m getting an error in following line --

"Set Filedest = ShellClass.NameSpace(sFileDest)"

Error is "Object variable or with block variable not set"
plz tell me how to solve it?