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

[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