So the only other method I've really seen to extract zip archives without shell32 or a 3rd party DLL is a full implementation of the ZIP algorithm, and while this isn't exactly a lightweight method, it's not nearly as complex as that was with all its class modules. As I've mentioned a few times, I'm definitely not a fan of the shell32 object, and I came across an unzip method using things I do like: shell interfaces. Thanks to low-level Windows ZIP integration, it's possible to extract the contents of a simple ZIP archive (doesn't support password-protected zips for example) using IStorage, IStream, and some API.
Requirements
A type library with IStorage and IStream is required, and I strongly recommend using oleexp for future compability (get it here)- any version is fine, there's no new version like new examples usually need; and the sample project is written for that. However, if you change a couple 'oleexp3.x' declares, the original olelib is supported (for the sample project, you'll need a new way of selecting the zip file too since it's using FileOpenDialog).
This method is compatible with Windows XP and higher, but note the sample project for simplicity has a Vista+ FileOpen
Code
Below is a free-standing module you can use without anything else in the demo project (besides oleexp or olelib with changes):
If anyone knows how I could add password support or create a zip file, definitely post ideas in the comments as I'll be working on it.
Thanks
This code is based on code using this method in C by sapero, found here.
------------------
Note: The file I uploaded was named UnzipNew.zip, I have no idea why VBForums keeps renaming it to U.zip. Have tried removing and reattaching several times.
Requirements
A type library with IStorage and IStream is required, and I strongly recommend using oleexp for future compability (get it here)- any version is fine, there's no new version like new examples usually need; and the sample project is written for that. However, if you change a couple 'oleexp3.x' declares, the original olelib is supported (for the sample project, you'll need a new way of selecting the zip file too since it's using FileOpenDialog).
This method is compatible with Windows XP and higher, but note the sample project for simplicity has a Vista+ FileOpen
Code
Below is a free-standing module you can use without anything else in the demo project (besides oleexp or olelib with changes):
Code:
Option Explicit
Public Declare Function ILCreateFromPathW Lib "shell32" (ByVal pwszPath As Long) As Long
Public Declare Sub ILFree Lib "shell32" (ByVal pidl As Long)
Public Declare Function SHBindToParent Lib "shell32" (ByVal pidl As Long, riid As UUID, ppv As Any, pidlLast As Long) As Long
Public Declare Function SHCreateStreamOnFileEx Lib "shlwapi" (ByVal pszFile As Long, ByVal grfMode As STGM, ByVal dwAttributes As FILE_ATTRIBUTES, ByVal fCreate As Long, ByVal pstmTemplate As Long, ppstm As oleexp3.IStream) As Long
Public Declare Function PathFileExistsW Lib "shlwapi" (ByVal lpszPath As Long) As Long
Public Declare Function CreateDirectoryW Lib "kernel32" (ByVal lpPathName As Long, ByVal lpSecurityAttributes As Any) As Long
Public Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal PV As Long) ' Frees memory allocated by the shell
Public Const NOERROR = 0&
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Sub UnzipFile(sFile As String, Optional ByVal sTo As String = "")
'unzip without 3rd party dll
Dim psfParent As oleexp3.IShellFolder
Dim pidlFQ As Long
Dim pidlChild As Long
Dim pszDest As String
If sTo = "" Then
'defaults to create a folder with the zip's name in the same folder as the zip
pszDest = sFile
pszDest = Left$(pszDest, Len(pszDest) - 4) 'remove .zip
Else
pszDest = sTo
End If
'First, we need the parent pidl, child pidl, and IShellFolder
'These are all references to the file very common in shell programming
pidlFQ = ILCreateFromPathW(StrPtr(sFile))
Call SHBindToParent(pidlFQ, IID_IShellFolder, psfParent, pidlChild)
If (psfParent Is Nothing) Or (pidlChild = 0) Then
Debug.Print "UnzipFile.Failed to bind to file"
Exit Sub
End If
'Now that we have the IShellFolder, we want the IStorage object
'That is what we'll be able to extract from, thanks to the
'very low level system zip integration with zipfldr.dll
Dim pStg As oleexp3.IStorage
psfParent.BindToObject pidlChild, 0, IID_IStorage, pStg
If (pStg Is Nothing) Then
Debug.Print "UnzipFile.Failed to bind to storage"
Exit Sub
End If
Debug.Print "UnzipFile.extract to " & pszDest
StgExtract pStg, pszDest
Set pStg = Nothing
Set psfParent = Nothing
ILFree pidlFQ
End Sub
Private Sub StgExtract(pStg As oleexp3.IStorage, pszTargetDir As String, Optional fOverwrite As Long = 0)
'This function is recursively called to extract zipped files and folders
'First, create the target directory (even if you're extracting to an existing folder, it create subfolders from the zip)
If (PathFileExistsW(StrPtr(pszTargetDir)) = 0) Then
Call CreateDirectoryW(StrPtr(pszTargetDir), ByVal 0&)
If (PathFileExistsW(StrPtr(pszTargetDir)) = 0) Then
Debug.Print "StgExtract.Failed to create directory " & pszTargetDir
Exit Sub
End If
End If
'The enumerator will loop through each storage object
'Here, that will be zipped files and folders
Dim pEnum As IEnumSTATSTG
Set pEnum = pStg.EnumElements(0, 0, 0)
If (pEnum Is Nothing) Then
Debug.Print "StgExtract.pEnum==nothing"
Exit Sub
End If
Dim celtFetched As Long
Dim stat As STATSTG
Dim pszPath As String
Do While (pEnum.Next(1, stat, celtFetched) = NOERROR)
pszPath = SysAllocString(stat.pwcsName) 'contains a file name
' Debug.Print "pszPath on alloc=" & pszPath
If (Len(pszPath) > 1) Then
pszPath = AddBackslash(pszTargetDir) & pszPath 'combine that with the path (recursive, so can be zipped folder path)
' Debug.Print "pszPath on combine=" & pszPath
If stat.Type = STGTY_STORAGE Then 'subfolder
Dim pStgSubfolder As oleexp3.IStorage
Set pStgSubfolder = pStg.OpenStorage(SysAllocString(stat.pwcsName), 0, STGM_READ, 0, 0)
If (pStgSubfolder Is Nothing) Then
Debug.Print "StgExtract.pstgsubfolder==nothing"
Exit Sub
End If
StgExtract pStgSubfolder, pszPath 'and if there's more subfolders, we'll go deeper
ElseIf stat.Type = STGTY_STREAM Then 'file
'the basic idea here is that we obtain an IStream representing the existing file,
'and an IStream representing the new extracted file, and copy the contents into the new file
Dim pStrm As oleexp3.IStream
Set pStrm = pStg.OpenStream(SysAllocString(stat.pwcsName), 0, STGM_READ, 0)
Dim pStrmFile As oleexp3.IStream
'here we add an option to not overwrite existing files; but the default is to overwrite
'set fOverwrite to anything non-zero and the file is skipped
'If we are extracting it, we call an API to create a new file with an IStream to write to it
If PathFileExistsW(StrPtr(pszPath)) Then
If fOverwrite Then
Call SHCreateStreamOnFileEx(StrPtr(pszPath), STGM_CREATE Or STGM_WRITE, FILE_ATTRIBUTE_NORMAL, 1, 0, pStrmFile)
End If
Else
Call SHCreateStreamOnFileEx(StrPtr(pszPath), STGM_CREATE Or STGM_WRITE, FILE_ATTRIBUTE_NORMAL, 1, 0, pStrmFile)
End If
If (pStrmFile Is Nothing) = False Then
'Debug.Print "StgExtract.Got pstrmfile"
Dim cbSize As Currency 'the STATSTG cbSize is ULONGLONG (equiv. to Currency), so files >2GB should be fine
pStrm.CopyTo pStrmFile, stat.cbSize, 0, cbSize
Set pStrmFile = Nothing
'Debug.Print "StgExtract.bytes written=" & CStr(cbSize)
Else
'either an error or skipped an existing file; either way we don't exit, we'll move on to the next
'Debug.Print "StgExtract.pstrmfile==nothing"
End If
Set pStrm = Nothing
End If
End If
pszPath = ""
Call CoTaskMemFree(stat.pwcsName) 'this memory needs to be freed, otherwise you'll leak memory
Loop
Set pEnum = Nothing
End Sub
Public Function LPWSTRtoStr(lPtr As Long, Optional ByVal fFree As Boolean = True) As String
SysReAllocString VarPtr(LPWSTRtoStr), lPtr
If fFree Then
Call CoTaskMemFree(lPtr)
End If
End Function
Public Function AddBackslash(s As String) As String
If Len(s) > 0 Then
If Right$(s, 1) <> "\" Then
AddBackslash = s & "\"
Else
AddBackslash = s
End If
Else
AddBackslash = "\"
End If
End Function
Public Function IID_IStorage() As UUID
'({0000000B-0000-0000-C000-000000000046})
Static iid As UUID
If (iid.Data1 = 0) Then Call DEFINE_OLEGUID(iid, &HB, 0, 0)
IID_IStorage = iid
End Function
'-----------------------------------------------------------
'Below this is not needed if you're using mIID.bas
'(check if the above IID_IStorage exists or not, because this was released before the update that included it)
'-----------------------------------------------------------
Public Sub DEFINE_UUID(Name As UUID, L As Long, w1 As Integer, w2 As Integer, B0 As Byte, b1 As Byte, b2 As Byte, B3 As Byte, b4 As Byte, b5 As Byte, b6 As Byte, b7 As Byte)
With Name
.Data1 = L
.Data2 = w1
.Data3 = w2
.Data4(0) = B0
.Data4(1) = b1
.Data4(2) = b2
.Data4(3) = B3
.Data4(4) = b4
.Data4(5) = b5
.Data4(6) = b6
.Data4(7) = b7
End With
End Sub
Public Sub DEFINE_OLEGUID(Name As UUID, L As Long, w1 As Integer, w2 As Integer)
DEFINE_UUID Name, L, w1, w2, &HC0, 0, 0, 0, 0, 0, 0, &H46
End Sub
Public Function IID_IShellFolder() As UUID
Static iid As UUID
If (iid.Data1 = 0) Then Call DEFINE_OLEGUID(iid, &H214E6, 0, 0)
IID_IShellFolder = iid
End FunctionThanks
This code is based on code using this method in C by sapero, found here.
------------------
Note: The file I uploaded was named UnzipNew.zip, I have no idea why VBForums keeps renaming it to U.zip. Have tried removing and reattaching several times.
