[VB6] Decompress gzip stream with libarchive on Win10

[wqweto]

Recent versions of Win10 ship tar.exe utility which for compressed archives depends on stdcall build of libarchive open-source library which is shipped disguised under the name of archiveint.dll in C:\Windows\SysWOW64 (the 32-bit version we need).

Here is a .bas module with a single public Ungzip function which accepts a compressed byte-array and on successful decompression returns True:

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function archive_read_new Lib "archiveint" Alias "_archive_read_new@0" () As Long
Private Declare Function archive_read_free Lib "archiveint" Alias "_archive_read_free@4" (ByVal hArchive As Long) As Long
Private Declare Function archive_read_support_filter_gzip Lib "archiveint" Alias "_archive_read_support_filter_gzip@4" (ByVal hArchive As Long) As Long
Private Declare Function archive_read_support_format_raw Lib "archiveint" Alias "_archive_read_support_format_raw@4" (ByVal hArchive As Long) As Long
Private Declare Function archive_read_open_memory Lib "archiveint" Alias "_archive_read_open_memory@12" (ByVal hArchive As Long, pBuffer As Any, ByVal lSize As Long) As Long
Private Declare Function archive_read_next_header Lib "archiveint" Alias "_archive_read_next_header@8" (ByVal hArchive As Long, pHeader As Long) As Long
Private Declare Function archive_read_data Lib "archiveint" Alias "_archive_read_data@12" (ByVal hArchive As Long, pBuffer As Any, ByVal lSize As Long) As Long
      
Public Function Ungzip(baInput() As Byte, baOutput() As Byte) As Boolean
    Const BUFF_SIZE     As Long = 65536
    Const MAX_STEP      As Long = 2 ^ 24 '--- 16MB
    Dim baBuffer(0 To BUFF_SIZE - 1) As Byte
    Dim hArchive        As Long
    Dim lSize           As Long
    Dim lResult         As Long
    Dim lOutSize        As Long
    Dim lStep           As Long
    
    hArchive = archive_read_new()
    If hArchive = 0 Then
        GoTo QH
    End If
    lResult = archive_read_support_filter_gzip(hArchive)
    If lResult <> 0 Then
        GoTo QH
    End If
    lResult = archive_read_support_format_raw(hArchive)
    If lResult <> 0 Then
        GoTo QH
    End If
    lResult = archive_read_open_memory(hArchive, baInput(0), UBound(baInput) + 1)
    If lResult <> 0 Then
        GoTo QH
    End If
    lResult = archive_read_next_header(hArchive, 0)
    If lResult <> 0 Then
        GoTo QH
    End If
    baOutput = vbNullString
    Do
        lSize = archive_read_data(hArchive, baBuffer(0), UBound(baBuffer) + 1)
        If lSize = 0 Then
            Exit Do
        End If
        If lSize < UBound(baBuffer) + 1 Then
            ReDim Preserve baOutput(0 To lOutSize + lSize - 1) As Byte
        ElseIf UBound(baOutput) < lOutSize + lSize - 1 Then
            ' lStep = Clamp(UBound(baOutput) + 1, BUFF_SIZE, MAX_STEP)
            lStep = UBound(baOutput) + 1
            If lStep < BUFF_SIZE Then
                lStep = BUFF_SIZE
            ElseIf lStep > MAX_STEP Then
                lStep = MAX_STEP
            End If
            ReDim Preserve baOutput(0 To UBound(baOutput) + lStep) As Byte
        End If
        Call CopyMemory(baOutput(lOutSize), baBuffer(0), lSize)
        lOutSize = lOutSize + lSize
    Loop
    If UBound(baOutput) <> lOutSize - 1 Then
        ReDim Preserve baOutput(0 To lOutSize - 1) As Byte
    End If
    '--- success
    Ungzip = True
QH:
    If hArchive <> 0 Then
        Call archive_read_free(hArchive)
    End If
End Function

Thus provided function can be used to decompress gzip response as returned by ServerXMLHTTP or WinHttpRequest object like this:

Option Explicit

Private Sub Form_Load()
    Dim baUncompressed() As Byte
    
    With New MSXML2.ServerXMLHTTP
        .Open "GET", "https://www.google.com/", False
        '--- note: changing this request header is important because original Mozilla/4.0 User-Agent string
        '---   prevents web servers from compressing response with gzip (or deflate)
        .SetRequestHeader "User-Agent", "Mozilla/5.0"
        .SetRequestHeader "Accept-Encoding", "gzip"
        .Send
        If .GetResponseHeader("Content-Encoding") <> "gzip" Then
            Debug.Print "Response not gzipped"
            Exit Sub
        End If
        If Not Ungzip(.ResponseBody, baUncompressed) Then
            Debug.Print "Ungzip failed"
            Exit Sub
        End If
        '--- note: response might be utf-8 encoded
        Debug.Print StrConv(baUncompressed, vbUnicode)
    End With
End Sub

cheers,
</wqw>