[VB6] Basic unzip without 3rd party DLL or shell32- IStorage-based

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)- Project has been updated to reference oleexp 4.0 or higher.

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 oleexp.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 oleexp.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 oleexp.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 oleexp.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 oleexp.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 oleexp.IStream
                Set pStrm = pStg.OpenStream(SysAllocString(stat.pwcsName), 0, STGM_READ, 0)
                Dim pStrmFile As oleexp.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 Function

---

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.


UPDATE
For Vista and higher, a really nice complement to this project is to use IExplorerBrowser to have an interactive display of the contents of the zip:
http://i.imgur.com/f1vXCfE.jpg
With that being a full Explorer frame, you can interact with it like you would normally- you can drag and drop from there, navigate subfolders, etc, all automatically- the only code required is to initialize it:

Code:

---

Private pEB As ExplorerBrowser
Private psiRes As IShellItem 'remove Dim of psiRes from Command1_Click !

Private Sub NavigateZip(pObj As IShellItem)
'pObj here would be the psiResult IShellItem from .GetResult in the code
'for picking a zip with pOpenDlg in Command1_Click:
'Delete: Set psiRes = Nothing
'And replace with:  NavigateZip psiRes

If (pEB Is Nothing) Then
    Set pEB = New ExplorerBrowser
    Dim prc As oleexp.RECT
    Dim pfs As FOLDERSETTINGS
   
    pfs.fFlags = FWF_ALIGNLEFT
    pfs.ViewMode = FVM_DETAILS
    prc.Top = 15
    prc.Bottom = (Frame1.Height / 15) - 5
    prc.Left = 5
    prc.Right = (Frame1.Width / 15) - 5
   
    pEB.Initialize Frame1.hWnd, prc, pfs
    pEB.SetOptions EBO_NONE
End If

pEB.BrowseToObject pObj, 0&

End Sub

'also, to resize:
Private Sub Form_Resize()
Frame1.Width = Me.Width - 300
Frame1.Height = Me.Height - 1530
If (pEB Is Nothing) = False Then
    Dim hr As Long
    Dim prc As oleexp.RECT
    Dim lpph As Long
    prc.Top = 15
    prc.Bottom = (Frame1.Height / 15) - 5
    prc.Left = 5
    prc.Right = (Frame1.Width / 15) - 5
    hr = pEB.SetRect(lpph, prc.Left, prc.Top, prc.Right, prc.Bottom)
End If
End Sub

---

As one more added bonus, using Extract All or dragging out a file using the browser supports passwords.

One final thing, the question came up about zip files that don't have the .zip extension, like .xlsm and other Office documents. Here's how to check inside the file for the signature. This method is extremely fast despite having to open the file, so can even replace entirely checking the extension.

Code:

---

Public Function PathIsZipEx(sPath As String) As Boolean
'performs a hard check on a file by opening it and checking for the ZIP signature
'A valid ZIP begins with 0x50,0x4b,0x03,0x04 as the first four bytes.
'If it's an empty zip, it's 0x50,0x4b,0x05,0x06-- this function doesn't count that as valid,
'but if so desired just add an additional check
On Error GoTo Done
Dim aBytes() As Byte
Dim pStrm As oleexp.IStream
Dim hr As Long

hr = SHCreateStreamOnFileEx(StrPtr(sPath), STGM_READ, FILE_ATTRIBUTE_NORMAL, 0&, 0&, pStrm)
If hr = S_OK Then
    ReDim aBytes(3)
    pStrm.Read aBytes(0), 4&
    If (aBytes(0) = &H50) And (aBytes(1) = &H4B) And (aBytes(2) = &H3) And (aBytes(3) = &H4) Then
        PathIsZipEx = True
    End If
Else
    Debug.Print "PathIsZipEx.Error->SHCreateStreamOnFileEx failed to create IStream; hr=0x" & Hex$(hr) & ", file=" & sPath
End If
Done:
Set pStrm = Nothing
End Function

---

------------------
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.

When I see Zip and UnZip, RAR and UnRAR will pop up on my mind. In my region, Most of us used WinRAR instead of WinZip. But I have to admit this is very good project. Thank you show us oleexp3 such advanced stuff!

Yeah it's really just a curiosity. Just thought it was a nice way to familiarize myself with IStorage, but for real work WinRAR is what I use too.

Very long time ago i tried to extract files from the zip archives using zipfldr.dll. This is the raw code, but maybe somebody else it will be interested.

Code:

---

Option Explicit
 
