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

[fafalone]

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):

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:

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:

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.

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.

[Jonney]

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!

[fafalone]

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.

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

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

[fafalone]

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.

[wqweto]

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>

[gonzaspina]

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

[gonzaspina]

Sorry, found it.. Thanks

[gonzaspina]

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

[fafalone]

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

[gonzaspina]

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

[fafalone]

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:

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.

[gonzaspina]

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

gspina1995@gmail.com

[fafalone]

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.

[gonzaspina]

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

[gonzaspina]

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

[ChenLin]

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

[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)

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

[Bonnie West]

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.

[xiaoyao]

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) ????

[fafalone]

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

[xiaoyao]

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

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