Seeking Advice on Implementing a 64-bit Zip Function via TB Moniker

[tmighty2]

Hello everyone,

I am still using VB6 for my apps.

I've been using ActiveX EXEs to run separate tasks in my projects, but they were too tricky to maintain. Recently, someone recommended using a TB moniker for handling 64-bit tasks in VB6, and it's been a game changer!

I'm now using TB Monikers for several tasks that shouldn't run inside my app's process. One issue I've encountered is with ChilkatZip—it doesn't work well because it starts its own tasks.

I want to make my own zip function inside a 64-bit TB moniker. I found a Zip class by wqweto, but it only works with 32-bit.

I'd like to stick to 64-bit and not use a 32-bit moniker if I can help it. Does anyone have suggestions or code examples for making a 64-bit zip function in TwinBasic moniker? Any advice would be greatly appreciated!
I do not want to use any closed source libraries anymore so fixing the Chilkat issue is not a solution.

Thank you very much in advance for your help!

[tmighty2]

Edit: cZipArchive runs nicely for me.
However, I am not sure if I could use the ASM code in TB.

[fafalone]

It doesn't look like wqweto has ported that project to 64bit yet.

It's not that you can't use asm at all, it's that first 32bit asm can't run under x64, you need to rewrite in 64bit asm (and the differences are far, far more than pointer size), and asm that makes use of undocumented VB6 internals won't work.

The zip projects I've made (here and here) would be quite easy to port to x64,or if you're ok with needing the 7-zip dll, bclothier's TwinBasicSevenZip has you covered.

For instance my first project to extract... you'd create a new project, add 'Windows Development Library for twinBASIC' as a Package in the Library References in Settings, then just remove the existing API declares and make a few minor adjustments:

Public Sub UnzipFile(sFile As String, Optional ByVal sTo As String = "")
'unzip without 3rd party dll
Dim psfParent As IShellFolder
Dim pidlFQ As LongPtr
Dim pidlChild As LongPtr
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 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 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), vbNullPtr)
    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 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 IStream
                Set pStrm = pStg.OpenStream(SysAllocString(stat.pwcsName), 0, STGM_READ, 0)
                Dim pStrmFile As 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, Nothing, pStrmFile)
                    End If
                Else
                    Call SHCreateStreamOnFileEx(StrPtr(pszPath), STGM_CREATE Or STGM_WRITE, FILE_ATTRIBUTE_NORMAL, 1, Nothing, pStrmFile)
                End If
                If (pStrmFile Is Nothing) = False Then
                    'Debug.Print "StgExtract.Got pstrmfile"
                    Dim cbSize As LongLong '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