[VB6] modShellZipUnzip.bas - Zip/Unzip Using Shell Library
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.
Code:
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
Re: [VB6] modShellZipUnzip.bas
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
Re: [VB6] modShellZipUnzip.bas
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.
Re: [VB6] modShellZipUnzip.bas
Quote:
Originally Posted by
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.
is there a way to still hide progress?
Re: [VB6] modShellZipUnzip.bas
Quote:
Originally Posted by
sergeos
is there a way to still hide progress?
FindWindow + ShowWindow might be able to do it.
Re: [VB6] modShellZipUnzip.bas
Quote:
Originally Posted by
Bonnie West
can you help write the example? :rolleyes:
Re: [VB6] modShellZipUnzip.bas
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!
Re: [VB6] modShellZipUnzip.bas
Thanks, but I'm weak in this matter
Re: [VB6] modShellZipUnzip.bas
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
Re: [VB6] modShellZipUnzip.bas
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.
Re: [VB6] modShellZipUnzip.bas
HI all, i know it's and old code/post but i have a little question.
Due this process is Asynchronous, how can i wait until shellzip finishes to work
I tried
Code:
Do While ShellZip(Carpeta_Backup1 & Carpeta_Backup2 & "\" & sFolder, xFicheroDestino) = False
do something
loop
but if i'm zipping a big txt file, shellzip is true before it finishes to process the file
Re: [VB6] modShellZipUnzip.bas
I think i solved it, i have to do some checks but... it seems it works:
changed shellzip function to:
Code:
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&)
' Esperar a que termine el proceso de compresión
Do While Not WaitForZipCompletion(DestZip)
ShellZip = False
Loop
Pausa 2
ShellZip = True
On Error GoTo 0
End Function
Created a new function:
Code:
Private Function WaitForZipCompletion(ByRef DestZip As String) As Boolean
Dim objShell As Object
Dim objZip As Object
Dim startTime As Single
Set objShell = CreateObject("Shell.Application")
Set objZip = objShell.NameSpace(CVar(DestZip))
' Tiempo máximo de espera en segundos
Const TIMEOUT_SECONDS As Single = 60
startTime = Timer
Do
' Verifica si el ZIP contiene archivos (Items > 0)
If objZip.Items.count > 0 Then
WaitForZipCompletion = True
Exit Function
End If
' Salir si se supera el tiempo límite
If Timer - startTime > TIMEOUT_SECONDS Then Exit Do
DoEvents ' Permitir que el sistema procese otros eventos
Loop
WaitForZipCompletion = False
End Function
Re: [VB6] modShellZipUnzip.bas
how to unzaip a file from abc.zip (have 20 files and folder),
unzip abc.zip\123\test.txt
unzip abc.zip\123 to D:\123
HOW TO ADD files or folders to abc.zip
addzipfiles d:\123b\ ,"abc.zip\123b"
Re: [VB6] modShellZipUnzip.bas
Quote:
Originally Posted by
xiaoyao
how to unzaip a file from abc.zip (have 20 files and folder),
unzip abc.zip\123\test.txt
unzip abc.zip\123 to D:\123
HOW TO ADD files or folders to abc.zip
addzipfiles d:\123b\ ,"abc.zip\123b"
Personally, for these purposes, I would use a class for working with ZIP from wqweto
Re: [VB6] modShellZipUnzip.bas
I've tested it. It's not difficult.
I never thought that this zip file could be edited. You can add files and delete files inside.Microsoft has managed this, ah, a zip file like a folder, which is really very clever.
If the ISO file can also directly add files, delete files, do not need to generate a new file, almost little modification ah, hard disk data so very good.
Re: [VB6] modShellZipUnzip.bas
Nice code if you don't mine I use this to use in my little VB projects backup tool. Thanks for shareing
Re: [VB6] modShellZipUnzip.bas
Hi All,
I need to be able to create a .zip file containing a collection of files and folders. I found this thread, and thought it would be a good start as it seems simple enough. I used the code in post #1, and created a small test project. At the moment, I'm trying to simply zip a file in my project directory by doing this:
Public Sub Main()
Dim bSuccess As Boolean
bSuccess = ShellZip("Test.txt", "Test.zip")
If bSuccess = True Then MsgBox "OK" Else MsgBox "Fail"
End Sub
Although bSuccess = False, a .zip file, "Test.zip" is created, but it's empty. I was expecting it to contain the file "Test.txt".
What am I missing?
John
Re: [VB6] modShellZipUnzip.bas
> What am I missing?
Use full filenames incl. path to file.