Работа с zip архивами

Option Explicit
'////////////////////////////////////////////
'// Модуль для чтения CAB-архивов          //
'// Copyright (c) 11.11.2024 by HackerVlad //
'// e-mail: vladislavpeshkov@yandex.ru     //
'// Testuser2 добавил поддержку x64        //
'// Версия 1.1                             //
'////////////////////////////////////////////
Private Declare PtrSafe Function SetupIterateCabinet Lib "setupapi" Alias "SetupIterateCabinetW" ( _
                      ByVal CabinetFile As LongPtr, _
                      ByVal Reserved As Long, _
                      ByVal MsgHandler As LongPtr, _
                      ByVal Context As LongPtr) As Long
'WINSETUPAPI BOOL SetupIterateCabinetW(
'  [in] PCWSTR              CabinetFile,
'  [in] DWORD               Reserved,
'  [in] PSP_FILE_CALLBACK_W MsgHandler,
'  [in] PVOID               Context
');
Private Declare PtrSafe Function lstrlenW Lib "kernel32" (ByVal lpString As LongPtr) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
 
Private Const MAXPATH = 260
Private Const NO_ERROR = 0
'
' Notification messages, handled in the callback
' procedure. This class doesn't handle them all.
'
Private Const SPFILENOTIFY_FILEINCABINET = &H11
Private Const SPFILENOTIFY_NEEDNEWCABINET = &H12
Private Const SPFILENOTIFY_FILEEXTRACTED = &H13
 
Private Const sicList = 568
Private Const sicCount = 569
Private Type CabInfo
    cabFileName As String
    cabFileSize As Long
End Type
Private Type FileInCabinetInfo          '_FILE_IN_CABINET_INFO_W
    NameInCabinet As LongPtr                  '  PCWSTR
    FileSize      As Long                     '  DWORD
    Win32Error    As Long                     '  DWORD
    DosDate       As Integer                  '  WORD
    DosTime       As Integer                  '  WORD
    DosAttribs    As Integer                  '  WORD
    FullTargetName(MAXPATH - 1) As Byte       '  WCHAR
End Type
Private Enum FILEOP
    FILEOP_ABORT = 0
    FILEOP_DOIT = 1
    FILEOP_SKIP = 2
End Enum
Private mstrFileToExtract As String
Private mstrOutputPath As String
Private mstrOutputFile As String
Private mlngCount As Long
Private arrListFilesCab() As CabInfo
'UINT PspFileCallbackW(PVOID Context, UINT Notification, UINT_PTR Param1, UINT_PTR Param2)
Private Function CabinetCallback(ByVal Context As LongPtr, ByVal Notification As Long, ByRef Param1 As FileInCabinetInfo, ByVal Param2 As LongPtr) As Long
    Select Case Notification
    Case SPFILENOTIFY_NEEDNEWCABINET
        CabinetCallback = NO_ERROR
        
    Case SPFILENOTIFY_FILEINCABINET
        Select Case Context
        Case sicCount
            mlngCount = mlngCount + 1
            CabinetCallback = FILEOP_SKIP
                
        Case sicList
            ' Добавить позицию в массив UDT
            ReDim Preserve arrListFilesCab(mlngCount)
            arrListFilesCab(mlngCount).cabFileName = fStringFromPointer(Param1.NameInCabinet)
            arrListFilesCab(mlngCount).cabFileSize = Param1.FileSize
            mlngCount = mlngCount + 1
            
            CabinetCallback = FILEOP_SKIP ' Перебирать список файлов дальше
        End Select
    End Select
End Function
 
Private Function fStringFromPointer(ByVal ptr As LongPtr) As String
    Dim lngLen As Long
    
    ' Given a string pointer, copy the value of the string into a new, safe location.
    lngLen = lstrlenW(ptr)
    fStringFromPointer = Space$(lngLen)
    
    CopyMemory ByVal StrPtr(fStringFromPointer), ByVal ptr, lngLen * 2
End Function
 
' Получить список файлов внутри архива CAB
Public Function GetFilesListInCab(ByRef FileName As String, arrCabInfo() As CabInfo) As Long
    mlngCount = 0
    
    If SetupIterateCabinet(StrPtr(FileName), 0, AddressOf CabinetCallback, sicList) Then
        arrCabInfo = arrListFilesCab
        GetFilesListInCab = mlngCount
        
        Erase arrListFilesCab
    End If
End Function
 
' Узнать количество файлов внутри архива CAB
Public Function GetFilesCountInCab(ByRef FileName As String) As Long
    mlngCount = 0
    
    If SetupIterateCabinet(StrPtr(FileName), 0&, AddressOf CabinetCallback, sicCount) Then
        GetFilesCountInCab = mlngCount
    End If
End Function