dcsimg
Results 1 to 19 of 19

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

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,245

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

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

  2. #2
    Frenzied Member
    Join Date
    Jan 2010
    Posts
    1,103

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

    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!

  3. #3

  4. #4
    Frenzied Member
    Join Date
    Feb 2015
    Posts
    1,329

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

    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

  5. #5

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,245

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

    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.

  6. #6
    Frenzied Member wqweto's Avatar
    Join Date
    May 2011
    Posts
    1,413

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

    Quote Originally Posted by The trick View Post
    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>

  7. #7
    New Member
    Join Date
    Nov 2015
    Posts
    7

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

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

  8. #8
    New Member
    Join Date
    Nov 2015
    Posts
    7

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

    Sorry, found it.. Thanks

  9. #9
    New Member
    Join Date
    Nov 2015
    Posts
    7

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

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

  10. #10

  11. #11
    New Member
    Join Date
    Nov 2015
    Posts
    7

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

    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

  12. #12

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,245

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

    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.

  13. #13
    New Member
    Join Date
    Nov 2015
    Posts
    7

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

    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

  14. #14

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,245

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

    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.

  15. #15
    New Member
    Join Date
    Nov 2015
    Posts
    7

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

    Thank you really much, you saved my life with this, i've been looking for so long.
    Last edited by gonzaspina; Nov 10th, 2015 at 12:04 PM.

  16. #16
    New Member
    Join Date
    Nov 2015
    Posts
    7

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

    When i have finished with this, i will update a class with both, Zipping and Unzipping functions.
    Last edited by gonzaspina; Nov 10th, 2015 at 12:04 PM.

  17. #17
    Addicted Member
    Join Date
    May 2016
    Location
    China
    Posts
    186

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

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

  18. #18
    Hyperactive Member
    Join Date
    Sep 2010
    Location
    Italy
    Posts
    434

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

    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

  19. #19
    Default Member Bonnie West's Avatar
    Join Date
    Jun 2012
    Location
    InIDE
    Posts
    4,057

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

    Quote Originally Posted by reexre View Post
    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.
    On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
    Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width