Private Declare Function SHParseDisplayName Lib "shell32" (ByVal pszName As Long, ByVal IBindCtx As Long, ByRef ppidl As Long, sfgaoIn As Long, sfgaoOut As Long) As Long
Private Declare Function ILFree Lib "shell32" (ByVal pidlFree As Long) As Long
Private Declare Function lstrcpyn Lib "kernel32" Alias "lstrcpynW" (ByVal lpString1 As Long, ByVal lpString2 As Long, ByVal iMaxLength As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long
 
Private Const ZipFldrCLSID = "{E88DCCE0-B7B3-11d1-A9F0-00AA0060FA31}"
Private Const IID_IShellExtInit = "{000214E8-0000-0000-C000-000000000046}"
 
Private Sub Form_Load()
    Dim clsid  As UUID
    Dim iidSh  As UUID
    Dim shExt  As IShellExtInit
    Dim pf      As IPersistFolder2
    Dim pidl    As Long
    Dim file    As String
    Dim cb      As Long
   
    file = "D:\Temp\Temp.zip"
    CLSIDFromString ZipFldrCLSID, clsid
    CLSIDFromString IID_IShellExtInit, iidSh
   
    If CoCreateInstance(clsid, Nothing, CLSCTX_INPROC_SERVER, iidSh, shExt) <> S_OK Then Exit Sub
    Set pf = shExt
    SHParseDisplayName StrPtr(file), 0, pidl, 0, 0
    pf.Initialize pidl
    ILFree pidl
 
    Dim srg    As IStorage
    Dim stm    As IStream
    Dim enm    As IEnumSTATSTG
    Dim itm    As STATSTG
    Dim nam    As String
    Dim buf()  As Byte
    Dim fnum    As Integer
   
    Set srg = pf
    Set enm = srg.EnumElements
   
    ReDim buf(&HFFFF&)
   
    enm.Reset
    Do While enm.Next(1, itm) = S_OK
        cb = lstrlen(itm.pwcsName)
        nam = Space(cb)
        lstrcpyn StrPtr(nam), itm.pwcsName, cb + 1
        CoTaskMemFree itm.pwcsName
       
        If itm.Type <> STGTY_STORAGE Then
            fnum = FreeFile
            Open "D:\temp\Testzip\" & nam For Binary As fnum
           
            Set stm = srg.OpenStream(nam, 0, STGM_READ, 0)
           
            Do
                cb = stm.Read(buf(0), UBound(buf) + 1)
                If cb = 0 Then Exit Do
                If cb <= UBound(buf) Then ReDim Preserve buf(cb - 1)
                Put #fnum, , buf()
            Loop
            Close fnum
        End If
    Loop
End Sub

---

Yeah that's basically the same idea, but it uses a different method to get the IStorage interface for the file. There's a couple other ways; IShellItem's binder for one, StgOpenStorageEx would probably work too. And writing the IStream with VB's built-in routines is a neat idea.

Quote:

---

Originally Posted by The trick

Very long time ago i tried to extract files from the zip archives using zipfldr.dll. This is the raw code, but maybe somebody else it will be interested.

---

Just FYI, `ReDim buf(&HFFFF&)` has to be inside the outer loop, somewhere before `Do : cb = stm.Read(buf(0), UBound(buf) + 1) : ... : Loop` part

It works now as is, but once the buffer is `ReDim Preserve`d on final iteration, all subsequent files are extracted with this truncated buffer (which is further truncated on every file) and that is suboptimal and clearly not what you intended to do here.

cheers,
</wqw>

Where do i have to put the oleexp3.tlb?? Thanks

Sorry, found it.. Thanks

Is there a way to compress files and folders into a zip using this method??

Yes, but it's not particularly easy:
http://blog.airesoft.co.uk/2012/10/d...out-libraries/

Thanks fafalone, at this point in my life, i dont really care if its not easy. I'm sick of figthing with Zip32.dll and some other ways... My customers needs to do a bakcup with lots of files and folders. Its really annoying that zip32.dll does not compress folders, at least it doesnt through my code, and the other way doesn't allow me to handle compression the way i can wait for it till its finished. As you see, i'm im really frutrated with this... jajaja

Just be aware especially since it's a business context, there's no way this method can be used to add a password or any other advanced features.

Also, since you'll have to provide a custom implementation of IDataObject if I'm reading things correctly, you'll need to use the IDataObject from olelib2.tlb (untouched original by E. Morcillo; included in the oleexp zip under \source\Implements) -- Implements olelib2.IDataObject -- since VB does not natively support functions in an implemented interface. The kicker is you actually will need them, so some methods will need a v-table swap (see oleexp thread, post #2 under "Implements Issues").

It turns out that you don't. The SHCreateFileDataObject API returns a compatible IDataObject. There's a few weird workarounds required, but I have got it to work:

Code:

---

Public Declare Function SHCreateFileDataObject Lib "shell32" Alias "#740" (ByVal pidlFolder As Long, ByVal cidl As Long, ByVal apidl As Long, pDataInner As Any, ppDataObj As oleexp.IDataObject) As Long
Public Declare Function ILCombine Lib "shell32" (ByVal pidl1 As Long, ByVal pidl2 As Long) As Long
Public Declare Function SHGetDesktopFolder Lib "shell32" (ppshf As IShellFolder) As Long ' Retrieves the IShellFolder interface for the desktop folder.
Public Const MK_LBUTTON = 1

Public Sub ZipTest()
Dim pZipStg As oleexp.IStorage
Dim pZipStrm As oleexp.IStream
Dim psfZipFolder As IShellFolder
Dim pidlZipFolder As Long
Dim pDT As IDropTarget

Dim pidlToZip() As Long
Dim pszToZip() As String
Dim idoToZip As oleexp.IDataObject

Dim pszZipFile As String
Dim pszZipFolder As String
Dim pidlZipFile() As Long

Dim pchEaten As Long
Dim q As Long

ReDim pidlZip(0)
ReDim pidlZipFile(0)
ReDim pszToZip(0)
ReDim pidlToZip(0)
pszToZip(0) = "C:\temp2\bananatime.gif"
pszZipFolder = "C:\temp2\mkziptest"
pszZipFile = "test1.zip"
For q = 0 To UBound(pszToZip)
    pidlToZip(0) = ILCreateFromPathW(StrPtr(pszToZip(q)))
Next
pidlZipFolder = ILCreateFromPathW(StrPtr(pszZipFolder))

Set psfZipFolder = GetIShellFolder(isfDesktop, pidlZipFolder)
Set pZipStg = psfZipFolder 'this calls QueryInterface internally
If (pZipStg Is Nothing) Then
    Debug.Print "Failed to create IStorage"
    GoTo clnup
End If

Set pZipStrm = pZipStg.CreateStream(pszZipFile, STGM_CREATE, 0, 0)
If (pZipStrm Is Nothing) Then
    Debug.Print "Failed to create IStream"
    GoTo clnup
Else
    Debug.Print "Created IStream"
End If

psfZipFolder.ParseDisplayName 0&, 0&, StrPtr(pszZipFile), pchEaten, pidlZipFile(0), 0&
If pidlZipFile(0) Then
    Debug.Print "Got pidl for zip file"
Else
    Debug.Print "Failed to get pidl for zip file"
    GoTo clnup
End If

Call SHCreateFileDataObject(VarPtr(0&), UBound(pidlToZip) + 1, VarPtr(pidlToZip(0)), ByVal 0&, idoToZip)
If (idoToZip Is Nothing) Then
    Debug.Print "Failed to get IDataObject for ToZip"
    GoTo clnup
Else
    Debug.Print "Got IDataObject for ToZip"
End If

Dim pidlFQZF As Long
pidlFQZF = ILCombine(pidlZipFolder, pidlZipFile(0))

'This is very weird. Both psfZipFolder and pidlZipFile(0) are valid, but if we request the IDropTarget using those,
'pDT fails to be generated. But when the zip file's relative pidl is combined with the pidl for its folder, and
'passed to isfDesktop as a fully qualified pidl, it works
'psfZipFolder.GetUIObjectOf 0&, 1, pidlZipFile(0), IID_IDropTarget, 0&, pDT

isfDesktop.GetUIObjectOf 0&, 1, pidlFQZF, IID_IDropTarget, 0&, pDT

If (pDT Is Nothing) Then
    Debug.Print "Failed to get drop target"
    GoTo clnup
Else
    Debug.Print "Got IDropTarget"
End If


pDT.DragEnter idoToZip, MK_LBUTTON, 0&, 0&, DROPEFFECT_COPY
Debug.Print "pDT DragEnter"
pDT.Drop idoToZip, MK_LBUTTON, 0&, 0&, DROPEFFECT_COPY
Debug.Print "pDT Drop"
'cleanup
clnup:
For q = 0 To UBound(pidlToZip)
    Call ILFree(pidlToZip(q))
Next
Call ILFree(pidlZip(0))
Call ILFree(pidlZipFolder)
Call ILFree(pidlFQZF)
End Sub

'-----------------------------
'Supporting functions
Public Function GetIShellFolder(isfParent As IShellFolder, pidlRel As Long) As IShellFolder
  Dim isf As IShellFolder
  On Error GoTo out

  Call isfParent.BindToObject(pidlRel, 0, IID_IShellFolder, isf)

out:
  If Err Or (isf Is Nothing) Then
    Set GetIShellFolder = isfDesktop
  Else
    Set GetIShellFolder = isf
  End If

End Function
Public Function isfDesktop() As IShellFolder
  Static isf As IShellFolder
  If (isf Is Nothing) Then Call SHGetDesktopFolder(isf)
  Set isfDesktop = isf
End Function
Public Function IID_IDropTarget() As UUID
'{00000122-0000-0000-C000-000000000046}
Static iid As UUID
 If (iid.Data1 = 0) Then Call DEFINE_UUID(iid, &H122, CInt(&H0), CInt(&H0), &HC0, &H0, &H0, &H0, &H0, &H0, &H0, &H46)
 IID_IDropTarget = iid
End Function

---

It needs a good bit of cleanup... I'll do that and make a new CodeBank article later on. But it definitely works without a custom IDataObject (so no need for olelib2.tlb)

Edit: Uncovered a second weird workaround that will be needed. I'm not going to update this post but it will be in the new project... The error mentioned in the article 'can't create because empty' popped up on me, and fortunately my initial test code in this post only used one file--- and that was the cause. Trying to add multiple files to an empty zip errors. So add the first, THEN add the rest.

Excellent!!! Thanks Fafalone for your help, i've already used it and it worked OK is all what i need. I will ask you 1 more thing. If you don't bother, could you send me the code of the TLB to my mail the way i can compile it by myself?
I would like to see that there's nothing weird in it before including it to my project. I don't wanna offend you, but i need some security.
Thanks Again!!

[email protected]

For creating ZIPs I did put out a cleaned up code bank entry with sample project for it.

The complete source to the TLB is, and always has been, included in the download in the \source\ folder, along with a .bat to compile it (if VS6 is installed in default dir, otherwise edit it). You'll need to use the VS6 MKTYPLIB; later MIDL compilers from more recent VS versions haven't been able to compile older typelibs. It is always current, as verifying the compiled hash is important to me too.

While I'd include the source out of open source principles anyway, I've always wondered: is it even possible to do something malicious with a TLB? They're not binaries like DLLs or OCXs, and can't compile any executable code in the version that VS6 uses (later versions allow a "cpp_quote" that might theoretically do something)... but then again, .BMP files aren't executables either and we all know what happened there. I would very much like to know for sure though.

Thank you really much, you saved my life with this, i've been looking for so long.

When i have finished with this, i will update a class with both, Zipping and Unzipping functions.

Why didn't you find the UnzipNew.zip download link?
Attachment 140219
Just Like this image.

I found somewhere this code (A little modified by me)
It works (on WinXP) if ZipFileName and DestinationFolder are explicitally typed between " " (Not as String-Variables)

Code:

---

Dim oShell As Object
Dim oFile  As Object
Dim Ret    As Long

Set oShell = CreateObject("Shell.Application")

For Each oFile In oShell.NameSpace("C:\ZippedFile.Zip").Items
        Ret = (oShell.NameSpace("C:\TestDestinationFolder\").CopyHere(oFile))
Next

---

EDIT:
Very easy way HERE using VBScript

Quote:

---

Originally Posted by reexre

It works (on WinXP) if ZipFileName and DestinationFolder are explicitally typed between " " (Not as String-Variables)

---

I believe you can get String variables to work if you wrap them with CVar(), like in this example.

how to unzip only one file? like :a\a2\test.xls
demo.zip filelist:
a\
a\1.txt
a\a2.txt
a\a2\test.xls
b\
c\

how to get length or size by Dim pStrm As oleexp.IStream?

Dim dwSize As Long
dwSize = pStrm.Seek(0, STREAM_SEEK_CUR) ????

In UnzipFiles, add a check on the file name before copying to see if it matches what you want to extract.

how to unzip only one file?
Path1 can use "P1\img"?

Code:

---

pStg.OpenStorage(Path1, 0, STGM_READ, 0, 0)

---

TestFile.zip (have more folder and 100 files)
unzip file:
P1\img\j3.jpg
P1\img\j4.jpg

Quote:

---

Originally Posted by gonzaspina

When i have finished with this, i will update a class with both, Zipping and Unzipping functions.

---

Excuse me, which link is it? Thank you.

Quote:

---

Originally Posted by xiaoyao

Excuse me, which link is it? Thank you.

---

He hasn't posted in 9 years, I wouldn't expect an answer.

Quote:

---

Originally Posted by fafalone

He hasn't posted in 9 years, I wouldn't expect an answer.

---

I have a few comments about your project from this topic.

1. Unpacked files do not set the date, time, and file attributes.
2. Subfolders are not processed
3. If you simply write the path to the ZIP file in the text field without selecting it in the dialog, your program will not unpack it.

Are you going to refine this code and release a new version?

Quote:

---

Originally Posted by HackerVlad

I have a few comments about your project from this topic.

1. Unpacked files do not set the date, time, and file attributes.
2. Subfolders are not processed
3. If you simply write the path to the ZIP file in the text field without selecting it in the dialog, your program will not unpack it.

Are you going to refine this code and release a new version?

---

SHCreateFileDataObject?A virtual file system folder like this.
The main feeling is that its use is very complicated.
If we could wrap it up as a dir function, it might be easier to use.

Ziplib. DLL, something like this, it only takes 200 kb. You can get all the files and folders in a zip file.
You can list the size of each file and the memory address, data length. So you can unzip any directory and unzip any subfile inside.At the same time, it will not occupy any memory.

Like XML, JSON format parsing, if you can do it, you don't need to load the whole file. Any node can be read. This speeds up the operation and reduces the memory footprint.
For example, Excel *.xlsx files are probably the largest XML format documents.
.. Libxl. DLL, you can read the background color of all the cells inside, as well as font size and other attributes. But just load an xlsx file. He has 50,000 rows of data and nearly 20 columns.
It takes five seconds just to load. In fact, I just want to get how many tables there are and how many rows there are.I don't need to read the text of each cell.
So if you're just loading some of the nodes we need, don't actually load the entire XML document.
The new version loads faster, from five seconds to about two seconds.

Quote:

---

Originally Posted by reexre

I found somewhere this code (A little modified by me)
It works (on WinXP) if ZipFileName and DestinationFolder are explicitally typed between " " (Not as String-Variables)

Code:

---

Dim oShell As Object
Dim oFile  As Object
Dim Ret    As Long

Set oShell = CreateObject("Shell.Application")

For Each oFile In oShell.NameSpace("C:\ZippedFile.Zip").Items
        Ret = (oShell.NameSpace("C:\TestDestinationFolder\").CopyHere(oFile))
Next

---

EDIT:
Very easy way HERE using VBScript

---

This is the easiest way to unzip a file on windows.We can even add files or folders to it.
But the scariest thing is that it runs very slowly. Extract a 20kb Excel file in xlsx format. I only want to extract an XML file or image resource from it. It turned out that he needed a second or so.And during the decompression process, it will show a progress bar. If we want to decompress a very large file, maybe 10 MB, it may show a dialog box progress bar, which takes 30 seconds.

Use ziplib, DLL, etc. Extract a 2kb file inside. It doesn't take a second to run, it only takes 10 milliseconds.
So I often suspect that Microsoft's technology is like ie11, which is very stuttering and inefficient.

Access forms, VBA forms, if we use it to display social data or add a lot of controls. It can take up to 10 seconds to load. Like, vb.net, the winform form developed . As long as there are many controls and data, loading will be slow, which may take three to 20 seconds.

Microsoft is very inefficient in some aspects of this operation. Like the chakracore. DLL, which is now free and open source, you can run JS scripts.But it takes six seconds to compute the remainder 11 times.
For the V8 JS engine, it only takes 1.5 seconds. , a 300% increase in speed, a gap that Microsoft has to capitulate on. Admit one's failure.

fafalone, you still haven't answered. Why is the date, time, and attributes of the unpacked files not being set?

All the attributes have to be set by the tool calling the extracting method.
The routines just decompress a byte array to a file, the rest is up to you.

The date and time of the files must be set. The code is incomplete.

Quote:

---

Originally Posted by HackerVlad

I have a few comments about your project from this topic.

1. Unpacked files do not set the date, time, and file attributes.
2. Subfolders are not processed
3. If you simply write the path to the ZIP file in the text field without selecting it in the dialog, your program will not unpack it.

Are you going to refine this code and release a new version?

---

The class module I wrote last time. You can extract any folder, including all subfiles.
A few days ago, I replied to someone that there was a modification of the file date, which was used here.

Normally, why should we change the creation date and the access date?This is useful if we want to keep the unzipped file the same as it was before it was packed.

Quote:

---

Originally Posted by HackerVlad

The date and time of the files must be set. The code is incomplete.

---

The sample project comes with the source code, you can easily modify it to suit your needs.
Also the project is called "Basic unzip without 3rd party DLL or shell32- IStorage-based"

The stat type has the times, pass them to SetFileTimes if you want. Maybe I'll add it but it's a low priority... This is a proof of concept demonstration, not a full featured unzip app.

Quote:

---

Originally Posted by The trick

Very long time ago i tried to extract files from the zip archives using zipfldr.dll. This is the raw code, but maybe somebody else it will be interested.

Code:

---

Option Explicit
 
Private Declare Function SHParseDisplayName Lib "shell32" (ByVal pszName As Long, ByVal IBindCtx As Long, ByRef ppidl As Long, sfgaoIn As Long, sfgaoOut As Long) As Long
Private Declare Function ILFree Lib "shell32" (ByVal pidlFree As Long) As Long
Private Declare Function lstrcpyn Lib "kernel32" Alias "lstrcpynW" (ByVal lpString1 As Long, ByVal lpString2 As Long, ByVal iMaxLength As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long
 
Private Const ZipFldrCLSID = "{E88DCCE0-B7B3-11d1-A9F0-00AA0060FA31}"
Private Const IID_IShellExtInit = "{000214E8-0000-0000-C000-000000000046}"
 
Private Sub Form_Load()
    Dim clsid  As UUID
    Dim iidSh  As UUID
    Dim shExt  As IShellExtInit
    Dim pf      As IPersistFolder2
    Dim pidl    As Long
    Dim file    As String
    Dim cb      As Long
   
    file = "D:\Temp\Temp.zip"
    CLSIDFromString ZipFldrCLSID, clsid
    CLSIDFromString IID_IShellExtInit, iidSh
   
    If CoCreateInstance(clsid, Nothing, CLSCTX_INPROC_SERVER, iidSh, shExt) <> S_OK Then Exit Sub
    Set pf = shExt
    SHParseDisplayName StrPtr(file), 0, pidl, 0, 0
    pf.Initialize pidl
    ILFree pidl
 
    Dim srg    As IStorage
    Dim stm    As IStream
    Dim enm    As IEnumSTATSTG
    Dim itm    As STATSTG
    Dim nam    As String
    Dim buf()  As Byte
    Dim fnum    As Integer
   
    Set srg = pf
    Set enm = srg.EnumElements
   
    ReDim buf(&HFFFF&)
   
    enm.Reset
    Do While enm.Next(1, itm) = S_OK
        cb = lstrlen(itm.pwcsName)
        nam = Space(cb)
        lstrcpyn StrPtr(nam), itm.pwcsName, cb + 1
        CoTaskMemFree itm.pwcsName
       
        If itm.Type <> STGTY_STORAGE Then
            fnum = FreeFile
            Open "D:\temp\Testzip\" & nam For Binary As fnum
           
            Set stm = srg.OpenStream(nam, 0, STGM_READ, 0)
           
            Do
                cb = stm.Read(buf(0), UBound(buf) + 1)
                If cb = 0 Then Exit Do
                If cb <= UBound(buf) Then ReDim Preserve buf(cb - 1)
                Put #fnum, , buf()
            Loop
            Close fnum
        End If
    Loop
End Sub

---

---

I am very grateful for this code. This is a really good example. Since this code extracts files not only from ZIP, but even from EXE! Which contain ZIP files (SFX EXE). And it's very important to me. It's just a pity that this code doesn't handle nested subfolders.

But the included subfolders are handled by the fafalone code, and I don't understand why the fafalone code doesn't work with EXE as with ZIP. Now I'm thinking about putting both versions of the code together and taking the best out of it.

For example, it is also worth noting here that the code from The Trick allows us to extract any files that contain ZIP files *.docx, *.xlsx and exe
The fafalone code is very similar to The trick code, and I don't understand why the fafalone code doesn't work with *.docx, *.xlsx, and so on files...

So why doesn't the fafalone code open DOCX files? I think it's because the SHParseDisplayName function is not used there.

P. S. After all, I did the processing of all the nested subfolders in the code from The trick. Based on the code from The trick, I wrote an example of reading DOCX files and viewing PNG images from DOCX:
https://www.vbforums.com/showthread....iles-in-memory

Quote:

---

Originally Posted by fafalone

The stat type has the times, pass them to SetFileTimes if you want. Maybe I'll add it but it's a low priority... This is a proof of concept demonstration, not a full featured unzip app.

---

I'm currently working on improving this code. If everything is clear to me with the date and time of the files, then what about the attributes of the file? Where to get them from? There are no attributes in this structure! Can you tell me what to do about it?

Use a different method?

Sounds like you want a full featured unzipper which the basic method here doesn't offer.

Quote:

---

Originally Posted by fafalone

Use a different method?

Sounds like you want a full featured unzipper which the basic method here doesn't offer.

---

Are you sure about this?
You can also get the attributes somehow using the interface... Maybe so:
https://learn.microsoft.com/en-us/wi...etattributesof

I actually checked that, the Windows zip folder namespace extension preserves attributes on unzip but the property storage interface but doesn't expose them; I tried force-querying some despite that and the standard attributes property and most others were blank, and the one that wasn't, System.SFGAOFlags, returned incorrect attributes. Also performance is gonna suck if you want to extract file by file instead of the whole thing if you use that method though.

Quote:

---

Originally Posted by fafalone

I actually checked that, the Windows zip folder namespace extension preserves attributes on unzip but the property storage interface but doesn't expose them; I tried force-querying some despite that and the standard attributes property and most others were blank, and the one that wasn't, System.SFGAOFlags, returned incorrect attributes. Also performance is gonna suck if you want to extract file by file instead of the whole thing if you use that method though.

---

Thank you so much for watching. However, Windows Explorer itself extracts files from archives with the automatic setting of file attributes. Windows does it somehow... I wish we could do that...

After all, a real full-fledged file extraction procedure includes the mandatory setting of the date, time, and file attributes. Otherwise, it's not a full-fledged unpacking.

Quote:

---

Originally Posted by fafalone

The stat type has the times, pass them to SetFileTimes if you want. Maybe I'll add it but it's a low priority... This is a proof of concept demonstration, not a full featured unzip app.

---

Another interesting feature: setting the date and time will not work in XP, only in Vista+
For some reason, in XP, the structure is not filled with the time value. All three time values in XP are zeros.

Why insist of using this method if there are multiple other methods available??

Quote:

---

Originally Posted by Arnoutdv

Why insist of using this method if there are multiple other methods available??

---

You will have to write a very lot of lines of code to get it using another method. Not to mention that it's an extra overhead. It will be slower in the end.

Quote:

---

Originally Posted by HackerVlad

Thank you so much for watching. However, Windows Explorer itself extracts files from archives with the automatic setting of file attributes. Windows does it somehow... I wish we could do that...

After all, a real full-fledged file extraction procedure includes the mandatory setting of the date, time, and file attributes. Otherwise, it's not a full-fledged unpacking.

---

Yes you could use Windows to extract a zip archive and the attributes will be set, you just can't read them prior to extraction with that method.

Here's a proof of concept, it works with tB/WinDevLib, I'll leave the switch to VB6/oleexp to you, and note that it's Vista+. XP support would require a major rewrite (though same principle), before XP not possible.

Attributes and file times are set automatically.

Code:

---

    Private Function ExtractByShell(pszZip As String, pszDest As String) As Long
        If PathFileExistsW(StrPtr(pszZip)) = 0 Then
            ExtractByShell = ERROR_FILE_NOT_FOUND
            Exit Function
        End If
        If PathFileExistsW(StrPtr(pszZip)) = 0 Then
            SHCreateDirectory 0, pszDest  'Note: For VB6 you'd change DeclareWide to Declare, String to LongPtr, and use StrPtr. I'll add an overload to next WDL version to avoid this.
        End If
       
        Dim siZip As IShellItem
        Dim siDest As IShellItem
        Dim siChild As IShellItem
        Dim pEnum As IEnumShellItems
        Dim pArray As IShellItemArray
        Dim pCopy As New FileOperation
        Dim pidl() As LongPtr
        Dim cPidl As Long
        Dim pPIDL As IPersistIDList
        Dim lRet As Long
        lRet = SHCreateItemFromParsingName(StrPtr(pszZip), Nothing, IID_IShellItem, siZip)
        lRet = SHCreateItemFromParsingName(StrPtr(pszDest), Nothing, IID_IShellItem, siDest)
        If (siZip Is Nothing) Or (siDest Is Nothing) Then
            ExtractByShell = ERROR_FILE_NOT_FOUND
            Exit Function
        End If
        lRet = siZip.BindToHandler(0, BHID_EnumItems, IID_IEnumShellItems, pEnum)
        If (pEnum Is Nothing) = False Then
            Do While pEnum.Next(1, siChild) = S_OK
                Set pPIDL = siChild
                ReDim Preserve pidl(cPidl)
                pPIDL.GetIDList pidl(cPidl)
                cPidl = cPidl + 1
            Loop
            If cPidl Then
                SHCreateShellItemArrayFromIDLists cPidl, VarPtr(pidl(0)), pArray
                If (pArray Is Nothing) = False Then
                    pCopy.CopyItems pArray, siDest
                    pCopy.PerformOperations
                    pCopy.GetAnyOperationsAborted lRet
                End If
                FreeIDListArray pidl, cPidl
            End If
        End If
        ExtractByShell = lRet
    End Function

---

(In 2015 when this thread was started, I was fresh off a 6 year break from programming and forgot most of the shell stuff, a lot of which wasn't even around in my original time, Vista didn't come out until 2007 and I didn't even install it before breaking in 2009-2014).

Thank you so much for your help. But will this code be able to unpack the docx file, or will there be problems with this?

Quote:

---

Originally Posted by fafalone

it works with tB/WinDevLib, I'll leave the switch to VB6/oleexp to you

---

You gave me incomplete code, which is why I've wasted several hours and still haven't been able to run this code. Even with all libraries connected in Twin Basic, there is still an unknown variable BHID_EnumItems, IID_IEnumShellItems. I really need your help to get these values.

Use MagnumDB for any constants you need:

BHID_EnumItems
IID_IEnumShellItems

Thanks you very muth
You've helped me a lot, as the function I found doesn't work for some reason!

Code:

---

Private Function BHID__EnumItems() As UUID
    Dim lpIID As UUID
   
    lpIID.Data1 = &H70629033
    lpIID.Data2 = &HE363
    lpIID.Data3 = &H4A28
   
    lpIID.Data4(0) = &HA5
    lpIID.Data4(1) = &H67
    lpIID.Data4(2) = &HD
    lpIID.Data4(3) = &HB7
    lpIID.Data4(4) = &H80
    lpIID.Data4(5) = &H6
    lpIID.Data4(6) = &HE6
    lpIID.Data4(7) = &HD7
   
    BHID__EnumItems = lpIID
End Function

---

Of course, it's best to use the CLSIDFromString function, it's more reliable this way! And I just needed such a convenient database where I could find the CLSID by class name.

Quote:

---

Originally Posted by HackerVlad

You gave me incomplete code, which is why I've wasted several hours and still haven't been able to run this code. Even with all libraries connected in Twin Basic, there is still an unknown variable BHID_EnumItems, IID_IEnumShellItems. I really need your help to get these values.

---

First of all, for twinBASIC, the code is complete. As noted (" it works with tB/WinDevLib"), you need to enable the WinDevLib package ("Windows Development Library for twinBASIC") and that's it. It includes all interfaces, APIs, constants, and GUIDs, including the two you mentioned. If you've never added a package manager package to tB before, here's an illustrated guide of how to add WinDevLib. You open settings, go to references, then the packages tab, and check a box; it's no huge burden. The *whole point* of WinDevLib is you can just write code like I did without having to manually define everything, you just tick a box and 99.99% of common Windows API stuff is available.

Second, for VB6, you could have either copied them from WDL or used mIID.bas, which comes with oleexp, in the same zip.

Quote:

---

Originally Posted by fafalone

First of all, for twinBASIC, the code is complete. As noted (" it works with tB/WinDevLib"), you need to enable the WinDevLib package ("Windows Development Library for twinBASIC") and that's it. It includes all interfaces, APIs, constants, and GUIDs, including the two you mentioned. If you've never added a package manager package to tB before, here's an illustrated guide of how to add WinDevLib. You open settings, go to references, then the packages tab, and check a box; it's no huge burden. The *whole point* of WinDevLib is you can just write code like I did without having to manually define everything, you just tick a box and 99.99% of common Windows API stuff is available.

Second, for VB6, you could have either copied them from WDL or used mIID.bas, which comes with oleexp, in the same zip.

---

Yes, I've already figured it out and run this code. He works.

However, I am not deceiving you when I say that for some reason the Twin Basic does not find these two variables, even with all your library connected (I did as per the instructions), I swear to you that the twin basic does not see me.

You must have changed something; like added local copies defined as String when you were trying to use CLSIDFromString. Or forgot to change it back from two underscores to one after removing the local copies you made with that difference like in your post of BHID_EnumItems where you changed the name: In post 48 you posted it as B H I D _ _ E n u m I t e m s when in my original code and my package it's B H I D _ E n u m I t e m s. If you changed my code to use your function, then removed your function, you need to change my code back to the original, a single _ in the name.

There's no way just those two could be missing. They're in the same module as IID_IShellItem; wdIID.twin, on lines 5961 and 2693. I've used them in dozens of projects.

Here's the exact project file I wrote to make and test the code. You'll see there's nothing but that function, Command1_Click that has ExtractByShell Text1.Text, Text2.Text, a Form with those two text boxes, and WinDevLib as an added package. There's no errors.

Simpler:

Code:

---

    Private Function ExtractByShell(pszZip As String, pszDest As String) As Long
        If PathFileExistsW(StrPtr(pszZip)) = 0 Then
            ExtractByShell = ERROR_FILE_NOT_FOUND
            Exit Function
        End If
        If PathFileExistsW(StrPtr(pszZip)) = 0 Then
            SHCreateDirectory 0, pszDest  'Note: For VB6 you'd change DeclareWide to Declare, String to LongPtr, and use StrPtr. I'll add an overload to next WDL version to avoid this.
        End If
       
        Dim siZip As IShellItem
        Dim siDest As IShellItem
        Dim pEnum As IEnumShellItems
        Dim pCopy As New FileOperation
        Dim lRet As Long
        lRet = SHCreateItemFromParsingName(StrPtr(pszZip), Nothing, IID_IShellItem, siZip)
        lRet = SHCreateItemFromParsingName(StrPtr(pszDest), Nothing, IID_IShellItem, siDest)
        If (siZip Is Nothing) Or (siDest Is Nothing) Then
            ExtractByShell = ERROR_FILE_NOT_FOUND
            Exit Function
        End If
        lRet = siZip.BindToHandler(0, BHID_EnumItems, IID_IEnumShellItems, pEnum)
        If (pEnum Is Nothing) = False Then
            pCopy.CopyItems pEnum, siDest
            pCopy.PerformOperations
            pCopy.GetAnyOperationsAborted lRet
        End If
        ExtractByShell = lRet
    End Function

---

Quote:

---

Originally Posted by fafalone

You must have changed something; like added local copies defined as String when you were trying to use CLSIDFromString. Or forgot to change it back from two underscores to one after removing the local copies you made with that difference like in your post of BHID_EnumItems where you changed the name: In post 48 you posted it as B H I D _ _ E n u m I t e m s when in my original code and my package it's B H I D _ E n u m I t e m s. If you changed my code to use your function, then removed your function, you need to change my code back to the original, a single _ in the name.

There's no way just those two could be missing. They're in the same module as IID_IShellItem; wdIID.twin, on lines 5961 and 2693. I've used them in dozens of projects.

Here's the exact project file I wrote to make and test the code. You'll see there's nothing but that function, Command1_Click that has ExtractByShell Text1.Text, Text2.Text, a Form with those two text boxes, and WinDevLib as an added package. There's no errors.

---

Yes, apparently there was a conflict with another connected library, especially if you check TWO boxes and connect your two WinDevLib libraries, then this code will no longer work. Well, it looks like I've already figured out what the problem was. There should be only one library.

Your example is good, thank you.

Quote:

---

Originally Posted by HackerVlad

Yes, apparently there was a conflict with another connected library, especially if you check TWO boxes and connect your two WinDevLib libraries, then this code will no longer work. Well, it looks like I've already figured out what the problem was. There should be only one library.

Your example is good, thank you.

---

There shouldn't be a conflict; they're meant to work together in the event you need the special versions of interfaces for use with Implements... Only problem would be if put the wrong one higher you'd get some different arguments in some interfaces but I'll look into it.

Do While pEnum.Next(1, siChild) = S_OK has its 3rd argument as not optional if you put WinDevLibImpl ahead of WinDevLib in the priority list, but I can't reproduce it finding IID_IShellItem but not those other two under any scenario.

Quote:

---

Originally Posted by fafalone

Do While pEnum.Next(1, siChild) = S_OK has its 3rd argument as not optional if you put WinDevLibImpl ahead of WinDevLib in the priority list, but I can't reproduce it finding IID_IShellItem but not those other two under any scenario.

---

By the way, I immediately noticed about the third parameter. So much for the library conflict.

P.S. Forget about IID_IShellItem, apparently I just had a glitch in the Twin Basic at that time...